replace tagsoup with scalpel

app/EpubParser.hs

@@ -7,8 +7,6 @@ module EpubParser
     getOpfPath,
     resolveSpine,
     getChapter,
-    getChapterTitle,
-    Tag (..),
   )
 where
 
@@ -21,14 +19,14 @@ import Control.Monad.Reader (MonadReader (ask), liftIO)
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Lazy as B
 import Data.List (find)
+import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import System.FilePath (normalise, takeDirectory, (</>))
 import Text.HTML.Scalpel (Scraper, ScraperT, anySelector, attr, chroot, chroots, html, innerHTML, scrapeStringLike, text)
-import Text.HTML.TagSoup (Tag (..), parseTags, renderTags)
 import Control.Applicative ((<|>))
-import Types (EpubEnv(..), EpubAction)
-
+import Types (EpubEnv(..), EpubAction, Chapter(..))
+import Control.Monad (guard)
 
 openEpub :: FilePath -> IO (Either String EpubEnv)
 openEpub path = do
@@ -61,16 +59,15 @@ openEpub path = do
                       eManifest = man
                     }
 
-getOpfPath :: Archive -> Maybe FilePath
+getOpfPath :: Archive -> Maybe String
 getOpfPath arch =
   case findEntryByPath "META-INF/container.xml" arch of
     Nothing -> Nothing
-    Just entry -> getRootPath (parseTags . T.unpack . TE.decodeUtf8 . B.toStrict $ fromEntry entry)
+    Just entry -> getRootPath (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 :: T.Text -> Maybe String
+getRootPath rawhtml =
+  scrapeStringLike rawhtml $ T.unpack <$> attr "full-path" "rootfile"
 
 resolveSpine :: EpubAction [FilePath]
 resolveSpine = do
@@ -85,15 +82,21 @@ resolveSpine = do
       pure [p | ref <- refs, let ident = DSpin.siIdRef ref, Just p <- [lookupHref ident]]
     _ -> pure []
 
-getChapter :: FilePath -> EpubAction [Tag T.Text]
-getChapter filename = do
+getChapter :: FilePath -> Int -> EpubAction Chapter
+getChapter filename idx = do
   env <- ask
   let full = normalise (baseDir env </> filename)
   case findEntryByPath full (archive env) of
-    Nothing -> pure []
+    Nothing -> pure $ Chapter "Missing" "" idx
     Just e -> do
-      let rawTags = parseTags . TE.decodeUtf8 . B.toStrict $ fromEntry e
-      pure (filterJunk (embedImages env rawTags))
+      let rawText = TE.decodeUtf8 . B.toStrict $ fromEntry e
+      let withImages = embedImages env rawText
+
+      let (title, content) =
+            fromMaybe ("Chapter " <> T.pack (show idx), "") $
+              scrapeStringLike withImages chapterScraper
+
+      pure $ Chapter title content idx
 
 getMimeFromManifest :: DMan.Manifest -> FilePath -> T.Text
 getMimeFromManifest (DMan.Manifest items) relPath =
@@ -101,45 +104,37 @@ getMimeFromManifest (DMan.Manifest items) relPath =
     Just item -> T.pack $ DMan.mfiMediaType item
     Nothing -> "image/jpeg"
 
--- Replace img tags with base64
-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
+-- translate a file path into base64 then formats it like "data:image/jpeg;<base64 string>"
+findImage :: EpubEnv -> T.Text -> T.Text
+findImage env path =
+  let fullPath = normalise (baseDir env </> T.unpack path)
+   in case findEntryByPath fullPath (archive env) of
+        Nothing -> path
+        Just entry -> "data:" <> mime <> ";base64," <> b64
+          where
+            rawData = B.toStrict $ fromEntry entry
+            b64 = TE.decodeUtf8 $ B64.encode rawData
+            mime = getMimeFromManifest (eManifest env) (T.unpack path)
 
-    replaceSrc (name, value)
-      | name == "src" = ("src", findImage value) -- guards to check for src otherwise output the argument it was given without changes
-      | otherwise = (name, value)
+imgScraper :: (Monad m) => EpubEnv -> ScraperT T.Text m [(T.Text, T.Text)]
+imgScraper env = chroots "img" $ (\s h -> (h, T.replace s (findImage env s) h)) <$> attr "src" anySelector <*> html anySelector
 
-    findImage path =
-      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
-                  mime = getMimeFromManifest (eManifest env) (T.unpack path)
-               in "data:" <> mime <> ";base64," <> b64
+applyReplacements :: T.Text -> [(T.Text, T.Text)] -> T.Text
+applyReplacements = foldl' (\acc (old, new) -> T.replace old new acc)
 
-filterJunk :: [Tag T.Text] -> [Tag T.Text]
-filterJunk = go
-  where
-    go [] = []
-    go (TagOpen name _ : xs) | name `elem` ["script", "style", "head", "link", "meta"] = go (dropUntilClose name xs) -- these are elems we want to filter out
-    go (x : xs) = x : go xs
+embedImages :: EpubEnv -> T.Text -> T.Text
+embedImages env htmlContent =
+  maybe htmlContent (applyReplacements htmlContent) (scrapeStringLike htmlContent (imgScraper env))
 
-    dropUntilClose _ [] = []
-    dropUntilClose name (TagClose n : xs) | n == name = xs
-    dropUntilClose name (_ : xs) = dropUntilClose name xs
+chTitleScraper :: Scraper T.Text T.Text
+chTitleScraper = do
+  t <- text "h1" <|> text "h2" <|> text "h3" <|> text "title"
+  let cleanT = T.strip t
+  guard $ not $ T.null cleanT
+  pure cleanT
 
-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) -- get the raw heading content, remove nested tags
-    _ -> "Untitled Chapter"
-  where
-    ishding (TagOpen n _) = n `elem` ["h1", "h2", "h3"]
-    ishding _ = False
-    isclose n (TagClose n') = n == n'
-    isclose _ _ = False
+chapterScraper :: Scraper T.Text (T.Text, T.Text)
+chapterScraper = do
+  title <- chTitleScraper <|> pure "Untitled Chapter"
+  content <- chroot "body" (innerHTML anySelector) <|> innerHTML anySelector
+  pure (title, content)

app/State.hs

@@ -1,9 +1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module State where
+module State
+  ( initialState,
+    prepareView
+  )
+where
 
-import Text.HTML.TagSoup (renderTags)
-import Types ( AppState(..), Chapter(chapterTags, chapterTitle), ChapterView(..), EpubEnv)
+import Types (AppState(..), Chapter(chapterTags, chapterTitle), ChapterView(..), EpubEnv)
 
 -- Get an element from a list without crashing
 safeGet :: Int -> [a] -> Maybe a
@@ -19,7 +22,6 @@ initialState env =
   AppState
     { cEnv = env,
       cIdx = 0,
-      cTags = Nothing,
       cSpine = [],
       bTitle = "Svitak - Loading...",
       zoomlvl = 1.0,
@@ -34,7 +36,6 @@ prepareView st index = do
   chapter <- safeGet index (cAllChapters st)
   return $ ChapterView
     { viewTitle = bTitle st <> " - " <> chapterTitle chapter
-    , viewHtml  = renderTags (chapterTags chapter)
+    , viewHtml  = chapterTags chapter
     , viewIdx   = index
     }
-

app/Types.hs

@@ -11,7 +11,6 @@ import qualified Data.Text as T
 import Codec.Archive.Zip (Archive)
 import qualified Codec.Epub.Data.Metadata as DMeta
 import qualified Codec.Epub.Data.Manifest as DMan
-import Text.HTML.TagSoup (Tag)
 import Control.Concurrent.Async (Async)
 import Control.Monad.Reader (ReaderT)
 
@@ -32,7 +31,7 @@ data ChapterView = ChapterView
 
 data Chapter = Chapter
   { chapterTitle :: T.Text,
-    chapterTags :: [Tag T.Text],
+    chapterTags :: T.Text,
     chapterIdx :: Int
   }
 
@@ -44,8 +43,7 @@ data AppState = AppState
     bTitle :: T.Text,
     cAllChapters :: [Chapter],
     activeTask :: Maybe (Async ()),
-    taskVersion :: Integer,
-    cTags :: Maybe [Tag T.Text]
+    taskVersion :: Integer
   }
 
 type EpubAction a = ReaderT EpubEnv IO a

app/UI.hs

@@ -19,7 +19,9 @@ import qualified GI.Gtk as Gtk
 import qualified GI.Gtk.Enums as GtkEnums
 import qualified GI.WebKit as WebKit
 import Persistence (loadLastRead, saveLastRead)
-import State (AppState (..), ChapterView (..), initialState, prepareView)
+import State (initialState, prepareView)
+import Types (AppState(..), ChapterView(..))
+import Control.Monad (zipWithM)
 
 runApp :: EpubEnv -> IO ()
 runApp env' = do
@@ -72,7 +74,7 @@ runApp env' = do
     -- start eager parse
     _ <- async $ do
       ispine <- runReaderT resolveSpine env'
-      allChapters <- runReaderT (mapM getChapter ispine) env'
+      allChapters <- runReaderT (zipWithM getChapter ispine[0..]) env'
 
       let titles = metaTitles (eMetadata env')
       let rawT = case find (\t -> titleType t == Just "main") titles of

svitak.cabal

@@ -71,12 +71,12 @@ executable svitak
                       haskell-gi-base,
                       mtl >= 2.3.2,
                       scalpel >= 0.6.2.2,
-                      tagsoup,
                       text >= 2.1.2,
                       zip-archive >= 0.4.3.2,
                       stm >=2.5.3.1,
                       gi-glib >= 2.0.30,
-                      async >= 2.2.6
+                      async >= 2.2.6,
+                      scalpel-core >= 0.6.2.2
 
     hs-source-dirs:   app
     default-language: Haskell2010
@@ -97,7 +97,6 @@ test-suite svitak-test
                       epub-metadata,
                       filepath,
                       mtl,
-                      tagsoup,
                       text,
                       zip-archive,
                       directory