192 lines
7.7 KiB
Haskell
192 lines
7.7 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
module EpubParser
|
|
( EpubAction,
|
|
EpubEnv (..),
|
|
openEpub,
|
|
getOpfPath,
|
|
resolveSpine,
|
|
getChapter,
|
|
)
|
|
where
|
|
|
|
import Codec.Archive.Zip (Archive, findEntryByPath, fromEntry, toArchive)
|
|
import qualified Codec.Epub.Data.Manifest as DMan
|
|
import qualified Codec.Epub.Data.Spine as DSpin
|
|
import Codec.Epub.Parse (getManifest, getMetadata, getSpine)
|
|
import Control.Applicative ((<|>))
|
|
import Control.Monad (guard)
|
|
import Control.Monad.Except (runExceptT, ExceptT, throwError)
|
|
import Control.Monad.Reader (MonadReader (ask), liftIO, runReaderT)
|
|
import Control.Monad.Trans (lift)
|
|
import qualified Data.ByteString.Base64 as B64
|
|
import qualified Data.ByteString.Lazy as B
|
|
import Data.List (find, foldl')
|
|
import Data.Maybe (fromMaybe, listToMaybe)
|
|
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 Types (Chapter (..), EpubAction, EpubEnv (..), InternalPath(..), ChapterIndex(..), BookInfo(..), EpubType(..))
|
|
import Navigation (navFinder, lndmkScraper, lndmkmap, getLandmarks)
|
|
import Codec.Epub.Parse (getPackage)
|
|
import Codec.Epub.Data.Metadata (metaTitles, titleText, titleType, Creator (creatorText), Metadata (metaCreators))
|
|
import Codec.Epub.Data.Package (Package(..))
|
|
import qualified Codec.Epub.Data.Metadata as DMeta
|
|
|
|
instance BookInfo EpubEnv where
|
|
getTitle env = fromMaybe "Unknown Title" $ T.pack . DMeta.titleText <$> listToMaybe (DMeta.metaTitles $ eMetadata env)
|
|
|
|
getAuthors env = map (T.pack . DMeta.creatorText) $ DMeta.metaCreators $ eMetadata env
|
|
|
|
getLandmarks = Navigation.getLandmarks
|
|
|
|
getBookPath = bookPath
|
|
|
|
getSpine env = runExceptT (runReaderT resolveSpine env)
|
|
loadChapter env path idx = runExceptT (runReaderT (getChapter path idx) env)
|
|
|
|
openEpub :: FilePath -> IO (Either String EpubEnv)
|
|
openEpub path = do
|
|
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
|
|
|
|
metaResult <- runExceptT $ getMetadata xml
|
|
manResult <- runExceptT $ getManifest xml
|
|
verResult <- runExceptT $ detectVersion xml
|
|
|
|
case (metaResult, manResult, verResult) of
|
|
(Left err, _, _) -> pure $ Left $ "Metadata parse error: " ++ err
|
|
(_, Left err, _) -> pure $ Left $ "Manifest parse error: " ++ err
|
|
(_, _, Left err) -> pure $ Left $ "Version parse error: " ++ err
|
|
(Right meta, Right man, Right v) ->
|
|
pure $
|
|
Right $
|
|
EpubEnv
|
|
{ archive = arch,
|
|
opfXml = xml,
|
|
baseDir = takeDirectory opfPath,
|
|
bookPath = path,
|
|
eMetadata = meta,
|
|
eManifest = man,
|
|
eVersion = T.pack v
|
|
}
|
|
|
|
(Left err, _, _) -> pure $ Left $ "Metadata error: " ++ err
|
|
(_, Left err, _) -> pure $ Left $ "Manifest error: " ++ err
|
|
(_, _, Left err) -> pure $ Left $ "Version error: " ++ err
|
|
|
|
getOpfPath :: Archive -> Maybe String
|
|
getOpfPath arch =
|
|
maybe Nothing (\e -> getRootPath (TE.decodeUtf8 . B.toStrict $ fromEntry e)) (findEntryByPath "META-INF/container.xml" arch)
|
|
|
|
getRootPath :: T.Text -> Maybe String
|
|
getRootPath rawhtml =
|
|
scrapeStringLike rawhtml $ T.unpack <$> attr "full-path" "rootfile"
|
|
|
|
resolveSpine :: EpubAction [(InternalPath, T.Text)]
|
|
resolveSpine = do
|
|
env <- ask
|
|
let xmlStr = opfXml env
|
|
let (DMan.Manifest items) = eManifest env
|
|
|
|
spineResult <- lift $ Codec.Epub.Parse.getSpine xmlStr
|
|
|
|
case spineResult of
|
|
DSpin.Spine maybeTocId refs -> do
|
|
let lookupHref ident = DMan.mfiHref <$> find (\mi -> DMan.mfiId mi == ident) items
|
|
let mNavPath = scrapeStringLike xmlStr navFinder
|
|
tocMap <- case mNavPath of
|
|
Just navPath -> extractTocFromEntry (baseDir env </> navPath)
|
|
Nothing -> case lookupHref maybeTocId of
|
|
Just ncxPath -> extractTocFromEntry (baseDir env </> ncxPath)
|
|
Nothing -> throwError "Could not locate a Table of Contents."
|
|
let buildChapter (ref, i) = do
|
|
let ident = DSpin.siIdRef ref
|
|
case lookupHref ident of
|
|
Nothing -> throwError $ "Manifest missing entry for spine item: " ++ ident
|
|
Just p ->
|
|
let title = fromMaybe ("Chapter " <> T.pack (show i)) (lookup p tocMap)
|
|
in pure (InternalPath p, title)
|
|
|
|
mapM buildChapter (zip refs [1..])
|
|
|
|
extractTocFromEntry :: FilePath -> EpubAction [(String, T.Text)]
|
|
extractTocFromEntry fullPath = do
|
|
env <- ask
|
|
case findEntryByPath (normalise fullPath) (archive env) of
|
|
Nothing -> pure []
|
|
Just e -> do
|
|
let raw = TE.decodeUtf8 . B.toStrict $ fromEntry e
|
|
let types = [EpubType "toc", EpubType "bodymatter"]
|
|
pure $ fromMaybe [] (scrapeStringLike raw (lndmkmap types) <|> scrapeStringLike raw ncxScraper)
|
|
|
|
getChapter :: (InternalPath, T.Text) -> ChapterIndex -> EpubAction Chapter
|
|
getChapter (InternalPath filename, tocTitle) idx = do
|
|
env <- ask
|
|
let full = normalise (baseDir env </> filename)
|
|
case findEntryByPath full (archive env) of
|
|
Nothing -> pure $ Chapter tocTitle "" idx
|
|
Just e -> do
|
|
let rawText = TE.decodeUtf8 . B.toStrict $ fromEntry e
|
|
let withImages = embedImages env rawText
|
|
|
|
let (_, content) = fromMaybe (tocTitle, "") $ scrapeStringLike withImages chapterScraper
|
|
pure $ Chapter tocTitle content idx
|
|
|
|
getMimeFromManifest :: DMan.Manifest -> FilePath -> T.Text
|
|
getMimeFromManifest (DMan.Manifest items) relPath =
|
|
case find (\item -> DMan.mfiHref item == relPath) items of
|
|
Just item -> T.pack $ DMan.mfiMediaType item
|
|
Nothing -> "image/jpeg"
|
|
|
|
-- 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)
|
|
|
|
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
|
|
|
|
applyReplacements :: T.Text -> [(T.Text, T.Text)] -> T.Text
|
|
applyReplacements = foldl' (\acc (old, new) -> T.replace old new acc)
|
|
|
|
embedImages :: EpubEnv -> T.Text -> T.Text
|
|
embedImages env htmlContent =
|
|
maybe htmlContent (applyReplacements htmlContent) (scrapeStringLike htmlContent (imgScraper env))
|
|
|
|
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
|
|
|
|
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)
|
|
|
|
ncxScraper :: Scraper T.Text [(String, T.Text)]
|
|
ncxScraper = chroots "navPoint" $
|
|
(,) <$> (T.unpack <$> attr "src" "content") <*> (T.strip <$> text "navLabel")
|
|
|
|
detectVersion :: String -> ExceptT String IO String
|
|
detectVersion = fmap pkgVersion . getPackage
|