Implement epub metadata module to the backend

app/EpubParser.hs

@@ -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 Control.Monad.Reader (ReaderT, MonadReader(ask), liftIO)
-import Text.HTML.TagSoup ( parseTags, Tag(..) )
+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]
+    , opfXml  :: String
     , baseDir :: FilePath
     }
 
-openEpub :: FilePath -> IO (Either String Archive)
+openEpub :: FilePath -> IO (Either String EpubEnv)
 openEpub path = do
-    entry <- B.readFile path
+    rawZip <- B.readFile path
-    return $ Right (toArchive entry)
+    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 ->
+        Just entry -> getRootPath (parseTags . T.unpack . TE.decodeUtf8 . B.toStrict $ fromEntry entry)
-            let content = TE.decodeUtf8 $ B.toStrict $ fromEntry entry
-                tags    = parseTags (T.unpack content)
-            in getRootPath tags
 
 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]
+myEnv :: Archive -> FilePath -> String -> EpubEnv
-getOpfTags arch opfPath =
+myEnv arch opfPath xml =
-    case findEntryByPath opfPath arch of
+    EpubEnv arch xml (takeDirectory opfPath)
-        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)
 
 resolveSpine :: EpubAction [FilePath]
 resolveSpine = do
     env <- ask
-    let tags = manifest env
+    let xmlStr = opfXml env
-    let itemRefs = [ idRef | TagOpen "itemref" attrs <- tags, let idRef = lookup "idref" attrs, isJust $ Just idRef ]
 
-    pure $ mapMaybe (findFileById tags) itemRefs
+    manifestResult <- liftIO $ runExceptT $ getManifest xmlStr
+    spineResult    <- liftIO $ runExceptT $ getSpine xmlStr
 
-findFileById :: [Tag String] -> Maybe String -> Maybe FilePath
+    case (manifestResult, spineResult) of
-findFileById _ Nothing = Nothing
+        (Right (DM.Manifest items), Right (DS.Spine _ refs)) -> do
-findFileById tags (Just myId) =
+            
-    let matches = [ href | TagOpen "item" attrs <- tags, lookup "id" attrs == Just myId, let href = lookup "href" attrs ]
+            let lookupHref ident = DM.mfiHref <$> find (\mi -> DM.mfiId mi == ident) items
-    in case matches of
+
-        (x:_) -> x
+            pure [ p | ref <- refs , let ident = DS.siIdRef ref , Just p <- [lookupHref ident] ]
-        [] -> Nothing
+                     
+        _ -> pure []
 
 getChapter :: FilePath -> EpubAction [Tag T.Text]
 getChapter filename = do
     env <- ask
-    let fullPath = normalise $ baseDir env </> filename
+    let full = normalise (baseDir env </> filename)
-    
+    case findEntryByPath full (archive env) of
-    let fileEntry = findEntryByPath fullPath (archive env)
-    case fileEntry of
         Nothing -> pure []
-        Just file -> do
+        Just e  -> pure $ parseTags . TE.decodeUtf8 . B.toStrict $ fromEntry e
-
-          pure $ parseTags $ TE.decodeUtf8 $ B.toStrict $ fromEntry file

app/Gui.hs

@@ -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 ()

app/Main.hs

@@ -2,49 +2,44 @@ module Main (main) where
 
 import System.Environment (getArgs)
 import Control.Monad.Reader (runReaderT, liftIO)
-import EpubParser
+import EpubParser (EpubAction, openEpub, resolveSpine, getChapter) 
-import qualified Data.Text.IO as TIO
+import Gui (runWindow)
-import qualified Data.Text as T
+
 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
+    Left err -> putStrLn $ "Error: " ++ err
-    Right arch -> do
+    Right env -> do
-      let maybeOpfPath = getOpfPath arch
+      runReaderT prntCh env
-      case maybeOpfPath of
-        Nothing -> putStrLn "Error: Could not find OPF metadata file."
-        Just opfPath -> do
-                  let tags = getOpfTags arch opfPath
 
-                  let env = myEnv arch opfPath tags
+prntCh :: EpubAction ()
-
+prntCh = do
-                  runReaderT printFirstRealChapter env
-
-printFirstRealChapter :: EpubAction ()
-printFirstRealChapter = 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 ++ "..."
+      liftIO $ putStrLn $ "\n--- Checking Chapter: " ++ p ++ " ---"
-      text <- getChapter p
+      tags <- getChapter p
-      let cleanText = T.strip text
 
-      if T.null cleanText
+      if null tags 
         then findText ps
         else do
-          liftIO $ putStrLn "\n Found text:"
+          liftIO $ mapM_ print tags          -- Each tag has a new line, only print the first one for testing
-          liftIO $ putStrLn "--------------------------------"
+          pure ()
-          liftIO $ TIO.putStrLn $ T.take 500 cleanText
-          liftIO $ putStrLn "..."

svitak.cabal

@@ -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