finish navigation implementation in epubparser

app/EpubParser.hs

@@ -27,7 +27,7 @@ import qualified Data.Text.Encoding as TE
 import System.FilePath (normalise, takeDirectory, (</>))
 import Text.HTML.Scalpel (Scraper, ScraperT, anySelector, attr, chroot, chroots, html, innerHTML, scrapeStringLike, text)
 import Types (Chapter (..), EpubAction, EpubEnv (..), InternalPath(..), ChapterIndex(..), BookInfo(..), EpubType(..))
-import Navigation (navFinder, lndmkScraper)
+import Navigation (navFinder, lndmkScraper, lndmkmap)
 import Codec.Epub.Parse (getPackage)
 import Codec.Epub.Data.Metadata (metaTitles, titleText, titleType, Creator (creatorText), Metadata (metaCreators))
 import Codec.Epub.Data.Package (Package(..))
@@ -108,6 +108,8 @@ resolveSpine = do
   env <- ask
   let xmlStr = opfXml env
 
+  let mNavPath = scrapeStringLike xmlStr navFinder
+
   spineResult <- liftIO $ runExceptT $ Codec.Epub.Parse.getSpine xmlStr
   let (DMan.Manifest items) = eManifest env
 
@@ -115,23 +117,27 @@ resolveSpine = do
     Right (DSpin.Spine maybeTocId refs) -> do
       let lookupHref ident = DMan.mfiHref <$> find (\mi -> DMan.mfiId mi == ident) items
       let maybeTocPath = lookupHref maybeTocId
-      let mNav = scrapeStringLike xmlStr navFinder
 
-      tocMap <- case maybeTocPath of
-        Nothing -> pure []
-        Just path -> do
-          let full = normalise (baseDir env </> path)
-          case findEntryByPath full (archive env) of
-            Nothing -> pure []
-            Just e  -> do
-              let raw = TE.decodeUtf8 . B.toStrict $ fromEntry e
+      tocMap <- case mNavPath of
+        Just navPath -> extractTocFromEntry (baseDir env </> navPath)
+        Nothing -> case lookupHref maybeTocId of
+          Just ncxPath -> extractTocFromEntry (baseDir env </> ncxPath)
+          Nothing -> pure []
 
-              pure $ fromMaybe [] (scrapeStringLike raw ncxScraper)
-
-      pure [(InternalPath p, fromMaybe ("Chapter " <> T.pack (show (i :: Int))) (lookup p tocMap)) | (ref, i) <- zip refs [1..] , let ident = DSpin.siIdRef ref , Just p <- [lookupHref ident]]
+      pure [(InternalPath p, fromMaybe ("Chapter " <> T.pack (show i)) (lookup p tocMap))  | (ref, i) <- zip refs [1..] , let ident = DSpin.siIdRef ref , Just p <- [lookupHref ident]]
 
     _ -> pure []
 
+extractTocFromEntry :: FilePath -> EpubAction [(String, T.Text)]
+extractTocFromEntry fullPath = do
+  env <- ask
+  case findEntryByPath (normalise fullPath) (archive env) of
+    Nothing -> pure []
+    Just e  -> do
+      let raw = TE.decodeUtf8 . B.toStrict $ fromEntry e
+      let types = [EpubType "toc", EpubType "bodymatter"]
+      pure $ fromMaybe [] (scrapeStringLike raw (lndmkmap types) <|> scrapeStringLike raw ncxScraper)
+
 getChapter :: (InternalPath, T.Text) -> ChapterIndex -> EpubAction Chapter
 getChapter (InternalPath filename, tocTitle) idx = do
   env <- ask
@@ -186,5 +192,9 @@ chapterScraper = do
   content <- chroot "body" (innerHTML anySelector) <|> innerHTML anySelector
   pure (title, content)
 
+ncxScraper :: Scraper T.Text [(String, T.Text)]
+ncxScraper = chroots "navPoint" $
+  (,) <$> (T.unpack <$> attr "src" "content") <*> (T.strip <$> text "navLabel")
+
 detectVersion :: String -> ExceptT String IO String
 detectVersion = fmap pkgVersion . getPackage

app/Navigation.hs

@@ -2,7 +2,8 @@
 
 module Navigation
   ( navFinder,
-    lndmkScraper
+    lndmkScraper,
+    lndmkmap
   )
 where
 
@@ -44,6 +45,12 @@ lndmkScraper labels =
     navPredicate "epub:type" xs = EpubType (T.pack xs) `elem` labels
     navPredicate _ _ = False
 
+lndmkmap :: [EpubType] -> Scraper T.Text [(String, T.Text)]
+lndmkmap types =
+  map (\item -> (unpackPath (navPath item), navLabel item)) <$> lndmkScraper types
+  where
+    unpackPath (InternalPath p) = p
+
                        --------------------------------------------------------
                        --                     dispatching                     --
                        --------------------------------------------------------