Implement scalpel

This commit is contained in:
Marko Andjelic 2026-01-24 00:56:23 +00:00
commit 092ef7b8f1
2 changed files with 11 additions and 22 deletions

View file

@ -3,7 +3,8 @@ module EpubParser where
import Codec.Archive.Zip (toArchive, findEntryByPath, fromEntry, Archive) 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, fromAttrib, (~==), Tag, innerText, sections) import Text.HTML.TagSoup (parseTags, Tag)
import Text.HTML.Scalpel (scrape, text, tagSelector, attr)
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
@ -36,16 +37,9 @@ openEpub path = toArchive <$> BL.readFile path >>= \archive -> maybe (pure $ Lef
getOpfPath :: Archive -> Maybe FilePath getOpfPath :: Archive -> Maybe FilePath
getOpfPath archive = do getOpfPath archive = do
entry <- findEntryByPath "META-INF/container.xml" archive entry <- findEntryByPath "META-INF/container.xml" archive
let content = C8.unpack (fromEntry entry) let tags = parseTags $ C8.unpack (fromEntry entry)
-- Logic: scrape (the_scraper) (the_tags)
let tags = parseTags content scrape (attr "full-path" (tagSelector "rootfile")) tags
let rootfileTags = filter (~== "<rootfile>") tags
-- If we found at least one, get the "full-path" attribute
case rootfileTags of
(t:_) -> Just (fromAttrib "full-path" t)
[] -> Nothing
getOpfTags :: Archive -> FilePath -> [Tag String] getOpfTags :: Archive -> FilePath -> [Tag String]
getOpfTags archive opfpath = getOpfTags archive opfpath =
@ -56,16 +50,10 @@ getOpfTags archive opfpath =
getRootPrefix :: FilePath -> FilePath getRootPrefix :: FilePath -> FilePath
getRootPrefix path = getRootPrefix path =
let dir = takeDirectory path let dir = takeDirectory path
in if dir == "." in if dir == "." then "" else dir ++ "/"
then ""
else dir ++ "/"
tagify :: String -> String
tagify item = "<" ++ item ++ ">"
getTagText :: String -> [Tag String] -> T.Text getTagText :: String -> [Tag String] -> T.Text
getTagText tagName tags = getTagText tagName tags =
case sections (~== tagify tagName) tags of let scraper = text (tagSelector tagName)
(x:_) -> T.pack (innerText x) in T.pack $ fromMaybe "" (scrape scraper tags)
[] -> T.empty

View file

@ -66,7 +66,8 @@ executable svitak
mtl >= 2.3.2, mtl >= 2.3.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