forked from marko/svitak
implement consistent formatting
This commit is contained in:
parent
1cab6a9bab
commit
4c6c181e65
5 changed files with 164 additions and 162 deletions
|
|
@ -1,41 +1,41 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module EpubParser
|
||||
( EpubAction
|
||||
, EpubEnv(..)
|
||||
, openEpub
|
||||
, getOpfPath
|
||||
, resolveSpine
|
||||
, getChapter
|
||||
, getChapterTitle
|
||||
, Tag(..)
|
||||
) where
|
||||
( EpubAction,
|
||||
EpubEnv (..),
|
||||
openEpub,
|
||||
getOpfPath,
|
||||
resolveSpine,
|
||||
getChapter,
|
||||
getChapterTitle,
|
||||
Tag (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Codec.Archive.Zip (Archive, findEntryByPath, fromEntry, toArchive)
|
||||
|
||||
import qualified Codec.Epub.Data.Manifest as DMan
|
||||
import qualified Codec.Epub.Data.Metadata as DMeta
|
||||
import qualified Codec.Epub.Data.Spine as DSpin
|
||||
import Codec.Epub.Parse (getManifest, getMetadata, getSpine)
|
||||
import Control.Monad.Except (runExceptT)
|
||||
import Control.Monad.Reader (MonadReader (ask), ReaderT, liftIO)
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import Data.List (find)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import Control.Monad.Reader (ReaderT, MonadReader(ask), liftIO)
|
||||
import Control.Monad.Except (runExceptT)
|
||||
import System.FilePath (takeDirectory, (</>), normalise)
|
||||
import Data.List (find)
|
||||
import Text.HTML.TagSoup (parseTags, innerText, Tag(..))
|
||||
import Codec.Epub.Parse (getSpine, getMetadata, getManifest)
|
||||
import qualified Codec.Epub.Data.Metadata as DMeta
|
||||
import qualified Codec.Epub.Data.Manifest as DMan
|
||||
import qualified Codec.Epub.Data.Spine as DSpin
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import System.FilePath (normalise, takeDirectory, (</>))
|
||||
import Text.HTML.TagSoup (Tag (..), innerText, parseTags)
|
||||
|
||||
type EpubAction a = ReaderT EpubEnv IO a
|
||||
|
||||
data EpubEnv = EpubEnv
|
||||
{ archive :: Archive
|
||||
, opfXml :: String
|
||||
, baseDir :: FilePath
|
||||
, bookPath :: FilePath
|
||||
, eMetadata :: DMeta.Metadata
|
||||
, eManifest :: DMan.Manifest
|
||||
{ archive :: Archive,
|
||||
opfXml :: String,
|
||||
baseDir :: FilePath,
|
||||
bookPath :: FilePath,
|
||||
eMetadata :: DMeta.Metadata,
|
||||
eManifest :: DMan.Manifest
|
||||
}
|
||||
|
||||
openEpub :: FilePath -> IO (Either String EpubEnv)
|
||||
|
|
@ -52,20 +52,22 @@ openEpub path = do
|
|||
let xml = T.unpack $ TE.decodeUtf8 $ B.toStrict $ fromEntry entry
|
||||
|
||||
metaResult <- runExceptT $ getMetadata xml
|
||||
manResult <- runExceptT $ getManifest xml
|
||||
manResult <- runExceptT $ getManifest xml
|
||||
|
||||
case (metaResult, manResult) of
|
||||
(Left err, _) -> pure $ Left $ "Metadata parse error: " ++ err
|
||||
(_, Left err) -> pure $ Left $ "Manifest parse error: " ++ err
|
||||
(Right meta, Right man) ->
|
||||
pure $ Right $ EpubEnv
|
||||
{ archive = arch
|
||||
, opfXml = xml
|
||||
, baseDir = takeDirectory opfPath
|
||||
, bookPath = path
|
||||
, eMetadata = meta
|
||||
, eManifest = man
|
||||
}
|
||||
(Right meta, Right man) ->
|
||||
pure $
|
||||
Right $
|
||||
EpubEnv
|
||||
{ archive = arch,
|
||||
opfXml = xml,
|
||||
baseDir = takeDirectory opfPath,
|
||||
bookPath = path,
|
||||
eMetadata = meta,
|
||||
eManifest = man
|
||||
}
|
||||
|
||||
getOpfPath :: Archive -> Maybe FilePath
|
||||
getOpfPath arch =
|
||||
|
|
@ -76,7 +78,7 @@ getOpfPath arch =
|
|||
getRootPath :: [Tag String] -> Maybe FilePath
|
||||
getRootPath [] = Nothing
|
||||
getRootPath (TagOpen "rootfile" attrs : _) = lookup "full-path" attrs
|
||||
getRootPath (_:xs) = getRootPath xs
|
||||
getRootPath (_ : xs) = getRootPath xs
|
||||
|
||||
resolveSpine :: EpubAction [FilePath]
|
||||
resolveSpine = do
|
||||
|
|
@ -88,7 +90,7 @@ resolveSpine = do
|
|||
case spineResult of
|
||||
Right (DSpin.Spine _ refs) -> do
|
||||
let lookupHref ident = DMan.mfiHref <$> find (\mi -> DMan.mfiId mi == ident) items
|
||||
pure [ p | ref <- refs , let ident = DSpin.siIdRef ref , Just p <- [lookupHref ident] ]
|
||||
pure [p | ref <- refs, let ident = DSpin.siIdRef ref, Just p <- [lookupHref ident]]
|
||||
_ -> pure []
|
||||
|
||||
getChapter :: FilePath -> EpubAction [Tag T.Text]
|
||||
|
|
@ -97,7 +99,7 @@ getChapter filename = do
|
|||
let full = normalise (baseDir env </> filename)
|
||||
case findEntryByPath full (archive env) of
|
||||
Nothing -> pure []
|
||||
Just e -> do
|
||||
Just e -> do
|
||||
let rawTags = parseTags . TE.decodeUtf8 . B.toStrict $ fromEntry e
|
||||
pure (filterJunk (embedImages env rawTags))
|
||||
|
||||
|
|
@ -105,48 +107,47 @@ 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"
|
||||
Nothing -> "image/jpeg"
|
||||
|
||||
-- Replace img tags with base64
|
||||
embedImages :: EpubEnv -> [Tag T.Text] -> [Tag T.Text]
|
||||
embedImages env = map processTag
|
||||
embedImages env = map processTag
|
||||
where
|
||||
processTag (TagOpen "img" attrs) = TagOpen "img" (map replaceSrc attrs)
|
||||
processTag other = other
|
||||
processTag other = other
|
||||
|
||||
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)
|
||||
| otherwise = (name, value)
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
filterJunk :: [Tag T.Text] -> [Tag T.Text]
|
||||
filterJunk = go
|
||||
filterJunk = go
|
||||
where
|
||||
go [] = []
|
||||
go (TagOpen name _ : xs) | name `elem` ["script", "style", "head", "link", "meta"] = -- these are elems we want to filter out
|
||||
go (dropUntilClose name xs)
|
||||
go (x:xs) = x : go xs
|
||||
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
|
||||
|
||||
dropUntilClose _ [] = []
|
||||
dropUntilClose name (TagClose n : xs) | n == name = xs
|
||||
dropUntilClose name (_ : xs) = dropUntilClose name xs
|
||||
|
||||
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"
|
||||
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
|
||||
ishding (TagOpen n _) = n `elem` ["h1", "h2", "h3"]
|
||||
ishding _ = False
|
||||
isclose n (TagClose n') = n == n'
|
||||
isclose _ _ = False
|
||||
|
|
|
|||
Loading…
Reference in a new issue