86 lines
2.7 KiB
Haskell
86 lines
2.7 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module EpubParser
|
|
( EpubAction
|
|
, EpubEnv(..)
|
|
, openEpub
|
|
, getOpfPath
|
|
, getOpfTags
|
|
, myEnv
|
|
, resolveSpine
|
|
, getChapter
|
|
, Tag(..)
|
|
) where
|
|
|
|
import Codec.Archive.Zip ( findEntryByPath, fromEntry, toArchive, Archive )
|
|
import qualified Data.ByteString.Lazy as B
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as TE
|
|
import Control.Monad.Reader ( ReaderT, MonadReader(ask) )
|
|
import Text.HTML.TagSoup ( parseTags, Tag(..) )
|
|
import System.FilePath (takeDirectory, (</>), normalise)
|
|
import Data.Maybe (mapMaybe, isJust)
|
|
type EpubAction a = ReaderT EpubEnv IO a
|
|
|
|
data EpubEnv = EpubEnv
|
|
{ archive :: Archive
|
|
, manifest :: [Tag String]
|
|
, baseDir :: FilePath
|
|
}
|
|
|
|
openEpub :: FilePath -> IO (Either String Archive)
|
|
openEpub path = do
|
|
entry <- B.readFile path
|
|
return $ Right (toArchive entry)
|
|
|
|
getOpfPath :: Archive -> Maybe FilePath
|
|
getOpfPath arch =
|
|
case findEntryByPath "META-INF/container.xml" arch of
|
|
Nothing -> Nothing
|
|
Just entry ->
|
|
let content = TE.decodeUtf8 $ B.toStrict $ fromEntry entry
|
|
tags = parseTags (T.unpack content)
|
|
in getRootPath tags
|
|
|
|
getRootPath :: [Tag String] -> Maybe FilePath
|
|
getRootPath [] = Nothing
|
|
getRootPath (TagOpen "rootfile" attrs : _) = lookup "full-path" attrs
|
|
getRootPath (_:xs) = getRootPath xs
|
|
|
|
getOpfTags :: Archive -> FilePath -> [Tag String]
|
|
getOpfTags arch opfPath =
|
|
case findEntryByPath opfPath arch of
|
|
Nothing -> []
|
|
Just entry -> parseTags $ T.unpack $ TE.decodeUtf8 $ B.toStrict $ fromEntry entry
|
|
|
|
myEnv :: Archive -> FilePath -> [Tag String] -> EpubEnv
|
|
myEnv arch opfPath tags = EpubEnv arch tags (takeDirectory opfPath)
|
|
|
|
resolveSpine :: EpubAction [FilePath]
|
|
resolveSpine = do
|
|
env <- ask
|
|
let tags = manifest env
|
|
let itemRefs = [ idRef | TagOpen "itemref" attrs <- tags, let idRef = lookup "idref" attrs, isJust $ Just idRef ]
|
|
|
|
-- let files = map (findFileById tags) itemRefs
|
|
pure $ mapMaybe (findFileById tags) itemRefs
|
|
|
|
findFileById :: [Tag String] -> Maybe String -> Maybe FilePath
|
|
findFileById _ Nothing = Nothing
|
|
findFileById tags (Just myId) =
|
|
let matches = [ href | TagOpen "item" attrs <- tags, lookup "id" attrs == Just myId, let href = lookup "href" attrs ]
|
|
in case matches of
|
|
(x:_) -> x
|
|
[] -> Nothing
|
|
|
|
getChapter :: FilePath -> EpubAction [Tag T.Text]
|
|
getChapter filename = do
|
|
env <- ask
|
|
let fullPath = normalise $ baseDir env </> filename
|
|
|
|
let fileEntry = findEntryByPath fullPath (archive env)
|
|
case fileEntry of
|
|
Nothing -> pure []
|
|
Just file -> do
|
|
|
|
pure $ parseTags $ TE.decodeUtf8 $ B.toStrict $ fromEntry file
|