Complete basic text parsing functionality
This commit is contained in:
parent
ffa90e0a3a
commit
29aabbf591
2 changed files with 101 additions and 93 deletions
|
|
@ -1,98 +1,91 @@
|
|||
module EpubParser where
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
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
|
||||
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 Data.Maybe (fromMaybe, catMaybes)
|
||||
import qualified Data.Map as M
|
||||
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)
|
||||
|
||||
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
|
||||
, archive :: Archive
|
||||
} deriving (Show)
|
||||
|
||||
myEnv :: Archive -> [Tag String] -> EpubEnv
|
||||
myEnv arch tags =
|
||||
let
|
||||
opfPath = fromMaybe "" (getOpfPath arch)
|
||||
prefix = getRootPrefix opfPath
|
||||
|
||||
in
|
||||
EpubEnv
|
||||
{ title = getTagText "dc:title" tags
|
||||
, author = getTagText "dc:creator" tags
|
||||
, rootPrefix = prefix
|
||||
, spine = getSpine tags
|
||||
, manifestMap = getManifest tags
|
||||
, archive = arch
|
||||
}
|
||||
{ archive :: Archive
|
||||
, manifest :: [Tag String]
|
||||
, baseDir :: FilePath
|
||||
}
|
||||
|
||||
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)
|
||||
openEpub path = do
|
||||
entry <- B.readFile path
|
||||
return $ Right (toArchive entry)
|
||||
|
||||
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
|
||||
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 archive opfpath =
|
||||
case findEntryByPath opfpath archive of
|
||||
Just entry -> parseTags $ C8.unpack (fromEntry entry)
|
||||
Nothing -> []
|
||||
getOpfTags arch opfPath =
|
||||
case findEntryByPath opfPath arch of
|
||||
Nothing -> []
|
||||
Just entry -> parseTags $ T.unpack $ TE.decodeUtf8 $ B.toStrict $ fromEntry entry
|
||||
|
||||
-- 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
|
||||
|
||||
pure $ fmap (\href -> p </> T.unpack href) (M.lookup spineId m)
|
||||
myEnv :: Archive -> FilePath -> [Tag String] -> EpubEnv
|
||||
myEnv arch opfPath tags = EpubEnv arch tags (takeDirectory opfPath)
|
||||
|
||||
resolveSpine :: EpubAction [FilePath]
|
||||
resolveSpine = catMaybes <$> (asks spine >>= mapM resolvePath)
|
||||
resolveSpine = do
|
||||
env <- ask
|
||||
let tags = manifest env
|
||||
let itemRefs = [ idRef | TagOpen "itemref" attrs <- tags, let idRef = lookup "idref" attrs, Just idRef /= Nothing ]
|
||||
|
||||
let files = map (findFileById tags) itemRefs
|
||||
return [ f | Just f <- files ]
|
||||
|
||||
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 T.Text
|
||||
getChapter path = do
|
||||
arch <- asks archive
|
||||
case findEntryByPath path arch of
|
||||
Nothing -> pure $ T.pack "Error: Chapter not found."
|
||||
Just entry -> do
|
||||
let content = C8.unpack (fromEntry entry)
|
||||
let rawText = scrape (text anySelector) (parseTags content)
|
||||
pure $ T.pack $ fromMaybe "" rawText
|
||||
getChapter filename = do
|
||||
env <- ask
|
||||
let fullPath = normalise $ (baseDir env) </> filename
|
||||
|
||||
let fileEntry = findEntryByPath fullPath (archive env)
|
||||
case fileEntry of
|
||||
Nothing -> return ""
|
||||
Just file -> do
|
||||
let content = fromEntry file
|
||||
return $ stripHtml $ TE.decodeUtf8 $ B.toStrict content
|
||||
|
||||
stripHtml :: T.Text -> T.Text
|
||||
stripHtml raw =
|
||||
let tags = parseTags (T.unpack raw)
|
||||
in T.pack $ unwords [ txt | TagText txt <- tags ]
|
||||
|
|
|
|||
37
app/Main.hs
37
app/Main.hs
|
|
@ -4,7 +4,7 @@ import System.Environment (getArgs)
|
|||
import Control.Monad.Reader (runReaderT, liftIO)
|
||||
import EpubParser
|
||||
import qualified Data.Text.IO as TIO
|
||||
|
||||
import qualified Data.Text as T
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
|
|
@ -12,6 +12,7 @@ main = do
|
|||
[] -> putStrLn "Usage: svitak <file.epub>"
|
||||
(path:_) -> runSvitak path
|
||||
|
||||
runSvitak :: FilePath -> IO ()
|
||||
runSvitak path = do
|
||||
result <- openEpub path
|
||||
case result of
|
||||
|
|
@ -21,15 +22,29 @@ runSvitak path = do
|
|||
case maybeOpfPath of
|
||||
Nothing -> putStrLn "Error: Could not find OPF metadata file."
|
||||
Just opfPath -> do
|
||||
let tags = getOpfTags arch opfPath
|
||||
let env = myEnv arch tags
|
||||
runReaderT printFirstChapter env
|
||||
let tags = getOpfTags arch opfPath
|
||||
|
||||
printFirstChapter :: EpubAction ()
|
||||
printFirstChapter =
|
||||
resolveSpine >>= \chapterPaths -> case chapterPaths of
|
||||
let env = myEnv arch opfPath tags
|
||||
|
||||
[] -> liftIO $ putStrLn $ "Nothing found"
|
||||
(firstFile:_) -> do
|
||||
text <- getChapter firstFile
|
||||
liftIO $ TIO.putStrLn text
|
||||
runReaderT printFirstRealChapter env
|
||||
|
||||
printFirstRealChapter :: EpubAction ()
|
||||
printFirstRealChapter = do
|
||||
chapterPaths <- resolveSpine
|
||||
|
||||
findText chapterPaths
|
||||
|
||||
where
|
||||
findText [] = liftIO $ putStrLn "End of book!"
|
||||
findText (p:ps) = do
|
||||
liftIO $ putStrLn $ "Checking: " ++ p ++ "..."
|
||||
text <- getChapter p
|
||||
let cleanText = T.strip text
|
||||
|
||||
if T.null cleanText
|
||||
then findText ps
|
||||
else do
|
||||
liftIO $ putStrLn "\n Found text:"
|
||||
liftIO $ putStrLn "--------------------------------"
|
||||
liftIO $ TIO.putStrLn $ T.take 500 cleanText
|
||||
liftIO $ putStrLn "..."
|
||||
|
|
|
|||
Loading…
Reference in a new issue