Add spine to file path resolving
This commit is contained in:
parent
9938b51ba1
commit
4bc89a49c1
2 changed files with 31 additions and 8 deletions
|
|
@ -4,11 +4,12 @@ import Codec.Archive.Zip (toArchive, findEntryByPath, fromEntry, Archive)
|
|||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.ByteString.Lazy.Char8 as C8
|
||||
import Text.HTML.TagSoup (parseTags, Tag)
|
||||
import Text.HTML.Scalpel (scrape, text, tagSelector, attr, attrs)
|
||||
import System.FilePath (takeDirectory)
|
||||
import Text.HTML.Scalpel (scrape, text, tagSelector, attr, attrs, Scraper, chroots, anySelector)
|
||||
import System.FilePath (takeDirectory, (</>))
|
||||
import Control.Monad.Reader
|
||||
import qualified Data.Text as T
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.Map as M
|
||||
|
||||
type EpubAction a = ReaderT EpubEnv IO a
|
||||
|
||||
|
|
@ -17,6 +18,7 @@ data EpubEnv = EpubEnv
|
|||
, author :: T.Text
|
||||
, rootPrefix :: FilePath
|
||||
, spine :: [T.Text]
|
||||
, manifestMap :: M.Map T.Text T.Text
|
||||
} deriving (Show)
|
||||
|
||||
myEnv :: Archive -> [Tag String] -> EpubEnv
|
||||
|
|
@ -27,10 +29,11 @@ myEnv archive tags =
|
|||
|
||||
in
|
||||
EpubEnv
|
||||
{ title = getTagText "dc:title" tags
|
||||
, author = getTagText "dc:creator" tags
|
||||
, rootPrefix = prefix
|
||||
, spine = getSpine tags
|
||||
{ title = getTagText "dc:title" tags
|
||||
, author = getTagText "dc:creator" tags
|
||||
, rootPrefix = prefix
|
||||
, spine = getSpine tags
|
||||
, manifestMap = getManifest tags
|
||||
}
|
||||
|
||||
openEpub :: FilePath -> IO (Either String Archive)
|
||||
|
|
@ -63,3 +66,22 @@ getTagText tagName tags =
|
|||
getSpine :: [Tag String] -> [T.Text]
|
||||
getSpine tags =
|
||||
map T.pack . fromMaybe [] $ scrape (attrs "idref" (tagSelector "itemref")) tags
|
||||
|
||||
-- This scraper will be run by chroot for every item
|
||||
itemScraper :: Scraper String (T.Text, T.Text)
|
||||
itemScraper =
|
||||
liftA2 (,) (attr "id" anySelector) (attr "href" anySelector) >>= \(id, href) -> pure (T.pack id, T.pack href)
|
||||
|
||||
getManifest :: [Tag String] -> M.Map T.Text T.Text
|
||||
getManifest tags =
|
||||
M.fromList . fromMaybe [] $ scrape (chroots (tagSelector "item") itemScraper) tags
|
||||
|
||||
resolvePath :: T.Text -> EpubAction (Maybe FilePath)
|
||||
resolvePath spineId = do
|
||||
m <- asks manifestMap
|
||||
p <- asks rootPrefix
|
||||
|
||||
let mHref = M.lookup spineId m
|
||||
|
||||
|
||||
pure $ fmap (\href -> p </> T.unpack href) mHref
|
||||
|
|
|
|||
|
|
@ -61,13 +61,14 @@ executable svitak
|
|||
|
||||
build-depends: base ^>=4.21.0.0,
|
||||
bytestring >= 0.12.2.0,
|
||||
containers >= 0.7,
|
||||
epub-metadata >=5.4,
|
||||
filepath >= 1.5.4.0,
|
||||
mtl >= 2.3.2,
|
||||
scalpel >= 0.6.2.2,
|
||||
tagsoup,
|
||||
text >= 2.1.2,
|
||||
zip-archive >= 0.4.3.2,
|
||||
scalpel >= 0.6.2.2
|
||||
zip-archive >= 0.4.3.2
|
||||
|
||||
hs-source-dirs: app
|
||||
default-language: Haskell2010
|
||||
|
|
|
|||
Loading…
Reference in a new issue