Complete basic text parsing functionality

app/EpubParser.hs

@@ -1,98 +1,91 @@
-module EpubParser where
+{-# LANGUAGE OverloadedStrings #-}
 
-import Codec.Archive.Zip (toArchive, findEntryByPath, fromEntry, Archive)
+module EpubParser
-import qualified Data.ByteString.Lazy as BL
+    ( EpubAction
-import qualified Data.ByteString.Lazy.Char8 as C8
+    , EpubEnv(..)
-import Text.HTML.TagSoup (parseTags, Tag)
+    , openEpub
-import Text.HTML.Scalpel (scrape, text, tagSelector, attr, attrs, Scraper, chroots, anySelector)
+    , getOpfPath
-import System.FilePath (takeDirectory, (</>))
+    , getOpfTags
-import Control.Monad.Reader
+    , 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.Text.Encoding as TE
-import qualified Data.Map as M
+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
+    { archive  :: Archive
-  , author     :: T.Text
+    , manifest :: [Tag String]
-  , rootPrefix :: FilePath
+    , baseDir  :: 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
-      }
 
 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
+getOpfPath arch =
-  entry <- findEntryByPath "META-INF/container.xml" archive
+    case findEntryByPath "META-INF/container.xml" arch of
-  let tags = parseTags $ C8.unpack (fromEntry entry)
+        Nothing -> Nothing
-  scrape (attr "full-path" (tagSelector "rootfile")) tags
+        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 =
+getOpfTags arch opfPath =
-  case findEntryByPath opfpath archive of
+    case findEntryByPath opfPath arch of
-    Just entry -> parseTags $ C8.unpack (fromEntry entry)
+        Nothing -> []
-    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
+myEnv :: Archive -> FilePath -> [Tag String] -> EpubEnv
-getRootPrefix :: FilePath -> FilePath
+myEnv arch opfPath tags = EpubEnv arch tags (takeDirectory opfPath)
-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)
 
 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
+getChapter filename = do
-  arch <- asks archive
+    env <- ask
-  case findEntryByPath path arch of
+    let fullPath = normalise $ (baseDir env) </> filename
-    Nothing -> pure $ T.pack "Error: Chapter not found."
+    
-    Just entry -> do
+    let fileEntry = findEntryByPath fullPath (archive env)
-      let content = C8.unpack (fromEntry entry)
+    case fileEntry of
-      let rawText = scrape (text anySelector) (parseTags content)
+        Nothing -> return "" 
-      pure $ T.pack $ fromMaybe "" rawText
+        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 ]

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 tags = getOpfTags arch opfPath
-          let env  = myEnv arch tags
-          runReaderT printFirstChapter env
 
-printFirstChapter :: EpubAction ()
+                  let env = myEnv arch opfPath tags
-printFirstChapter =
-  resolveSpine >>= \chapterPaths -> case chapterPaths of
 
-    [] -> liftIO $ putStrLn $ "Nothing found"
+                  runReaderT printFirstRealChapter env
-    (firstFile:_) -> do
+
-      text <- getChapter firstFile
+printFirstRealChapter :: EpubAction ()
-      liftIO $ TIO.putStrLn text
+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 "..."