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
This commit is contained in:
parent
fab1d6b84c
commit
3987c1a853
3 changed files with 87 additions and 64 deletions
|
|
@ -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
|
||||
|
|
|
|||
73
app/UI.hs
73
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!"
|
||||
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)
|
||||
|
||||
-- Save state after every chapter
|
||||
writeIORef currentIndex safeIdx
|
||||
putStrLn $ "Loading Chapter " ++ show (safeIdx + 1)
|
||||
saveLastRead (bookPath env) safeIdx
|
||||
writeIORef currentIndex safeIdx
|
||||
saveLastRead (bookPath env) safeIdx
|
||||
|
||||
let filename = spine !! safeIdx
|
||||
tags <- runReaderT (getChapter filename) env
|
||||
let filename = spine !! safeIdx
|
||||
tags <- runReaderT (getChapter filename) env
|
||||
|
||||
let htmlContent = renderTags tags
|
||||
let chapterTitle = getChapterTitle tags
|
||||
Gtk.windowSetTitle window (Just $ "Svitak - " <> chapterTitle)
|
||||
|
||||
-- Load HTML
|
||||
WebKit.webViewLoadHtml webView htmlContent (Just "file:///")
|
||||
let htmlContent = renderTags tags
|
||||
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
|
||||
keyCtrl <- Gtk.eventControllerKeyNew
|
||||
Gtk.eventControllerSetPropagationPhase keyCtrl GtkEnums.PropagationPhaseCapture
|
||||
|
||||
|
||||
-- Setup keyboard input
|
||||
keyController <- Gtk.eventControllerKeyNew
|
||||
|
||||
Gtk.eventControllerSetPropagationPhase keyController GtkEnums.PropagationPhaseCapture
|
||||
|
||||
_ <- Gtk.on keyController #keyPressed $ \keyval _ _ -> do
|
||||
_ <- 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 ()
|
||||
|
|
|
|||
22
svitak.cabal
22
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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue