Integrate parsing backend with gtk. TODO: Base64 image embedding for image compatibility
This commit is contained in:
parent
adfc94e352
commit
b666d8477f
3 changed files with 72 additions and 70 deletions
|
|
@ -11,13 +11,13 @@ module EpubParser
|
|||
, Tag(..)
|
||||
) where
|
||||
|
||||
import Codec.Archive.Zip ( Archive, findEntryByPath, fromEntry, toArchive )
|
||||
import Codec.Archive.Zip (Archive, findEntryByPath, fromEntry, toArchive)
|
||||
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
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 (ExceptT, runExceptT)
|
||||
import Control.Monad.Except (runExceptT)
|
||||
import Text.HTML.TagSoup (parseTags, Tag(..))
|
||||
import System.FilePath (takeDirectory, (</>), normalise)
|
||||
import Data.List (find)
|
||||
|
|
@ -29,60 +29,60 @@ import qualified Codec.Epub.Data.Spine as DS
|
|||
type EpubAction a = ReaderT EpubEnv IO a
|
||||
|
||||
data EpubEnv = EpubEnv
|
||||
{ archive :: Archive
|
||||
, opfXml :: String
|
||||
, baseDir :: FilePath
|
||||
}
|
||||
{ archive :: Archive
|
||||
, opfXml :: String
|
||||
, baseDir :: FilePath
|
||||
}
|
||||
|
||||
openEpub :: FilePath -> IO (Either String EpubEnv)
|
||||
openEpub path = do
|
||||
rawZip <- B.readFile path
|
||||
let arch = toArchive rawZip
|
||||
rawZip <- B.readFile path
|
||||
let arch = toArchive rawZip
|
||||
|
||||
case getOpfPath arch of
|
||||
Nothing -> pure $ Left "Could not find OPF path"
|
||||
Just opfPath ->
|
||||
case findEntryByPath opfPath arch of
|
||||
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)
|
||||
case getOpfPath arch of
|
||||
Nothing -> pure $ Left "Could not find OPF path"
|
||||
Just opfPath ->
|
||||
case findEntryByPath opfPath arch of
|
||||
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)
|
||||
|
||||
getOpfPath :: Archive -> Maybe FilePath
|
||||
getOpfPath arch =
|
||||
case findEntryByPath "META-INF/container.xml" arch of
|
||||
Nothing -> Nothing
|
||||
Just entry -> getRootPath (parseTags . T.unpack . TE.decodeUtf8 . B.toStrict $ fromEntry entry)
|
||||
case findEntryByPath "META-INF/container.xml" arch of
|
||||
Nothing -> Nothing
|
||||
Just entry -> getRootPath (parseTags . T.unpack . TE.decodeUtf8 . B.toStrict $ fromEntry entry)
|
||||
|
||||
getRootPath :: [Tag String] -> Maybe FilePath
|
||||
getRootPath [] = Nothing
|
||||
getRootPath (TagOpen "rootfile" attrs : _) = lookup "full-path" attrs
|
||||
getRootPath (_ : xs) = getRootPath xs
|
||||
getRootPath (_:xs) = getRootPath xs
|
||||
|
||||
myEnv :: Archive -> FilePath -> String -> EpubEnv
|
||||
myEnv arch opfPath xml = EpubEnv arch xml (takeDirectory opfPath)
|
||||
|
||||
resolveSpine :: EpubAction [FilePath]
|
||||
resolveSpine = do
|
||||
env <- ask
|
||||
let xmlStr = opfXml env
|
||||
env <- ask
|
||||
let xmlStr = opfXml env
|
||||
|
||||
manifestResult <- liftIO $ runExceptT $ getManifest xmlStr
|
||||
spineResult <- liftIO $ runExceptT $ getSpine xmlStr
|
||||
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
|
||||
case (manifestResult, spineResult) of
|
||||
(Right (DM.Manifest items), Right (DS.Spine _ refs)) -> do
|
||||
|
||||
pure [ p | ref <- refs , let ident = DS.siIdRef ref , Just p <- [lookupHref ident] ]
|
||||
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] ]
|
||||
|
||||
_ -> pure []
|
||||
_ -> pure []
|
||||
|
||||
getChapter :: FilePath -> EpubAction [Tag T.Text]
|
||||
getChapter filename = do
|
||||
env <- ask
|
||||
let full = normalise (baseDir env </> filename)
|
||||
case findEntryByPath full (archive env) of
|
||||
Nothing -> pure []
|
||||
Just e -> pure $ parseTags . TE.decodeUtf8 . B.toStrict $ fromEntry e
|
||||
env <- ask
|
||||
let full = normalise (baseDir env </> filename)
|
||||
case findEntryByPath full (archive env) of
|
||||
Nothing -> pure []
|
||||
Just e -> pure $ parseTags . TE.decodeUtf8 . B.toStrict $ fromEntry e
|
||||
|
|
|
|||
30
app/Gui.hs
30
app/Gui.hs
|
|
@ -4,18 +4,28 @@ module Gui (runWindow) where
|
|||
|
||||
import qualified GI.Gtk as Gtk
|
||||
import qualified GI.Gio as Gio
|
||||
import qualified GI.WebKit as WebKit
|
||||
import qualified Data.Text as T
|
||||
|
||||
runWindow :: IO ()
|
||||
runWindow = do
|
||||
runWindow :: String -> IO ()
|
||||
runWindow htmlContent = do
|
||||
|
||||
app <- Gtk.applicationNew (Just "com.svitak.reader") []
|
||||
app <- Gtk.applicationNew (Just "com.svitak.reader") []
|
||||
|
||||
_ <- Gtk.on app #activate $ do
|
||||
_ <- Gtk.on app #activate $ do
|
||||
|
||||
window <- Gtk.applicationWindowNew app
|
||||
Gtk.windowSetTitle window (Just "Svitak Reader (GTK 4)")
|
||||
Gtk.windowSetDefaultSize window 800 600
|
||||
#present window
|
||||
window <- Gtk.applicationWindowNew app
|
||||
Gtk.windowSetTitle window (Just "Svitak Reader (GTK 4)")
|
||||
|
||||
_ <- Gio.applicationRun app Nothing
|
||||
return ()
|
||||
Gtk.windowSetDefaultSize window 800 600
|
||||
|
||||
webView <- WebKit.webViewNew
|
||||
|
||||
WebKit.webViewLoadHtml webView (T.pack htmlContent) (Just "file:///")
|
||||
|
||||
Gtk.windowSetChild window (Just webView)
|
||||
|
||||
#present window
|
||||
|
||||
_ <- Gio.applicationRun app Nothing
|
||||
pure ()
|
||||
|
|
|
|||
38
app/Main.hs
38
app/Main.hs
|
|
@ -1,9 +1,11 @@
|
|||
module Main (main) where
|
||||
|
||||
import System.Environment (getArgs)
|
||||
import Control.Monad.Reader (runReaderT, liftIO)
|
||||
import EpubParser (EpubAction, openEpub, resolveSpine, getChapter)
|
||||
import Control.Monad.Reader (runReaderT)
|
||||
import EpubParser (EpubAction, openEpub, resolveSpine, getChapter)
|
||||
import Gui (runWindow)
|
||||
import qualified Data.Text as T
|
||||
import Text.HTML.TagSoup (renderTags)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
|
@ -11,7 +13,7 @@ main = do
|
|||
case args of
|
||||
[] -> do
|
||||
putStrLn "Starting GUI..."
|
||||
runWindow -- This is just for testing GTK works, useless for now.
|
||||
runWindow "<h1>Welcome to Svitak</h1><p>Please input an epub file.</p>"
|
||||
|
||||
(path:_) -> runSvitak path
|
||||
|
||||
|
|
@ -21,25 +23,15 @@ runSvitak path = do
|
|||
case result of
|
||||
Left err -> putStrLn $ "Error: " ++ err
|
||||
Right env -> do
|
||||
runReaderT prntCh env
|
||||
htmlContent <- runReaderT loadBook env
|
||||
runWindow htmlContent
|
||||
|
||||
prntCh :: EpubAction ()
|
||||
prntCh = do
|
||||
chapterPaths <- resolveSpine
|
||||
|
||||
loadBook :: EpubAction String
|
||||
loadBook = do
|
||||
spine <- resolveSpine
|
||||
case spine of
|
||||
[] -> pure "<h1>No chapters found</h1>"
|
||||
(firstChapter:_) -> do
|
||||
tags <- getChapter firstChapter
|
||||
pure $ T.unpack $ renderTags tags
|
||||
|
||||
liftIO $ putStrLn $ "Spine resolved: " ++ show chapterPaths -- Print the found chapter paths for debugging
|
||||
|
||||
findText chapterPaths
|
||||
|
||||
where
|
||||
findText [] = liftIO $ putStrLn "No chapters found in spine."
|
||||
findText (p:ps) = do
|
||||
liftIO $ putStrLn $ "\n--- Checking Chapter: " ++ p ++ " ---"
|
||||
tags <- getChapter p
|
||||
|
||||
if null tags
|
||||
then findText ps
|
||||
else do
|
||||
liftIO $ mapM_ print tags -- Each tag has a new line, only print the first one for testing
|
||||
pure ()
|
||||
|
|
|
|||
Loading…
Reference in a new issue