From 3987c1a853779d7c3a4a35c6ad68bdc5fa65dc3d Mon Sep 17 00:00:00 2001 From: Marko Andjelic Date: Mon, 26 Jan 2026 09:26:45 +0000 Subject: [PATCH] Begin implementing chapter title parsing Right now chapter titles are completely plain, parsing the tags will allow us to render it properly. Revert chapterTitle addition and add it to seperate branch until its completed Delegating the task of implementing chapter title parsing into a different branch instead of having it incomplete in the main one Merge chtitle into main --- app/EpubParser.hs | 42 ++++++++++++++++++----- app/UI.hs | 85 +++++++++++++++++------------------------------ svitak.cabal | 22 ++++++++++++ 3 files changed, 86 insertions(+), 63 deletions(-) diff --git a/app/EpubParser.hs b/app/EpubParser.hs index 177ab73..b3e5c8d 100644 --- a/app/EpubParser.hs +++ b/app/EpubParser.hs @@ -8,6 +8,7 @@ module EpubParser , myEnv , resolveSpine , getChapter + , getChapterTitle , Tag(..) ) where @@ -18,7 +19,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Control.Monad.Reader (ReaderT, MonadReader(ask), liftIO) import Control.Monad.Except (runExceptT) -import Text.HTML.TagSoup (parseTags, Tag(..)) import System.FilePath (takeDirectory, (), normalise, takeExtension) import Data.List (find) @@ -30,9 +30,10 @@ import qualified Data.ByteString.Base64 as B64 type EpubAction a = ReaderT EpubEnv IO a data EpubEnv = EpubEnv - { archive :: Archive - , opfXml :: String - , baseDir :: FilePath + { archive :: Archive + , opfXml :: String + , baseDir :: FilePath + , bookPath :: FilePath } openEpub :: FilePath -> IO (Either String EpubEnv) @@ -47,7 +48,7 @@ openEpub path = do Nothing -> pure $ Left "OPF not in archive" Just entry -> do let xml = T.unpack $ TE.decodeUtf8 $ B.toStrict $ fromEntry entry - pure $ Right $ EpubEnv arch xml (takeDirectory opfPath) + pure $ Right $ EpubEnv arch xml (takeDirectory opfPath) path getOpfPath :: Archive -> Maybe FilePath getOpfPath arch = @@ -60,8 +61,8 @@ getRootPath [] = Nothing getRootPath (TagOpen "rootfile" attrs : _) = lookup "full-path" attrs getRootPath (_:xs) = getRootPath xs -myEnv :: Archive -> FilePath -> String -> EpubEnv -myEnv arch opfPath xml = EpubEnv arch xml (takeDirectory opfPath) +myEnv :: Archive -> FilePath -> String -> FilePath -> EpubEnv +myEnv arch opfPath xml path = EpubEnv arch xml (takeDirectory opfPath) path resolveSpine :: EpubAction [FilePath] resolveSpine = do @@ -87,7 +88,9 @@ getChapter filename = do case findEntryByPath full (archive env) of Nothing -> pure [] Just e -> do - pure $ embedImages (archive env) (baseDir env) (parseTags . TE.decodeUtf8 . B.toStrict $ fromEntry e) -- The base64 img + let rawTags = parseTags . TE.decodeUtf8 . B.toStrict $ fromEntry e + + pure (filterJunk (embedImages (archive env) (baseDir env) rawTags)) getMimeType :: FilePath -> T.Text getMimeType path = T.pack $ "image/" ++ normalizeExt (drop 1 $ takeExtension path) @@ -115,3 +118,26 @@ embedImages arch bdir = map processTag let rawData = B.toStrict $ fromEntry entry b64 = TE.decodeUtf8 $ B64.encode rawData in "data:" <> getMimeType fullPath <> ";base64," <> b64 + +-- TODO: Implement this, as it's not called yet +getChapterTitle :: [Tag T.Text] -> T.Text +getChapterTitle tags = + case dropWhile (not . isHeading) tags of + (_ : TagText t : _) -> T.strip t + _ -> "Untitled Chapter" + where + isHeading (TagOpen "h1" _) = True + isHeading (TagOpen "h2" _) = True + isHeading _ = False + +filterJunk :: [Tag T.Text] -> [Tag T.Text] +filterJunk = go + where + go [] = [] + go (TagOpen name _ : xs) | name `elem` ["script", "style", "head", "link", "meta"] = + go (dropUntilClose name xs) + go (x:xs) = x : go xs + + dropUntilClose _ [] = [] + dropUntilClose name (TagClose n : xs) | n == name = xs + dropUntilClose name (_ : xs) = dropUntilClose name xs diff --git a/app/UI.hs b/app/UI.hs index 3916db1..7d69040 100644 --- a/app/UI.hs +++ b/app/UI.hs @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings, OverloadedLabels #-} module UI (runApp) where - import qualified GI.Gtk as Gtk import qualified GI.Gdk as Gdk import qualified GI.Gio as Gio @@ -9,89 +8,65 @@ import qualified GI.WebKit as WebKit import qualified GI.Gtk.Enums as GtkEnums import Control.Monad.Reader (runReaderT) -import Data.IORef (newIORef, readIORef, writeIORef) +import Control.Concurrent.MVar (newMVar, readMVar, swapMVar) import Text.HTML.TagSoup (renderTags) -import EpubParser (EpubEnv, resolveSpine, getChapter, bookPath) +import EpubParser (EpubEnv(..), resolveSpine, getChapter, getChapterTitle) import Persistence (saveLastRead, loadLastRead) runApp :: EpubEnv -> IO () runApp env = do - app <- Gtk.applicationNew (Just "com.svitak.reader.v2") [] _ <- Gtk.on app #activate $ do - putStrLn "App Activated" - - -- Setup window window <- Gtk.applicationWindowNew app - Gtk.windowSetTitle window (Just "Svitak") Gtk.windowSetDefaultSize window 800 600 - - -- Setup webview + webView <- WebKit.webViewNew Gtk.windowSetChild window (Just webView) - -- Get the spine spine <- runReaderT resolveSpine env let totalChapters = length spine - putStrLn $ "Spine loaded. Total chapters: " ++ show totalChapters - if totalChapters == 0 - then putStrLn "ERROR: This book has no chapters!" + if totalChapters == 0 + then Gtk.windowSetTitle window (Just "Svitak - No Chapters Found") else do - currentIndex <- newIORef 0 + -- LoadChapter is now inside the 'else' do-block let loadChapter index = do - let maxIdx = totalChapters - 1 - let safeIdx = max 0 (min index maxIdx) + let maxIdx = totalChapters - 1 + let safeIdx = max 0 (min index maxIdx) + + writeIORef currentIndex safeIdx + saveLastRead (bookPath env) safeIdx - -- Save state after every chapter - writeIORef currentIndex safeIdx - putStrLn $ "Loading Chapter " ++ show (safeIdx + 1) - saveLastRead (bookPath env) safeIdx - - let filename = spine !! safeIdx - tags <- runReaderT (getChapter filename) env - - let htmlContent = renderTags tags + let filename = spine !! safeIdx + tags <- runReaderT (getChapter filename) env + + let chapterTitle = getChapterTitle tags + Gtk.windowSetTitle window (Just $ "Svitak - " <> chapterTitle) + + let htmlContent = renderTags tags + WebKit.webViewLoadHtml webView htmlContent (Just "file:///") - -- Load HTML - WebKit.webViewLoadHtml webView htmlContent (Just "file:///") - - -- If there's no state saved then load the first chapter maybeSaved <- loadLastRead - case maybeSaved of - Just (path, index) - | path == bookPath env -> loadChapter index - | otherwise -> loadChapter 0 + Just (path, idx) | path == bookPath env -> loadChapter idx + _ -> loadChapter 0 - Nothing -> loadChapter 0 - - - -- Setup keyboard input - keyController <- Gtk.eventControllerKeyNew - - Gtk.eventControllerSetPropagationPhase keyController GtkEnums.PropagationPhaseCapture - - _ <- Gtk.on keyController #keyPressed $ \keyval _ _ -> do + keyCtrl <- Gtk.eventControllerKeyNew + Gtk.eventControllerSetPropagationPhase keyCtrl GtkEnums.PropagationPhaseCapture + + _ <- Gtk.on keyCtrl #keyPressed $ \keyval _ _ -> do curr <- readIORef currentIndex case keyval of - Gdk.KEY_Right -> do - putStrLn "KEY: -> Next" - loadChapter (curr + 1) - return True - Gdk.KEY_Left -> do - putStrLn "KEY: <- Prev" - loadChapter (curr - 1) - return True - _ -> return False + Gdk.KEY_Right -> loadChapter (curr + 1) >> return True + Gdk.KEY_Left -> loadChapter (curr - 1) >> return True + _ -> return False - Gtk.widgetAddController window keyController + Gtk.widgetAddController window keyCtrl #present window - putStrLn "DEBUG: Window presented" _ <- Gio.applicationRun app Nothing - pure () + return () diff --git a/svitak.cabal b/svitak.cabal index 75f1656..0c174dc 100644 --- a/svitak.cabal +++ b/svitak.cabal @@ -82,3 +82,25 @@ executable svitak hs-source-dirs: app default-language: Haskell2010 + +test-suite svitak-test + main-is: Spec.hs + type: exitcode-stdio-1.0 + + other-modules: EpubParser, + Persistence + + build-depends: base ^>= 4.21.0.0, + base64-bytestring, + bytestring, + epub-metadata, + filepath, + mtl, + tagsoup, + text, + zip-archive, + directory + + hs-source-dirs: test, app + default-language: Haskell2010 +