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 +