88 lines
2.8 KiB
Haskell
88 lines
2.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module EpubParser
|
|
( EpubAction
|
|
, EpubEnv(..)
|
|
, openEpub
|
|
, getOpfPath
|
|
, myEnv
|
|
, resolveSpine
|
|
, getChapter
|
|
, Tag(..)
|
|
) where
|
|
|
|
import Codec.Archive.Zip ( Archive, findEntryByPath, fromEntry, toArchive )
|
|
|
|
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), liftIO)
|
|
import Control.Monad.Except (ExceptT, runExceptT)
|
|
import Text.HTML.TagSoup (parseTags, Tag(..))
|
|
import System.FilePath (takeDirectory, (</>), normalise)
|
|
import Data.List (find)
|
|
|
|
import Codec.Epub.Parse (getManifest , getSpine)
|
|
import qualified Codec.Epub.Data.Manifest as DM
|
|
import qualified Codec.Epub.Data.Spine as DS
|
|
|
|
type EpubAction a = ReaderT EpubEnv IO a
|
|
|
|
data EpubEnv = EpubEnv
|
|
{ archive :: Archive
|
|
, opfXml :: String
|
|
, baseDir :: FilePath
|
|
}
|
|
|
|
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
|
|
pure $ Right $ EpubEnv arch xml (takeDirectory opfPath)
|
|
|
|
getOpfPath :: Archive -> Maybe FilePath
|
|
getOpfPath arch =
|
|
case findEntryByPath "META-INF/container.xml" arch of
|
|
Nothing -> Nothing
|
|
Just entry -> getRootPath (parseTags . T.unpack . 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
|
|
|
|
myEnv :: Archive -> FilePath -> String -> EpubEnv
|
|
myEnv arch opfPath xml = EpubEnv arch xml (takeDirectory opfPath)
|
|
|
|
resolveSpine :: EpubAction [FilePath]
|
|
resolveSpine = do
|
|
env <- ask
|
|
let xmlStr = opfXml env
|
|
|
|
manifestResult <- liftIO $ runExceptT $ getManifest xmlStr
|
|
spineResult <- liftIO $ runExceptT $ getSpine xmlStr
|
|
|
|
case (manifestResult, spineResult) of
|
|
(Right (DM.Manifest items), Right (DS.Spine _ refs)) -> do
|
|
|
|
let lookupHref ident = DM.mfiHref <$> find (\mi -> DM.mfiId mi == ident) items
|
|
|
|
pure [ p | ref <- refs , let ident = DS.siIdRef ref , Just p <- [lookupHref ident] ]
|
|
|
|
_ -> pure []
|
|
|
|
getChapter :: FilePath -> EpubAction [Tag T.Text]
|
|
getChapter filename = do
|
|
env <- ask
|
|
let full = normalise (baseDir env </> filename)
|
|
case findEntryByPath full (archive env) of
|
|
Nothing -> pure []
|
|
Just e -> pure $ parseTags . TE.decodeUtf8 . B.toStrict $ fromEntry e
|