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

Add reader environment

Browse source
This commit is contained in:
Marko Andjelic 2026-01-24 00:04:45 +00:00
commit 2a35aff1b2
2 changed files with 28 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

33
app/EpubParser.hs
View file

@ -5,12 +5,30 @@ 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, fromAttrib, (~==), Tag, innerText, sections)
import System.FilePath (takeDirectory) import System.FilePath (takeDirectory)
import Control.Monad.Reader
import qualified Data.Text as T
import Data.Maybe (fromMaybe)
data BookInfo = BookInfo type EpubAction a = ReaderT EpubEnv IO a
{ title :: String
, author :: String data EpubEnv = EpubEnv
{ title :: T.Text
, author :: T.Text
, rootPrefix :: FilePath
} deriving (Show) } deriving (Show)
myEnv :: Archive -> [Tag String] -> EpubEnv
myEnv archive tags =
let
opfPath = fromMaybe "" (getOpfPath archive)
prefix = getRootPrefix opfPath
in
EpubEnv
{ title = getTagText "dc:title" tags
, author = getTagText "dc:creator" tags
, rootPrefix = prefix
}
openEpub :: FilePath -> IO (Either String Archive) 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) 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)
@ -28,7 +46,7 @@ getOpfPath archive = do
case rootfileTags of case rootfileTags of
(t:_) -> Just (fromAttrib "full-path" t) (t:_) -> Just (fromAttrib "full-path" t)
[] -> Nothing [] -> Nothing
getRootPrefix :: FilePath -> FilePath getRootPrefix :: FilePath -> FilePath
getRootPrefix path = getRootPrefix path =
let dir = takeDirectory path let dir = takeDirectory path
@ -39,8 +57,9 @@ getRootPrefix path =
tagify :: String -> String tagify :: String -> String
tagify item = "<" ++ item ++ ">" tagify item = "<" ++ item ++ ">"
getTagText :: String -> [Tag String] -> String getTagText :: String -> [Tag String] -> T.Text
getTagText tagName tags = getTagText tagName tags =
case sections (~== tagify tagName) tags of case sections (~== tagify tagName) tags of
(x:_) -> innerText x (x:_) -> T.pack (innerText x)
[] -> "" [] -> T.empty

2
svitak.cabal
View file

@ -63,7 +63,9 @@ executable svitak
bytestring >= 0.12.2.0, bytestring >= 0.12.2.0,
epub-metadata >=5.4, epub-metadata >=5.4,
filepath >= 1.5.4.0, filepath >= 1.5.4.0,
mtl >= 2.3.2,
tagsoup, tagsoup,
text >= 2.1.2,
zip-archive >= 0.4.3.2 zip-archive >= 0.4.3.2
hs-source-dirs: app hs-source-dirs: app