From 29aabbf591d365e2e63ce9a9c5295c7c1720761d Mon Sep 17 00:00:00 2001 From: Marko Andjelic Date: Sun, 25 Jan 2026 02:03:38 +0000 Subject: [PATCH] Complete basic text parsing functionality --- app/EpubParser.hs | 155 ++++++++++++++++++++++------------------------ app/Main.hs | 37 +++++++---- 2 files changed, 100 insertions(+), 92 deletions(-) diff --git a/app/EpubParser.hs b/app/EpubParser.hs index 746f8c4..2d4cff9 100644 --- a/app/EpubParser.hs +++ b/app/EpubParser.hs @@ -1,98 +1,91 @@ -module EpubParser where +{-# LANGUAGE OverloadedStrings #-} -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, Tag) -import Text.HTML.Scalpel (scrape, text, tagSelector, attr, attrs, Scraper, chroots, anySelector) -import System.FilePath (takeDirectory, ()) -import Control.Monad.Reader +module EpubParser + ( EpubAction + , EpubEnv(..) + , openEpub + , getOpfPath + , getOpfTags + , myEnv + , resolveSpine + , getChapter + , Tag(..) + ) where + +import Codec.Archive.Zip ( findEntryByPath, fromEntry, toArchive, Archive ) +import qualified Data.ByteString.Lazy as B import qualified Data.Text as T -import Data.Maybe (fromMaybe, catMaybes) -import qualified Data.Map as M +import qualified Data.Text.Encoding as TE +import Control.Monad.Reader ( ReaderT, MonadReader(ask) ) +import Text.HTML.TagSoup ( parseTags, Tag(..) ) +import System.FilePath (takeDirectory, (), normalise) type EpubAction a = ReaderT EpubEnv IO a data EpubEnv = EpubEnv - { title :: T.Text - , author :: T.Text - , rootPrefix :: FilePath - , spine :: [T.Text] - , manifestMap :: M.Map T.Text T.Text - , archive :: Archive - } deriving (Show) - -myEnv :: Archive -> [Tag String] -> EpubEnv -myEnv arch tags = - let - opfPath = fromMaybe "" (getOpfPath arch) - prefix = getRootPrefix opfPath - - in - EpubEnv - { title = getTagText "dc:title" tags - , author = getTagText "dc:creator" tags - , rootPrefix = prefix - , spine = getSpine tags - , manifestMap = getManifest tags - , archive = arch - } + { archive :: Archive + , manifest :: [Tag String] + , baseDir :: FilePath + } 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 = do + entry <- B.readFile path + return $ Right (toArchive entry) getOpfPath :: Archive -> Maybe FilePath -getOpfPath archive = do - entry <- findEntryByPath "META-INF/container.xml" archive - let tags = parseTags $ C8.unpack (fromEntry entry) - scrape (attr "full-path" (tagSelector "rootfile")) tags +getOpfPath arch = + case findEntryByPath "META-INF/container.xml" arch of + Nothing -> Nothing + Just entry -> + let content = TE.decodeUtf8 $ B.toStrict $ fromEntry entry + tags = parseTags (T.unpack content) + in getRootPath tags + +getRootPath :: [Tag String] -> Maybe FilePath +getRootPath [] = Nothing +getRootPath (TagOpen "rootfile" attrs : _) = lookup "full-path" attrs +getRootPath (_:xs) = getRootPath xs getOpfTags :: Archive -> FilePath -> [Tag String] -getOpfTags archive opfpath = - case findEntryByPath opfpath archive of - Just entry -> parseTags $ C8.unpack (fromEntry entry) - Nothing -> [] +getOpfTags arch opfPath = + case findEntryByPath opfPath arch of + Nothing -> [] + Just entry -> parseTags $ T.unpack $ TE.decodeUtf8 $ B.toStrict $ fromEntry entry --- Makes it easier so we can just use this function and concatenate relative paths -getRootPrefix :: FilePath -> FilePath -getRootPrefix path = - let dir = takeDirectory path - in if dir == "." then "" else dir ++ "/" - -getTagText :: String -> [Tag String] -> T.Text -getTagText tagName tags = - let scraper = text (tagSelector tagName) - in T.pack $ fromMaybe "" (scrape scraper tags) - -getSpine :: [Tag String] -> [T.Text] -getSpine 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 - - pure $ fmap (\href -> p T.unpack href) (M.lookup spineId m) +myEnv :: Archive -> FilePath -> [Tag String] -> EpubEnv +myEnv arch opfPath tags = EpubEnv arch tags (takeDirectory opfPath) resolveSpine :: EpubAction [FilePath] -resolveSpine = catMaybes <$> (asks spine >>= mapM resolvePath) +resolveSpine = do + env <- ask + let tags = manifest env + let itemRefs = [ idRef | TagOpen "itemref" attrs <- tags, let idRef = lookup "idref" attrs, Just idRef /= Nothing ] + + let files = map (findFileById tags) itemRefs + return [ f | Just f <- files ] + +findFileById :: [Tag String] -> Maybe String -> Maybe FilePath +findFileById _ Nothing = Nothing +findFileById tags (Just myId) = + let matches = [ href | TagOpen "item" attrs <- tags, lookup "id" attrs == Just myId, let href = lookup "href" attrs ] + in case matches of + (x:_) -> x + [] -> Nothing getChapter :: FilePath -> EpubAction T.Text -getChapter path = do - arch <- asks archive - case findEntryByPath path arch of - Nothing -> pure $ T.pack "Error: Chapter not found." - Just entry -> do - let content = C8.unpack (fromEntry entry) - let rawText = scrape (text anySelector) (parseTags content) - pure $ T.pack $ fromMaybe "" rawText +getChapter filename = do + env <- ask + let fullPath = normalise $ (baseDir env) filename + + let fileEntry = findEntryByPath fullPath (archive env) + case fileEntry of + Nothing -> return "" + Just file -> do + let content = fromEntry file + return $ stripHtml $ TE.decodeUtf8 $ B.toStrict content + +stripHtml :: T.Text -> T.Text +stripHtml raw = + let tags = parseTags (T.unpack raw) + in T.pack $ unwords [ txt | TagText txt <- tags ] diff --git a/app/Main.hs b/app/Main.hs index 7344b41..0333337 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,7 +4,7 @@ import System.Environment (getArgs) import Control.Monad.Reader (runReaderT, liftIO) import EpubParser import qualified Data.Text.IO as TIO - +import qualified Data.Text as T main :: IO () main = do args <- getArgs @@ -12,6 +12,7 @@ main = do [] -> putStrLn "Usage: svitak " (path:_) -> runSvitak path +runSvitak :: FilePath -> IO () runSvitak path = do result <- openEpub path case result of @@ -21,15 +22,29 @@ runSvitak path = do case maybeOpfPath of Nothing -> putStrLn "Error: Could not find OPF metadata file." Just opfPath -> do - let tags = getOpfTags arch opfPath - let env = myEnv arch tags - runReaderT printFirstChapter env + let tags = getOpfTags arch opfPath -printFirstChapter :: EpubAction () -printFirstChapter = - resolveSpine >>= \chapterPaths -> case chapterPaths of + let env = myEnv arch opfPath tags - [] -> liftIO $ putStrLn $ "Nothing found" - (firstFile:_) -> do - text <- getChapter firstFile - liftIO $ TIO.putStrLn text + runReaderT printFirstRealChapter env + +printFirstRealChapter :: EpubAction () +printFirstRealChapter = do + chapterPaths <- resolveSpine + + findText chapterPaths + + where + findText [] = liftIO $ putStrLn "End of book!" + findText (p:ps) = do + liftIO $ putStrLn $ "Checking: " ++ p ++ "..." + text <- getChapter p + let cleanText = T.strip text + + if T.null cleanText + then findText ps + else do + liftIO $ putStrLn "\n Found text:" + liftIO $ putStrLn "--------------------------------" + liftIO $ TIO.putStrLn $ T.take 500 cleanText + liftIO $ putStrLn "..."