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

Add tag support

Browse source
This commit is contained in:
Marko Andjelic 2026-01-25 03:06:12 +00:00
commit 8d3848451c
1 changed files with 8 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

21
app/EpubParser.hs
View file

@ -19,7 +19,7 @@ import qualified Data.Text.Encoding as TE
import Control.Monad.Reader ( ReaderT, MonadReader(ask) ) import Control.Monad.Reader ( ReaderT, MonadReader(ask) )
import Text.HTML.TagSoup ( parseTags, Tag(..) ) import Text.HTML.TagSoup ( parseTags, Tag(..) )
import System.FilePath (takeDirectory, (</>), normalise) import System.FilePath (takeDirectory, (</>), normalise)
import Data.Maybe (mapMaybe, isJust)
type EpubAction a = ReaderT EpubEnv IO a type EpubAction a = ReaderT EpubEnv IO a
data EpubEnv = EpubEnv data EpubEnv = EpubEnv
@ -60,10 +60,10 @@ resolveSpine :: EpubAction [FilePath]
resolveSpine = do resolveSpine = do
env <- ask env <- ask
let tags = manifest env let tags = manifest env
let itemRefs = [ idRef | TagOpen "itemref" attrs <- tags, let idRef = lookup "idref" attrs, Just idRef /= Nothing ] let itemRefs = [ idRef | TagOpen "itemref" attrs <- tags, let idRef = lookup "idref" attrs, isJust $ Just idRef ]
let files = map (findFileById tags) itemRefs -- let files = map (findFileById tags) itemRefs
return [ f | Just f <- files ] pure $ mapMaybe (findFileById tags) itemRefs
findFileById :: [Tag String] -> Maybe String -> Maybe FilePath findFileById :: [Tag String] -> Maybe String -> Maybe FilePath
findFileById _ Nothing = Nothing findFileById _ Nothing = Nothing
@ -73,19 +73,14 @@ findFileById tags (Just myId) =
(x:_) -> x (x:_) -> x
[] -> Nothing [] -> Nothing
getChapter :: FilePath -> EpubAction T.Text getChapter :: FilePath -> EpubAction [Tag T.Text]
getChapter filename = do getChapter filename = do
env <- ask env <- ask
let fullPath = normalise $ (baseDir env) </> filename let fullPath = normalise $ baseDir env </> filename
let fileEntry = findEntryByPath fullPath (archive env) let fileEntry = findEntryByPath fullPath (archive env)
case fileEntry of case fileEntry of
Nothing -> return "" Nothing -> pure []
Just file -> do Just file -> do
let content = fromEntry file
return $ stripHtml $ TE.decodeUtf8 $ B.toStrict content
stripHtml :: T.Text -> T.Text pure $ parseTags $ TE.decodeUtf8 $ B.toStrict $ fromEntry file
stripHtml raw =
let tags = parseTags (T.unpack raw)
in T.pack $ unwords [ txt | TagText txt <- tags ]