Add image rendering alongside automatic mimetype detection

app/EpubParser.hs

@@ -19,12 +19,13 @@ 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)
+import System.FilePath (takeDirectory, (</>), normalise, takeExtension)
 import Data.List (find)
 
 import Codec.Epub.Parse (getManifest , getSpine)
 import qualified Codec.Epub.Data.Manifest as DM
 import qualified Codec.Epub.Data.Spine    as DS
+import qualified Data.ByteString.Base64 as B64
 
 type EpubAction a = ReaderT EpubEnv IO a
 
@@ -85,4 +86,32 @@ getChapter filename = do
   let full = normalise (baseDir env </> filename)
   case findEntryByPath full (archive env) of
     Nothing -> pure []
-    Just e  -> pure $ parseTags . TE.decodeUtf8 . B.toStrict $ fromEntry e
+    Just e  -> do
+      pure $ embedImages (archive env) (baseDir env) (parseTags . TE.decodeUtf8 . B.toStrict $ fromEntry e) -- The base64 img
+
+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 
+  where
+    processTag (TagOpen "img" attrs) = TagOpen "img" (map replaceSrc attrs)
+    processTag other                 = other
+
+    replaceSrc (name, value)
+      | name == "src" = ("src", findImage value)
+      | otherwise     = (name, value)
+
+    findImage path =
+      let fullPath = normalise (bdir </> T.unpack path)
+      in case findEntryByPath fullPath arch of
+           Nothing -> path
+           Just entry ->
+             let rawData = B.toStrict $ fromEntry entry
+                 b64 = TE.decodeUtf8 $ B64.encode rawData
+             in "data:" <> getMimeType fullPath <> ";base64," <> b64 

app/Gui.hs

@@ -15,7 +15,7 @@ runWindow htmlContent = do
   _ <- Gtk.on app #activate $ do
 
     window <- Gtk.applicationWindowNew app
-    Gtk.windowSetTitle window (Just "Svitak Reader (GTK 4)")
+    Gtk.windowSetTitle window (Just "Svitak")
 
     Gtk.windowSetDefaultSize window 800 600
 

svitak.cabal

@@ -73,7 +73,8 @@ executable svitak
                       gi-gtk == 4.0.*,
                       gi-webkit == 6.0.*,
                       gi-gio,
-                      haskell-gi-base
+                      haskell-gi-base,
+                      base64-bytestring
 
     hs-source-dirs:   app
     default-language: Haskell2010