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

improve error handling

Browse source
This commit is contained in:
Marko Andjelic 2026-03-21 22:57:53 +00:00
commit 9784b7c7de
Signed by: marko
GPG key ID: 9C5E99C8C682FB59
4 changed files with 55 additions and 57 deletions
Download patch file Download diff file Expand all files Collapse all files

62
app/EpubParser.hs
View file

@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module EpubParser
( EpubAction,
@ -16,46 +17,35 @@ import qualified Codec.Epub.Data.Spine as DSpin
import Codec.Epub.Parse (getManifest, getMetadata, getSpine)
import Control.Applicative ((<|>))
import Control.Monad (guard)
import Control.Monad.Except (runExceptT, ExceptT)
import Control.Monad.Except (runExceptT, ExceptT, throwError)
import Control.Monad.Reader (MonadReader (ask), liftIO, runReaderT)
import Control.Monad.Trans (lift)
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy as B
import Data.List (find, foldl')
import Data.Maybe (fromMaybe)
import Data.Maybe (fromMaybe, listToMaybe)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import System.FilePath (normalise, takeDirectory, (</>))
import Text.HTML.Scalpel (Scraper, ScraperT, anySelector, attr, chroot, chroots, html, innerHTML, scrapeStringLike, text)
import Types (Chapter (..), EpubAction, EpubEnv (..), InternalPath(..), ChapterIndex(..), BookInfo(..), EpubType(..))
import Navigation (navFinder, lndmkScraper, lndmkmap)
import Navigation (navFinder, lndmkScraper, lndmkmap, getLandmarks)
import Codec.Epub.Parse (getPackage)
import Codec.Epub.Data.Metadata (metaTitles, titleText, titleType, Creator (creatorText), Metadata (metaCreators))
import Codec.Epub.Data.Package (Package(..))
import qualified Codec.Epub.Data.Metadata as DMeta
instance BookInfo EpubEnv where
getTitle env =
let titles = metaTitles (eMetadata env)
in case find (\t -> titleType t == Just "main") titles of
Just t -> T.pack (titleText t)
Nothing -> if null titles then "Unknown" else T.pack (titleText (head titles))
getTitle env = fromMaybe "Unknown Title" $ T.pack . DMeta.titleText <$> listToMaybe (DMeta.metaTitles $ eMetadata env)
getAuthors env = map (T.pack . creatorText) (metaCreators (eMetadata env))
getAuthors env = map (T.pack . DMeta.creatorText) $ DMeta.metaCreators $ eMetadata env
getLandmarks env =
let xmlStr = opfXml env
maybeNavPath = scrapeStringLike xmlStr navFinder
in case maybeNavPath of
Nothing -> []
Just path ->
let full = normalise (baseDir env </> path)
in case findEntryByPath full (archive env) of
Nothing -> []
Just entry ->
let raw = TE.decodeUtf8 . B.toStrict $ fromEntry entry
in fromMaybe [] (scrapeStringLike raw (lndmkScraper [EpubType "toc", EpubType "landmarks", EpubType "bodymatter"]))
getLandmarks = Navigation.getLandmarks
getBookPath = bookPath
getSpine = runReaderT resolveSpine
loadChapter env path idx = runReaderT (getChapter path idx) env
getSpine env = runExceptT (runReaderT resolveSpine env)
loadChapter env path idx = runExceptT (runReaderT (getChapter path idx) env)
openEpub :: FilePath -> IO (Either String EpubEnv)
openEpub path = do
@ -107,26 +97,28 @@ resolveSpine :: EpubAction [(InternalPath, T.Text)]
resolveSpine = do
env <- ask
let xmlStr = opfXml env
let mNavPath = scrapeStringLike xmlStr navFinder
spineResult <- liftIO $ runExceptT $ Codec.Epub.Parse.getSpine xmlStr
let (DMan.Manifest items) = eManifest env
case spineResult of
Right (DSpin.Spine maybeTocId refs) -> do
let lookupHref ident = DMan.mfiHref <$> find (\mi -> DMan.mfiId mi == ident) items
let maybeTocPath = lookupHref maybeTocId
spineResult <- lift $ Codec.Epub.Parse.getSpine xmlStr
case spineResult of
DSpin.Spine maybeTocId refs -> do
let lookupHref ident = DMan.mfiHref <$> find (\mi -> DMan.mfiId mi == ident) items
let mNavPath = scrapeStringLike xmlStr navFinder
tocMap <- case mNavPath of
Just navPath -> extractTocFromEntry (baseDir env </> navPath)
Nothing -> case lookupHref maybeTocId of
Just ncxPath -> extractTocFromEntry (baseDir env </> ncxPath)
Nothing -> pure []
Nothing -> throwError "Could not locate a Table of Contents."
let buildChapter (ref, i) = do
let ident = DSpin.siIdRef ref
case lookupHref ident of
Nothing -> throwError $ "Manifest missing entry for spine item: " ++ ident
Just p ->
let title = fromMaybe ("Chapter " <> T.pack (show i)) (lookup p tocMap)
in pure (InternalPath p, title)
pure [(InternalPath p, fromMaybe ("Chapter " <> T.pack (show i)) (lookup p tocMap)) | (ref, i) <- zip refs [1..] , let ident = DSpin.siIdRef ref , Just p <- [lookupHref ident]]
_ -> pure []
mapM buildChapter (zip refs [1..])
extractTocFromEntry :: FilePath -> EpubAction [(String, T.Text)]
extractTocFromEntry fullPath = do