forked from marko/svitak
feature:MVar Implementation
Replace IORef Branch created to replace the use of IORef with MVar
This commit is contained in:
parent
83a767968b
commit
018e5290a3
3 changed files with 164 additions and 108 deletions
|
|
@ -3,9 +3,9 @@
|
|||
module EpubParser
|
||||
( EpubAction
|
||||
, EpubEnv(..)
|
||||
, AppState(..)
|
||||
, openEpub
|
||||
, getOpfPath
|
||||
, myEnv
|
||||
, resolveSpine
|
||||
, getChapter
|
||||
, getChapterTitle
|
||||
|
|
@ -19,22 +19,34 @@ 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 System.FilePath (takeDirectory, (</>), normalise, takeExtension)
|
||||
import System.FilePath (takeDirectory, (</>), normalise)
|
||||
import Data.List (find)
|
||||
import Text.HTML.TagSoup
|
||||
import Text.HTML.TagSoup (parseTags, innerText, Tag(..))
|
||||
|
||||
import Codec.Epub.Parse (getManifest , getSpine)
|
||||
import qualified Codec.Epub.Data.Manifest as DM
|
||||
import qualified Codec.Epub.Data.Spine as DS
|
||||
import Codec.Epub.Parse (getSpine, getMetadata, getManifest)
|
||||
import qualified Codec.Epub.Data.Metadata as DMeta
|
||||
import qualified Codec.Epub.Data.Manifest as DMan
|
||||
import qualified Codec.Epub.Data.Spine as DSpin
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
|
||||
type EpubAction a = ReaderT EpubEnv IO a
|
||||
|
||||
data AppState = AppState
|
||||
{ cEnv :: EpubEnv
|
||||
, cIdx :: Int
|
||||
, zoomlvl :: Double
|
||||
, cSpine :: [FilePath]
|
||||
, bTitle :: T.Text
|
||||
, cTags :: Maybe [Tag T.Text]
|
||||
}
|
||||
|
||||
data EpubEnv = EpubEnv
|
||||
{ archive :: Archive
|
||||
, opfXml :: String
|
||||
, baseDir :: FilePath
|
||||
, bookPath :: FilePath
|
||||
{ archive :: Archive
|
||||
, opfXml :: String
|
||||
, baseDir :: FilePath
|
||||
, bookPath :: FilePath
|
||||
, eMetadata :: DMeta.Metadata
|
||||
, eManifest :: DMan.Manifest
|
||||
}
|
||||
|
||||
openEpub :: FilePath -> IO (Either String EpubEnv)
|
||||
|
|
@ -49,7 +61,22 @@ 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) path
|
||||
|
||||
metaResult <- runExceptT $ getMetadata xml
|
||||
manResult <- runExceptT $ getManifest xml
|
||||
|
||||
case (metaResult, manResult) of
|
||||
(Left err, _) -> pure $ Left $ "Metadata parse error: " ++ err
|
||||
(_, Left err) -> pure $ Left $ "Manifest parse error: " ++ err
|
||||
(Right meta, Right man) ->
|
||||
pure $ Right $ EpubEnv
|
||||
{ archive = arch
|
||||
, opfXml = xml
|
||||
, baseDir = takeDirectory opfPath
|
||||
, bookPath = path
|
||||
, eMetadata = meta
|
||||
, eManifest = man
|
||||
}
|
||||
|
||||
getOpfPath :: Archive -> Maybe FilePath
|
||||
getOpfPath arch =
|
||||
|
|
@ -62,24 +89,17 @@ getRootPath [] = Nothing
|
|||
getRootPath (TagOpen "rootfile" attrs : _) = lookup "full-path" attrs
|
||||
getRootPath (_:xs) = getRootPath xs
|
||||
|
||||
myEnv :: Archive -> FilePath -> String -> FilePath -> EpubEnv
|
||||
myEnv arch opfPath xml path = EpubEnv arch xml (takeDirectory opfPath) path
|
||||
|
||||
resolveSpine :: EpubAction [FilePath]
|
||||
resolveSpine = do
|
||||
env <- ask
|
||||
let xmlStr = opfXml env
|
||||
spineResult <- liftIO $ runExceptT $ getSpine xmlStr
|
||||
let (DMan.Manifest items) = eManifest env
|
||||
|
||||
manifestResult <- liftIO $ runExceptT $ getManifest xmlStr
|
||||
spineResult <- liftIO $ runExceptT $ getSpine xmlStr
|
||||
|
||||
case (manifestResult, spineResult) of
|
||||
(Right (DM.Manifest items), Right (DS.Spine _ refs)) -> do
|
||||
|
||||
let lookupHref ident = DM.mfiHref <$> find (\mi -> DM.mfiId mi == ident) items
|
||||
|
||||
pure [ p | ref <- refs , let ident = DS.siIdRef ref , Just p <- [lookupHref ident] ]
|
||||
|
||||
case spineResult of
|
||||
Right (DSpin.Spine _ refs) -> do
|
||||
let lookupHref ident = DMan.mfiHref <$> find (\mi -> DMan.mfiId mi == ident) items
|
||||
pure [ p | ref <- refs , let ident = DSpin.siIdRef ref , Just p <- [lookupHref ident] ]
|
||||
_ -> pure []
|
||||
|
||||
getChapter :: FilePath -> EpubAction [Tag T.Text]
|
||||
|
|
@ -90,19 +110,16 @@ getChapter filename = do
|
|||
Nothing -> pure []
|
||||
Just e -> do
|
||||
let rawTags = parseTags . TE.decodeUtf8 . B.toStrict $ fromEntry e
|
||||
pure (filterJunk (embedImages env rawTags))
|
||||
|
||||
pure (filterJunk (embedImages (archive env) (baseDir env) rawTags))
|
||||
getMimeFromManifest :: DMan.Manifest -> FilePath -> T.Text
|
||||
getMimeFromManifest (DMan.Manifest items) relPath =
|
||||
case find (\item -> DMan.mfiHref item == relPath) items of
|
||||
Just item -> T.pack $ DMan.mfiMediaType item
|
||||
Nothing -> "image/jpeg"
|
||||
|
||||
getMimeType :: FilePath -> T.Text
|
||||
getMimeType path = T.pack $ "image/" ++ normalizeExt (drop 1 $ takeExtension path)
|
||||
where
|
||||
normalizeExt :: String -> String
|
||||
normalizeExt ext
|
||||
| ext == "jpg" = "jpeg"
|
||||
| otherwise = ext
|
||||
|
||||
embedImages :: Archive -> FilePath -> [Tag T.Text] -> [Tag T.Text]
|
||||
embedImages arch bdir = map processTag
|
||||
embedImages :: EpubEnv -> [Tag T.Text] -> [Tag T.Text]
|
||||
embedImages env = map processTag
|
||||
where
|
||||
processTag (TagOpen "img" attrs) = TagOpen "img" (map replaceSrc attrs)
|
||||
processTag other = other
|
||||
|
|
@ -112,15 +129,14 @@ embedImages arch bdir = map processTag
|
|||
| otherwise = (name, value)
|
||||
|
||||
findImage path =
|
||||
let fullPath = normalise (bdir </> T.unpack path)
|
||||
in case findEntryByPath fullPath arch of
|
||||
let fullPath = normalise (baseDir env </> T.unpack path)
|
||||
in case findEntryByPath fullPath (archive env) of
|
||||
Nothing -> path
|
||||
Just entry ->
|
||||
let rawData = B.toStrict $ fromEntry entry
|
||||
b64 = TE.decodeUtf8 $ B64.encode rawData
|
||||
in "data:" <> getMimeType fullPath <> ";base64," <> b64
|
||||
|
||||
|
||||
mime = getMimeFromManifest (eManifest env) (T.unpack path)
|
||||
in "data:" <> mime <> ";base64," <> b64
|
||||
|
||||
filterJunk :: [Tag T.Text] -> [Tag T.Text]
|
||||
filterJunk = go
|
||||
|
|
@ -134,14 +150,11 @@ filterJunk = go
|
|||
dropUntilClose name (TagClose n : xs) | n == name = xs
|
||||
dropUntilClose name (_ : xs) = dropUntilClose name xs
|
||||
|
||||
-- TODO: Implement this, as it's not called yet
|
||||
getChapterTitle :: [Tag T.Text] -> T.Text
|
||||
getChapterTitle tags =
|
||||
case dropWhile (not . ishding) tags of
|
||||
(TagOpen x _ : xs ) -> T.strip $ innerText (takeWhile (not . isclose x) xs) -- The heading content, the outer tags will be detected such as h1 but this makes sure that every other inner tag is ignored yet the inner text will still be visible
|
||||
|
||||
(TagOpen x _ : xs ) -> T.strip $ innerText (takeWhile (not . isclose x) xs)
|
||||
_ -> "Untitled Chapter"
|
||||
|
||||
where
|
||||
ishding (TagOpen n _ ) = n `elem` ["h1", "h2", "h3"]
|
||||
ishding _ = False
|
||||
|
|
|
|||
16
app/Main.hs
16
app/Main.hs
|
|
@ -6,11 +6,11 @@ import UI (runApp)
|
|||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
case args of
|
||||
[path] -> do
|
||||
result <- openEpub path
|
||||
case result of
|
||||
Left err -> putStrLn $ "Error: " ++ err
|
||||
Right env -> runApp env
|
||||
_ -> putStrLn "Usage: svitak <file.epub>"
|
||||
args <- getArgs
|
||||
case args of
|
||||
[path] -> do
|
||||
result <- openEpub path
|
||||
case result of
|
||||
Left err -> putStrLn $ "Error: " ++ err
|
||||
Right env -> runApp env
|
||||
_ -> putStrLn "Usage: svitak <file.epub>"
|
||||
|
|
|
|||
135
app/UI.hs
135
app/UI.hs
|
|
@ -1,72 +1,115 @@
|
|||
{-# 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
|
||||
import qualified GI.WebKit as WebKit
|
||||
import qualified GI.Gtk.Enums as GtkEnums
|
||||
import qualified Data.Text as T
|
||||
|
||||
import Data.List (find)
|
||||
import Data.GI.Base (AttrOp(..))
|
||||
import Control.Monad.Reader (runReaderT)
|
||||
import Control.Concurrent.MVar (newMVar, readMVar, swapMVar)
|
||||
import Text.HTML.TagSoup (renderTags)
|
||||
|
||||
import EpubParser (EpubEnv(..), resolveSpine, getChapter, getChapterTitle)
|
||||
import Codec.Epub.Data.Metadata (metaTitles, titleType, titleText)
|
||||
import EpubParser (EpubEnv(..), AppState(..), resolveSpine, getChapter, getChapterTitle)
|
||||
import Persistence (saveLastRead, loadLastRead)
|
||||
|
||||
runApp :: EpubEnv -> IO ()
|
||||
runApp env = do
|
||||
app <- Gtk.applicationNew (Just "com.svitak.reader.v2") []
|
||||
runApp env' = do
|
||||
app <- Gtk.applicationNew (Just "com.svitak.reader.v2") []
|
||||
|
||||
_ <- Gtk.on app #activate $ do
|
||||
window <- Gtk.applicationWindowNew app
|
||||
Gtk.windowSetDefaultSize window 800 600
|
||||
|
||||
webView <- WebKit.webViewNew
|
||||
Gtk.windowSetChild window (Just webView)
|
||||
_ <- Gtk.on app #activate $ do
|
||||
ispine <- runReaderT resolveSpine env'
|
||||
|
||||
let titles = metaTitles (eMetadata env')
|
||||
|
||||
spine <- runReaderT resolveSpine env
|
||||
let totalChapters = length spine
|
||||
-- checks for the title marked as main otherwise takes the first one
|
||||
let rawTitle = case find (\t -> titleType t == Just "main") titles of
|
||||
Just t -> titleText t
|
||||
Nothing -> if null titles then "Unknown Book" else titleText (head titles)
|
||||
|
||||
if totalChapters == 0
|
||||
then Gtk.windowSetTitle window (Just "Svitak - No Chapters Found")
|
||||
else do
|
||||
let initState = AppState
|
||||
{ cEnv = env'
|
||||
, cIdx = 0
|
||||
, cTags = Nothing
|
||||
, cSpine = ispine
|
||||
, bTitle = T.pack rawTitle
|
||||
, zoomlvl = 1.0
|
||||
}
|
||||
|
||||
-- LoadChapter is now inside the 'else' do-block
|
||||
let loadChapter index = do
|
||||
let maxIdx = totalChapters - 1
|
||||
let safeIdx = max 0 (min index maxIdx)
|
||||
|
||||
writeIORef currentIndex safeIdx
|
||||
saveLastRead (bookPath env) safeIdx
|
||||
stateMVar <- newMVar initState
|
||||
|
||||
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:///")
|
||||
window <- Gtk.applicationWindowNew app
|
||||
webView <- WebKit.webViewNew
|
||||
|
||||
maybeSaved <- loadLastRead
|
||||
case maybeSaved of
|
||||
Just (path, idx) | path == bookPath env -> loadChapter idx
|
||||
_ -> loadChapter 0
|
||||
Gtk.set window [#defaultWidth := 800 , #defaultHeight := 600 , #child := webView]
|
||||
|
||||
keyCtrl <- Gtk.eventControllerKeyNew
|
||||
Gtk.eventControllerSetPropagationPhase keyCtrl GtkEnums.PropagationPhaseCapture
|
||||
|
||||
_ <- Gtk.on keyCtrl #keyPressed $ \keyval _ _ -> do
|
||||
curr <- readIORef currentIndex
|
||||
case keyval of
|
||||
Gdk.KEY_Right -> loadChapter (curr + 1) >> return True
|
||||
Gdk.KEY_Left -> loadChapter (curr - 1) >> return True
|
||||
_ -> return False
|
||||
let loadChapter index = do
|
||||
st <- readMVar stateMVar
|
||||
let env = cEnv st
|
||||
let spine = cSpine st
|
||||
|
||||
if null spine
|
||||
then Gtk.set window [ #title := "Svitak - Empty Book" ]
|
||||
else do
|
||||
let safeIdx = max 0 (min index (length spine - 1))
|
||||
let filename = spine !! safeIdx
|
||||
|
||||
Gtk.widgetAddController window keyCtrl
|
||||
newTags <- runReaderT (getChapter filename) env
|
||||
|
||||
#present window
|
||||
let newState = st { cIdx = safeIdx, cTags = Just newTags }
|
||||
_ <- swapMVar stateMVar newState
|
||||
|
||||
_ <- Gio.applicationRun app Nothing
|
||||
return ()
|
||||
saveLastRead (bookPath env) safeIdx
|
||||
|
||||
let chapterTitle = getChapterTitle newTags
|
||||
Gtk.set window [ #title := (bTitle st <> " - " <> chapterTitle) ]
|
||||
|
||||
WebKit.webViewLoadHtml webView (renderTags newTags) Nothing
|
||||
|
||||
-- loading progress
|
||||
st1 <- readMVar stateMVar
|
||||
let env = cEnv st1
|
||||
let spine = cSpine st1
|
||||
|
||||
if null spine
|
||||
then Gtk.set window [#title := "Svitak - No Chapters Found"]
|
||||
else do
|
||||
maybeSaved <- loadLastRead
|
||||
case maybeSaved of
|
||||
Just (path, idx) | path == bookPath env -> loadChapter idx
|
||||
_ -> loadChapter 0
|
||||
|
||||
-- keyboard handling
|
||||
keyCtrl <- Gtk.eventControllerKeyNew
|
||||
Gtk.eventControllerSetPropagationPhase keyCtrl GtkEnums.PropagationPhaseCapture
|
||||
|
||||
_ <- Gtk.on keyCtrl #keyPressed $ \keyval _ _ -> do
|
||||
stNow <- readMVar stateMVar
|
||||
let curr = cIdx stNow
|
||||
let z = zoomlvl stNow
|
||||
case keyval of
|
||||
Gdk.KEY_Right -> loadChapter (curr + 1) >> pure True
|
||||
Gdk.KEY_Left -> loadChapter (curr - 1) >> pure True
|
||||
Gdk.KEY_equal -> do
|
||||
let newZ = z + 0.1
|
||||
_ <- swapMVar stateMVar stNow { zoomlvl = newZ }
|
||||
WebKit.webViewSetZoomLevel webView newZ
|
||||
pure True
|
||||
Gdk.KEY_minus -> do
|
||||
let newZ = max 0.1 (z - 0.1)
|
||||
_ <- swapMVar stateMVar stNow { zoomlvl = newZ }
|
||||
WebKit.webViewSetZoomLevel webView newZ
|
||||
pure True
|
||||
_ -> pure False
|
||||
|
||||
Gtk.widgetAddController window keyCtrl
|
||||
#present window
|
||||
|
||||
_ <- Gio.applicationRun app Nothing
|
||||
pure ()
|
||||
|
|
|
|||
Loading…
Reference in a new issue