87 lines
2.9 KiB
Haskell
87 lines
2.9 KiB
Haskell
module EpubParser where
|
|
|
|
import Codec.Archive.Zip (toArchive, findEntryByPath, fromEntry, Archive)
|
|
import qualified Data.ByteString.Lazy as BL
|
|
import qualified Data.ByteString.Lazy.Char8 as C8
|
|
import Text.HTML.TagSoup (parseTags, Tag)
|
|
import Text.HTML.Scalpel (scrape, text, tagSelector, attr, attrs, Scraper, chroots, anySelector)
|
|
import System.FilePath (takeDirectory, (</>))
|
|
import Control.Monad.Reader
|
|
import qualified Data.Text as T
|
|
import Data.Maybe (fromMaybe)
|
|
import qualified Data.Map as M
|
|
|
|
type EpubAction a = ReaderT EpubEnv IO a
|
|
|
|
data EpubEnv = EpubEnv
|
|
{ title :: T.Text
|
|
, author :: T.Text
|
|
, rootPrefix :: FilePath
|
|
, spine :: [T.Text]
|
|
, manifestMap :: M.Map T.Text T.Text
|
|
} deriving (Show)
|
|
|
|
myEnv :: Archive -> [Tag String] -> EpubEnv
|
|
myEnv archive tags =
|
|
let
|
|
opfPath = fromMaybe "" (getOpfPath archive)
|
|
prefix = getRootPrefix opfPath
|
|
|
|
in
|
|
EpubEnv
|
|
{ title = getTagText "dc:title" tags
|
|
, author = getTagText "dc:creator" tags
|
|
, rootPrefix = prefix
|
|
, spine = getSpine tags
|
|
, manifestMap = getManifest tags
|
|
}
|
|
|
|
openEpub :: FilePath -> IO (Either String Archive)
|
|
openEpub path = toArchive <$> BL.readFile path >>= \archive -> maybe (pure $ Left "Error reading file") (\entry -> if fromEntry entry == C8.pack "application/epub+zip" then pure (Right archive) else pure (Left "Wrong mimetype")) (findEntryByPath "mimetype" archive)
|
|
|
|
getOpfPath :: Archive -> Maybe FilePath
|
|
getOpfPath archive = do
|
|
entry <- findEntryByPath "META-INF/container.xml" archive
|
|
let tags = parseTags $ C8.unpack (fromEntry entry)
|
|
scrape (attr "full-path" (tagSelector "rootfile")) tags
|
|
|
|
getOpfTags :: Archive -> FilePath -> [Tag String]
|
|
getOpfTags archive opfpath =
|
|
case findEntryByPath opfpath archive of
|
|
Just entry -> parseTags $ C8.unpack (fromEntry entry)
|
|
Nothing -> []
|
|
|
|
-- Makes it easier so we can just use this function and concatenate relative paths
|
|
getRootPrefix :: FilePath -> FilePath
|
|
getRootPrefix path =
|
|
let dir = takeDirectory path
|
|
in if dir == "." then "" else dir ++ "/"
|
|
|
|
getTagText :: String -> [Tag String] -> T.Text
|
|
getTagText tagName tags =
|
|
let scraper = text (tagSelector tagName)
|
|
in T.pack $ fromMaybe "" (scrape scraper tags)
|
|
|
|
|
|
getSpine :: [Tag String] -> [T.Text]
|
|
getSpine tags =
|
|
map T.pack . fromMaybe [] $ scrape (attrs "idref" (tagSelector "itemref")) tags
|
|
|
|
-- This scraper will be run by chroot for every item
|
|
itemScraper :: Scraper String (T.Text, T.Text)
|
|
itemScraper =
|
|
liftA2 (,) (attr "id" anySelector) (attr "href" anySelector) >>= \(id, href) -> pure (T.pack id, T.pack href)
|
|
|
|
getManifest :: [Tag String] -> M.Map T.Text T.Text
|
|
getManifest tags =
|
|
M.fromList . fromMaybe [] $ scrape (chroots (tagSelector "item") itemScraper) tags
|
|
|
|
resolvePath :: T.Text -> EpubAction (Maybe FilePath)
|
|
resolvePath spineId = do
|
|
m <- asks manifestMap
|
|
p <- asks rootPrefix
|
|
|
|
let mHref = M.lookup spineId m
|
|
|
|
|
|
pure $ fmap (\href -> p </> T.unpack href) mHref
|