diff --git a/app/EpubParser.hs b/app/EpubParser.hs index 03c4dfc..65c72df 100644 --- a/app/EpubParser.hs +++ b/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;" +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) diff --git a/app/State.hs b/app/State.hs index eb6bf06..4e70ebf 100644 --- a/app/State.hs +++ b/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 } - diff --git a/app/Types.hs b/app/Types.hs index 5e8490a..fbcb8b2 100644 --- a/app/Types.hs +++ b/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 diff --git a/app/UI.hs b/app/UI.hs index 8871077..050bcb4 100644 --- a/app/UI.hs +++ b/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 diff --git a/svitak.cabal b/svitak.cabal index bcba135..5f19193 100644 --- a/svitak.cabal +++ b/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