From 9784b7c7dec90212bbf175378b7871ae59627cca Mon Sep 17 00:00:00 2001 From: Marko Andjelic Date: Sat, 21 Mar 2026 22:57:53 +0000 Subject: [PATCH] improve error handling --- app/EpubParser.hs | 62 +++++++++++++++++++++-------------------------- app/Navigation.hs | 3 ++- app/Types.hs | 7 +++--- app/UI.hs | 32 +++++++++++++----------- 4 files changed, 51 insertions(+), 53 deletions(-) diff --git a/app/EpubParser.hs b/app/EpubParser.hs index 77fa0db..756592d 100644 --- a/app/EpubParser.hs +++ b/app/EpubParser.hs @@ -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 diff --git a/app/Navigation.hs b/app/Navigation.hs index 0c344a0..f06b824 100644 --- a/app/Navigation.hs +++ b/app/Navigation.hs @@ -3,7 +3,8 @@ module Navigation ( navFinder, lndmkScraper, - lndmkmap + lndmkmap, + getLandmarks ) where diff --git a/app/Types.hs b/app/Types.hs index bf5f780..939c11c 100644 --- a/app/Types.hs +++ b/app/Types.hs @@ -22,6 +22,7 @@ import qualified Codec.Epub.Data.Manifest as DMan import Control.Concurrent.Async (Async) import Control.Monad.Reader (ReaderT) import Data.String (IsString) +import Control.Monad.Except (ExceptT) -- Unified interface for EPub 2 and EPub 3 formats, allows generic programming of both without having to repeat boilerplate class BookInfo a where @@ -29,8 +30,8 @@ class BookInfo a where getAuthors :: a -> [T.Text] getLandmarks :: a -> [NavItem] getBookPath :: a -> FilePath - getSpine :: a -> IO [(InternalPath, T.Text)] - loadChapter :: a -> (InternalPath, T.Text) -> ChapterIndex -> IO Chapter + getSpine :: a -> IO (Either String [(InternalPath, T.Text)]) + loadChapter :: a -> (InternalPath, T.Text) -> ChapterIndex -> IO (Either String Chapter) newtype ChapterIndex = ChapterIndex Int deriving (Show, Eq, Ord, Num) @@ -74,7 +75,7 @@ data AppState = AppState taskVersion :: Integer } -type EpubAction a = ReaderT EpubEnv IO a +type EpubAction a = ReaderT EpubEnv (ExceptT String IO) a data UserAction = NextChapter diff --git a/app/UI.hs b/app/UI.hs index fa3a735..0670cb0 100644 --- a/app/UI.hs +++ b/app/UI.hs @@ -64,22 +64,26 @@ updateZoom stateTVar webView level = do initAppServices :: (BookInfo a) => a -> TVar AppState -> (UserAction -> IO ()) -> IO () initAppServices env stateTVar actionHandler = do _ <- async $ do - ispine <- getSpine env + spineResult <- getSpine env + case spineResult of + Left err -> putStrLn $ "Failed to load spine: " ++ err + Right ispine -> do + chapterResults <- zipWithM (loadChapter env) ispine (map ChapterIndex [0 ..]) - allChapters <- zipWithM (loadChapter env) ispine (map ChapterIndex [0 ..]) + case sequence chapterResults of + Left err -> putStrLn $ "Failed to load chapters: " ++ err + Right allChapters -> do + let bookTitle = getTitle env + atomically $ modifyTVar stateTVar $ \s -> + s { cSpine = ispine, cAllChapters = allChapters, bTitle = bookTitle } - let bookTitle = getTitle env - - atomically $ modifyTVar stateTVar $ \s -> - s {cSpine = ispine, cAllChapters = allChapters, bTitle = bookTitle} - - _ <- GLib.idleAdd GLibConst.PRIORITY_DEFAULT $ do - maybeSaved <- loadLastRead - case maybeSaved of - Just (path, idx) | path == getBookPath env -> actionHandler (LoadSpecific idx) - _ -> actionHandler (LoadSpecific 0) - pure False - pure () + _ <- GLib.idleAdd GLibConst.PRIORITY_DEFAULT $ do + maybeSaved <- loadLastRead + case maybeSaved of + Just (path, idx) | path == getBookPath env -> actionHandler (LoadSpecific idx) + _ -> actionHandler (LoadSpecific 0) + pure False + pure () pure () activate :: EpubEnv -> Gtk.Application -> IO ()