Implement epub metadata module to the backend
This commit is contained in:
parent
609024f30e
commit
747c9183a9
4 changed files with 98 additions and 71 deletions
|
|
@ -5,81 +5,88 @@ module EpubParser
|
|||
, EpubEnv(..)
|
||||
, openEpub
|
||||
, getOpfPath
|
||||
, getOpfTags
|
||||
, myEnv
|
||||
, resolveSpine
|
||||
, getChapter
|
||||
, Tag(..)
|
||||
) where
|
||||
|
||||
import Codec.Archive.Zip ( findEntryByPath, fromEntry, toArchive, Archive )
|
||||
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) )
|
||||
import Text.HTML.TagSoup ( parseTags, Tag(..) )
|
||||
import Control.Monad.Reader (ReaderT, MonadReader(ask), liftIO)
|
||||
import Control.Monad.Except (ExceptT, runExceptT)
|
||||
import Text.HTML.TagSoup (parseTags, Tag(..))
|
||||
import System.FilePath (takeDirectory, (</>), normalise)
|
||||
import Data.Maybe (mapMaybe, isJust)
|
||||
import Data.List (find)
|
||||
|
||||
-- epub-metadata parse API
|
||||
import Codec.Epub.Parse (getManifest , getSpine)
|
||||
|
||||
import qualified Codec.Epub.Data.Manifest as DM
|
||||
import qualified Codec.Epub.Data.Spine as DS
|
||||
|
||||
type EpubAction a = ReaderT EpubEnv IO a
|
||||
|
||||
data EpubEnv = EpubEnv
|
||||
{ archive :: Archive
|
||||
, manifest :: [Tag String]
|
||||
, baseDir :: FilePath
|
||||
{ archive :: Archive
|
||||
, opfXml :: String
|
||||
, baseDir :: FilePath
|
||||
}
|
||||
|
||||
openEpub :: FilePath -> IO (Either String Archive)
|
||||
openEpub :: FilePath -> IO (Either String EpubEnv)
|
||||
openEpub path = do
|
||||
entry <- B.readFile path
|
||||
return $ Right (toArchive entry)
|
||||
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)
|
||||
|
||||
getOpfPath :: Archive -> Maybe FilePath
|
||||
getOpfPath arch =
|
||||
case findEntryByPath "META-INF/container.xml" arch of
|
||||
Nothing -> Nothing
|
||||
Just entry ->
|
||||
let content = TE.decodeUtf8 $ B.toStrict $ fromEntry entry
|
||||
tags = parseTags (T.unpack content)
|
||||
in getRootPath tags
|
||||
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
|
||||
|
||||
getOpfTags :: Archive -> FilePath -> [Tag String]
|
||||
getOpfTags arch opfPath =
|
||||
case findEntryByPath opfPath arch of
|
||||
Nothing -> []
|
||||
Just entry -> parseTags $ T.unpack $ TE.decodeUtf8 $ B.toStrict $ fromEntry entry
|
||||
|
||||
myEnv :: Archive -> FilePath -> [Tag String] -> EpubEnv
|
||||
myEnv arch opfPath tags = EpubEnv arch tags (takeDirectory opfPath)
|
||||
myEnv :: Archive -> FilePath -> String -> EpubEnv
|
||||
myEnv arch opfPath xml =
|
||||
EpubEnv arch xml (takeDirectory opfPath)
|
||||
|
||||
resolveSpine :: EpubAction [FilePath]
|
||||
resolveSpine = do
|
||||
env <- ask
|
||||
let tags = manifest env
|
||||
let itemRefs = [ idRef | TagOpen "itemref" attrs <- tags, let idRef = lookup "idref" attrs, isJust $ Just idRef ]
|
||||
let xmlStr = opfXml env
|
||||
|
||||
pure $ mapMaybe (findFileById tags) itemRefs
|
||||
manifestResult <- liftIO $ runExceptT $ getManifest xmlStr
|
||||
spineResult <- liftIO $ runExceptT $ getSpine xmlStr
|
||||
|
||||
findFileById :: [Tag String] -> Maybe String -> Maybe FilePath
|
||||
findFileById _ Nothing = Nothing
|
||||
findFileById tags (Just myId) =
|
||||
let matches = [ href | TagOpen "item" attrs <- tags, lookup "id" attrs == Just myId, let href = lookup "href" attrs ]
|
||||
in case matches of
|
||||
(x:_) -> x
|
||||
[] -> Nothing
|
||||
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] ]
|
||||
|
||||
_ -> pure []
|
||||
|
||||
getChapter :: FilePath -> EpubAction [Tag T.Text]
|
||||
getChapter filename = do
|
||||
env <- ask
|
||||
let fullPath = normalise $ baseDir env </> filename
|
||||
|
||||
let fileEntry = findEntryByPath fullPath (archive env)
|
||||
case fileEntry of
|
||||
Nothing -> pure []
|
||||
Just file -> do
|
||||
|
||||
pure $ parseTags $ TE.decodeUtf8 $ B.toStrict $ fromEntry file
|
||||
let full = normalise (baseDir env </> filename)
|
||||
case findEntryByPath full (archive env) of
|
||||
Nothing -> pure []
|
||||
Just e -> pure $ parseTags . TE.decodeUtf8 . B.toStrict $ fromEntry e
|
||||
|
|
|
|||
21
app/Gui.hs
Normal file
21
app/Gui.hs
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
{-# LANGUAGE OverloadedStrings, OverloadedLabels #-}
|
||||
|
||||
module Gui (runWindow) where
|
||||
|
||||
import qualified GI.Gtk as Gtk
|
||||
import qualified GI.Gio as Gio
|
||||
|
||||
runWindow :: IO ()
|
||||
runWindow = do
|
||||
|
||||
app <- Gtk.applicationNew (Just "com.svitak.reader") []
|
||||
|
||||
_ <- Gtk.on app #activate $ do
|
||||
|
||||
window <- Gtk.applicationWindowNew app
|
||||
Gtk.windowSetTitle window (Just "Svitak Reader (GTK 4)")
|
||||
Gtk.windowSetDefaultSize window 800 600
|
||||
#present window
|
||||
|
||||
_ <- Gio.applicationRun app Nothing
|
||||
return ()
|
||||
49
app/Main.hs
49
app/Main.hs
|
|
@ -2,49 +2,44 @@ module Main (main) where
|
|||
|
||||
import System.Environment (getArgs)
|
||||
import Control.Monad.Reader (runReaderT, liftIO)
|
||||
import EpubParser
|
||||
import qualified Data.Text.IO as TIO
|
||||
import qualified Data.Text as T
|
||||
import EpubParser (EpubAction, openEpub, resolveSpine, getChapter)
|
||||
import Gui (runWindow)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
case args of
|
||||
[] -> putStrLn "Usage: svitak <file.epub>"
|
||||
[] -> do
|
||||
putStrLn "Starting GUI..."
|
||||
runWindow -- This is just for testing GTK works, useless for now.
|
||||
|
||||
(path:_) -> runSvitak path
|
||||
|
||||
runSvitak :: FilePath -> IO ()
|
||||
runSvitak path = do
|
||||
result <- openEpub path
|
||||
case result of
|
||||
Left err -> putStrLn err
|
||||
Right arch -> do
|
||||
let maybeOpfPath = getOpfPath arch
|
||||
case maybeOpfPath of
|
||||
Nothing -> putStrLn "Error: Could not find OPF metadata file."
|
||||
Just opfPath -> do
|
||||
let tags = getOpfTags arch opfPath
|
||||
Left err -> putStrLn $ "Error: " ++ err
|
||||
Right env -> do
|
||||
runReaderT prntCh env
|
||||
|
||||
let env = myEnv arch opfPath tags
|
||||
|
||||
runReaderT printFirstRealChapter env
|
||||
|
||||
printFirstRealChapter :: EpubAction ()
|
||||
printFirstRealChapter = do
|
||||
prntCh :: EpubAction ()
|
||||
prntCh = do
|
||||
chapterPaths <- resolveSpine
|
||||
|
||||
|
||||
liftIO $ putStrLn $ "Spine resolved: " ++ show chapterPaths -- Print the found chapter paths for debugging
|
||||
|
||||
findText chapterPaths
|
||||
|
||||
where
|
||||
findText [] = liftIO $ putStrLn "End of book!"
|
||||
findText [] = liftIO $ putStrLn "No chapters found in spine."
|
||||
findText (p:ps) = do
|
||||
liftIO $ putStrLn $ "Checking: " ++ p ++ "..."
|
||||
text <- getChapter p
|
||||
let cleanText = T.strip text
|
||||
|
||||
if T.null cleanText
|
||||
liftIO $ putStrLn $ "\n--- Checking Chapter: " ++ p ++ " ---"
|
||||
tags <- getChapter p
|
||||
|
||||
if null tags
|
||||
then findText ps
|
||||
else do
|
||||
liftIO $ putStrLn "\n Found text:"
|
||||
liftIO $ putStrLn "--------------------------------"
|
||||
liftIO $ TIO.putStrLn $ T.take 500 cleanText
|
||||
liftIO $ putStrLn "..."
|
||||
liftIO $ mapM_ print tags -- Each tag has a new line, only print the first one for testing
|
||||
pure ()
|
||||
|
|
|
|||
|
|
@ -57,7 +57,8 @@ executable svitak
|
|||
import: warnings
|
||||
main-is: Main.hs
|
||||
|
||||
other-modules: EpubParser
|
||||
other-modules: EpubParser,
|
||||
Gui
|
||||
|
||||
build-depends: base ^>=4.21.0.0,
|
||||
bytestring >= 0.12.2.0,
|
||||
|
|
@ -68,7 +69,10 @@ executable svitak
|
|||
scalpel >= 0.6.2.2,
|
||||
tagsoup,
|
||||
text >= 2.1.2,
|
||||
zip-archive >= 0.4.3.2
|
||||
zip-archive >= 0.4.3.2,
|
||||
gi-gtk >= 4.0,
|
||||
gi-gio,
|
||||
haskell-gi-base
|
||||
|
||||
hs-source-dirs: app
|
||||
default-language: Haskell2010
|
||||
|
|
|
|||
Loading…
Reference in a new issue