{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Filters.Archive — annotate (and, for dead links, redirect) body links
--   to archived works.
--
--   For every @Link@ whose URL matches an entry in @data/archive-index.json@
--   (the equivalent-URL alias set included):
--
--     * a 'live', 'moved' or (inconclusive) 'error' target keeps its
--       original link and gains a small superscript affordance pointing at
--       the local @/archive/<slug>/@ page — purely additive;
--
--     * a 'rotted' target (confirmed dead by @archive.py check@'s
--       hysteresis) has its primary link flipped to the archived copy, so
--       a reader of an old essay reaches a working snapshot instead of a
--       404. A "archived" marker replaces the affordance.
--
--   Registered in 'Filters.applyAll' immediately after @Smallcaps@ and
--   before @Links@: it must see the smallcaps-rewritten text, and it emits
--   the affordance/marker as @RawInline@ so the downstream @Links@ pass
--   never re-classifies it.
--
--   No-op when @data/archive-index.json@ is absent. When no rot scan has
--   run, every entry is 'Live' — no link is ever flipped.
module Filters.Archive (apply) where

import qualified Data.Text              as T
import           Text.Pandoc.Definition
import           Text.Pandoc.Walk       (walk)
import           ArchiveIndex           (ArchiveStatus (..), archiveIndexIsEmpty,
                                         archiveSlugFor, archiveStatusForSlug)

-- | Annotate body links. Headings are left alone — an affordance there
--   would be noise. Identity when the index is empty.
apply :: Pandoc -> Pandoc
apply doc@(Pandoc meta blocks)
    | archiveIndexIsEmpty = doc
    | otherwise           = Pandoc meta (map annotateBlock blocks)

annotateBlock :: Block -> Block
annotateBlock h@Header{} = h
annotateBlock b          = walk annotateInlines b

-- | For each archived @Link@: flip it if the target is 'Rotted', else
--   append the affordance. Non-archived links pass through untouched.
annotateInlines :: [Inline] -> [Inline]
annotateInlines = concatMap expand
  where
    expand l@(Link attr text (url, _)) =
        case archiveSlugFor url of
            Nothing   -> [l]
            Just slug -> case archiveStatusForSlug slug of
                Rotted -> [flipped slug attr text, marker slug "rotted"
                                "The original is a dead link &mdash; \
                                \opens the local archived copy"]
                _      -> [l, marker slug "" "Archived &mdash; \
                                            \local preservation copy"]
    expand x = [x]

-- | A 'Rotted' link, redirected to the local archived copy. Keeps the
--   link text; the @archive-rotted@ class lets CSS mark it.
flipped :: String -> Attr -> [Inline] -> Inline
flipped slug (ident, classes, kvs) text =
    Link (ident, "archive-rotted" : classes, kvs) text
         ( T.pack ("/archive/" ++ slug ++ "/")
         , "Original link is dead \8212 opens the local archived copy" )

-- | The superscript marker after the link: "A" for a normal affordance,
--   "archived" for a flipped dead link. Emitted as raw HTML so the
--   downstream @Links@ filter (which classifies @Link@ nodes) leaves it
--   alone. Slugs are @[a-z0-9-]@ by construction in @archive.py@.
marker :: String -> String -> T.Text -> Inline
marker slug modifier title = RawInline "html" $ T.concat
    [ "<sup class=\"archive-affordance", modifierClass, "\">"
    , "<a href=\"/archive/", T.pack slug, "/\" title=\"", title, "\">"
    , label, "</a></sup>"
    ]
  where
    modifierClass = if null modifier
                    then ""
                    else " archive-affordance--" <> T.pack modifier
    label = if null modifier then "A" else "archived"
