Add parsing and associated modules

This commit is contained in:
Marko Andjelic 2026-01-23 23:33:00 +00:00
commit 0f9a03822e
2 changed files with 36 additions and 3 deletions

View file

@ -3,6 +3,14 @@ module EpubParser where
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, fromAttrib, (~==), Tag, innerText, sections)
import System.FilePath (takeDirectory)
data BookInfo = BookInfo
{ title :: String
, author :: String
} deriving (Show)
openEpub :: FilePath -> IO (Either String Archive)
openEpub path = toArchive <$> BL.readFile path >>= \archive -> maybe (pure $ Left "Error reading file") (\entry -> if fromEntry entry == C8.pack "application/epub+zip" then pure (Right archive) else pure (Left "Wrong mimetype")) (findEntryByPath "mimetype" archive)
@ -10,5 +18,29 @@ openEpub path = toArchive <$> BL.readFile path >>= \archive -> maybe (pure $ Lef
getOpfPath :: Archive -> Maybe FilePath
getOpfPath archive = do
entry <- findEntryByPath "META-INF/container.xml" archive
let content = C8.unpack (fromEntry entry)
return "OEBPS/content.opf"
let tags = parseTags content
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
getRootPrefix :: FilePath -> FilePath
getRootPrefix path =
let dir = takeDirectory path
in if dir == "."
then ""
else dir ++ "/"
tagify :: String -> String
tagify item = "<" ++ item ++ ">"
getTagText :: String -> [Tag String] -> String
getTagText tagName tags =
case sections (~== tagify tagName) tags of
(x:_) -> innerText x
[] -> ""

View file

@ -62,8 +62,9 @@ executable svitak
build-depends: base ^>=4.21.0.0,
bytestring >= 0.12.2.0,
epub-metadata >=5.4,
zip-archive >= 0.4.3.2,
tagsoup
filepath >= 1.5.4.0,
tagsoup,
zip-archive >= 0.4.3.2
hs-source-dirs: app
default-language: Haskell2010