marko/svitak
Watch
1
0
Fork
You've already forked svitak
 1
Code Issues Pull requests Projects Releases Wiki Activity Actions

Add spine to file path resolving

Browse source
This commit is contained in:
Marko Andjelic 2026-01-24 01:48:02 +00:00
commit 4bc89a49c1
2 changed files with 31 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

34
app/EpubParser.hs
View file

@ -4,11 +4,12 @@ import Codec.Archive.Zip (toArchive, findEntryByPath, fromEntry, Archive)
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as C8 import qualified Data.ByteString.Lazy.Char8 as C8
import Text.HTML.TagSoup (parseTags, Tag) import Text.HTML.TagSoup (parseTags, Tag)
import Text.HTML.Scalpel (scrape, text, tagSelector, attr, attrs) import Text.HTML.Scalpel (scrape, text, tagSelector, attr, attrs, Scraper, chroots, anySelector)
import System.FilePath (takeDirectory) import System.FilePath (takeDirectory, (</>))
import Control.Monad.Reader import Control.Monad.Reader
import qualified Data.Text as T import qualified Data.Text as T
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import qualified Data.Map as M
type EpubAction a = ReaderT EpubEnv IO a type EpubAction a = ReaderT EpubEnv IO a
@ -17,6 +18,7 @@ data EpubEnv = EpubEnv
, author :: T.Text , author :: T.Text
, rootPrefix :: FilePath , rootPrefix :: FilePath
, spine :: [T.Text] , spine :: [T.Text]
, manifestMap :: M.Map T.Text T.Text
} deriving (Show) } deriving (Show)
myEnv :: Archive -> [Tag String] -> EpubEnv myEnv :: Archive -> [Tag String] -> EpubEnv
@ -27,10 +29,11 @@ myEnv archive tags =
in in
EpubEnv EpubEnv
{ title = getTagText "dc:title" tags { title = getTagText "dc:title" tags
, author = getTagText "dc:creator" tags , author = getTagText "dc:creator" tags
, rootPrefix = prefix , rootPrefix = prefix
, spine = getSpine tags , spine = getSpine tags
, manifestMap = getManifest tags
} }
openEpub :: FilePath -> IO (Either String Archive) openEpub :: FilePath -> IO (Either String Archive)
@ -63,3 +66,22 @@ getTagText tagName tags =
getSpine :: [Tag String] -> [T.Text] getSpine :: [Tag String] -> [T.Text]
getSpine tags = getSpine tags =
map T.pack . fromMaybe [] $ scrape (attrs "idref" (tagSelector "itemref")) 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

5
svitak.cabal
View file

@ -61,13 +61,14 @@ executable svitak
build-depends: base ^>=4.21.0.0, build-depends: base ^>=4.21.0.0,
bytestring >= 0.12.2.0, bytestring >= 0.12.2.0,
containers >= 0.7,
epub-metadata >=5.4, epub-metadata >=5.4,
filepath >= 1.5.4.0, filepath >= 1.5.4.0,
mtl >= 2.3.2, mtl >= 2.3.2,
scalpel >= 0.6.2.2,
tagsoup, tagsoup,
text >= 2.1.2, text >= 2.1.2,
zip-archive >= 0.4.3.2, zip-archive >= 0.4.3.2
scalpel >= 0.6.2.2
hs-source-dirs: app hs-source-dirs: app
default-language: Haskell2010 default-language: Haskell2010