{-# LANGUAGE OverloadedStrings #-}

-- | Scrapers that turn a table-of-contents document into a /tree/ of raw
-- entries. Two formats are supported:
--
--   * EPUB 2 — an NCX file with nested @\<navPoint\>@s.
--   * EPUB 3 — a nav document with nested @\<ol\>@\/@\<li\>@ lists.
--
-- Hrefs are left relative here; 'EpubParser' resolves them against the TOC
-- document's location. We use 'atDepth' so each recursion level only picks up
-- its /direct/ children (otherwise scalpel's descendant matching would flatten
-- the hierarchy and duplicate nested nodes).
module Navigation
  ( RawToc (..),
    navDocHref,
    ncxToc,
    navToc,
    guideToc,
  )
where

import Control.Applicative ((<|>))
import qualified Data.Text as T
import Text.HTML.Scalpel (Scraper, atDepth, attr, chroot, chroots, scrapeStringLike, text, (@:), (@=))

-- | A TOC node with an as-yet-unresolved (document-relative) href.
data RawToc = RawToc
  { rawLabel :: T.Text,
    rawHref :: FilePath,
    rawChildren :: [RawToc]
  }
  deriving (Show)

-- | The EPUB 3 navigation document's href, declared in the OPF manifest as the
-- item carrying @properties="nav"@.
navDocHref :: String -> Maybe FilePath
navDocHref opf =
  scrapeStringLike opf (attr "href" ("item" @: ["properties" @= "nav"]))

-- | EPUB 2: walk the @\<navMap\>@ of nested @\<navPoint\>@s.
ncxToc :: Scraper T.Text [RawToc]
ncxToc = chroot "navMap" points
  where
    points = chroots ("navPoint" `atDepth` 1) node
    node =
      RawToc
        <$> (T.strip <$> text ("navLabel" `atDepth` 1))
        <*> (T.unpack <$> attr "src" ("content" `atDepth` 1))
        <*> points

-- | EPUB 3: walk @\<nav epub:type="toc"\>@'s nested @\<ol\>@\/@\<li\>@ lists.
navToc :: Scraper T.Text [RawToc]
navToc = chroot ("nav" @: ["epub:type" @= "toc"]) (chroot "ol" items)
  where
    items = chroots ("li" `atDepth` 1) node
    node =
      RawToc
        <$> (T.strip <$> text ("a" `atDepth` 1))
        <*> (T.unpack <$> attr "href" ("a" `atDepth` 1))
        <*> (chroot ("ol" `atDepth` 1) items <|> pure [])

-- | EPUB 2 @\<guide\>@: a flat list of @\<reference\>@s (cover, toc, start, …).
-- Used as a last-resort TOC when there's no NCX or nav document.
guideToc :: Scraper T.Text [RawToc]
guideToc = chroot "guide" $ chroots "reference" node
  where
    node =
      RawToc
        <$> (T.strip <$> attr "title" "reference")
        <*> (T.unpack <$> attr "href" "reference")
        <*> pure []