{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE OverloadedStrings #-}
-- | External link classification.
--
--   Walks all @Link@ inlines and:
--   * Adds @class="link-external"@ to any link whose URL starts with
--     @http://@ or @https://@ and is not on the site's own domain.
--   * Adds @data-link-icon@ / @data-link-icon-type@ attributes for
--     per-domain brand icons (see 'domainIcon' for the full list).
--   * Adds @target="_blank" rel="noopener noreferrer"@ to external links.
module Filters.Links (apply) where

import           Data.Text            (Text)
import qualified Data.Text            as T
import           Text.Pandoc.Definition
import           Text.Pandoc.Walk     (walk)

-- | Apply link classification to the entire document.
--   Two passes: PDF links first (rewrites href to viewer URL), then external
--   link classification (operates on http/https, so no overlap).
apply :: Pandoc -> Pandoc
apply = walk classifyLink . walk classifyPdfLink

-- | Rewrite root-relative PDF links to open via the vendored PDF.js viewer.
--   Preserves the original path in @data-pdf-src@ so the popup thumbnail
--   provider can locate the corresponding @.thumb.png@ file.
--   Skips links that are already pointing at the viewer (idempotent).
--
--   Handles fragment identifiers (e.g. @/papers/foo.pdf#page=5@): the
--   fragment is stripped before the @.pdf@ suffix check and re-attached
--   after the viewer URL so PDF.js's anchor handling works.
classifyPdfLink :: Inline -> Inline
classifyPdfLink (Link (ident, classes, kvs) ils (url, title))
    | "/" `T.isPrefixOf` url
    , let (path, fragment) = T.break (== '#') url
    , ".pdf" `T.isSuffixOf` T.toLower path
    , "pdf-link" `notElem` classes =
        let viewerUrl = "/pdfjs/web/viewer.html?file="
                        <> encodeQueryValue path <> fragment
            classes'  = classes ++ ["pdf-link"]
            kvs'      = kvs ++ [("data-pdf-src", path)]
        in  Link (ident, classes', kvs') ils (viewerUrl, title)
classifyPdfLink x = x

classifyLink :: Inline -> Inline
classifyLink l@(Link (_, classes, _) _ _)
    -- Source-ref links are owned by Filters.SourceRefs: they keep the
    -- inline-code chrome of their body, must not receive an external
    -- brand icon stamp, and have their own popup provider. Leave them
    -- entirely alone.
    | "source-ref" `elem` classes = l
classifyLink (Link (ident, classes, kvs) ils (url, title))
    | isExternal url =
        let icon     = domainIcon url
            classes' = classes ++ ["link-external"]
            kvs'     = kvs
                       ++ [("target",             "_blank")]
                       ++ [("rel",                "noopener noreferrer")]
                       ++ [("data-link-icon",      icon)]
                       ++ [("data-link-icon-type", "svg")]
        in  Link (ident, classes', kvs') ils (url, title)
    | isInternalPage url =
        let classes' = classes ++ ["link-internal"]
            kvs'     = kvs
                       ++ [("data-link-icon",      "internal")]
                       ++ [("data-link-icon-type", "svg")]
        in  Link (ident, classes', kvs') ils (url, title)
classifyLink x = x

-- ---------------------------------------------------------------------------
-- Helpers
-- ---------------------------------------------------------------------------

-- | True if the URL is a root-relative or relative path to another page
--   (not an anchor-only link like @#section@ or @#ref-foo@).
isInternalPage :: Text -> Bool
isInternalPage url
    | T.null url                  = False
    | "#" `T.isPrefixOf` url      = False   -- anchor-only
    | "mailto:" `T.isPrefixOf` url = False
    | "http://"  `T.isPrefixOf` url = False  -- handled by isExternal
    | "https://" `T.isPrefixOf` url = False
    | otherwise                    = True

-- | True if the URL points outside the site's content host.
--
--   Only @levineuwirth.org@ and @www.levineuwirth.org@ count as the content
--   site itself. Sibling subdomains like @git.levineuwirth.org@ (Forgejo) are
--   distinct services and are classified as external so they receive their
--   brand icon, @target=_blank@, and @rel=noopener noreferrer@.
--
--   Uses strict hostname comparison rather than substring matching, so a
--   hostile lookalike like @evil-levineuwirth.org.attacker.com@ is also
--   correctly classified as external.
isExternal :: Text -> Bool
isExternal url =
    case extractHost url of
        Nothing   -> False
        Just host -> host /= siteHost && host /= "www." <> siteHost
  where
    siteHost = "levineuwirth.org"

-- | Extract the lowercased hostname from an absolute http(s) URL.
--   Returns 'Nothing' for non-http(s) URLs (relative paths, mailto:, etc.).
extractHost :: Text -> Maybe Text
extractHost url
    | Just rest <- T.stripPrefix "https://" url = Just (hostOf rest)
    | Just rest <- T.stripPrefix "http://"  url = Just (hostOf rest)
    | otherwise                                  = Nothing
  where
    hostOf rest =
        let withPort = T.takeWhile (\c -> c /= '/' && c /= '?' && c /= '#') rest
            host     = T.takeWhile (/= ':') withPort
        in  T.toLower host

-- | Icon name for the link, matching a file in /images/link-icons/<name>.svg.
domainIcon :: Text -> Text
domainIcon url
    -- Scholarly / reference
    | "wikipedia.org"       `T.isInfixOf` url = "wikipedia"
    | "arxiv.org"           `T.isInfixOf` url = "arxiv"
    | "doi.org"             `T.isInfixOf` url = "doi"
    | "worldcat.org"        `T.isInfixOf` url = "worldcat"
    | "orcid.org"           `T.isInfixOf` url = "orcid"
    | "archive.org"         `T.isInfixOf` url = "internet-archive"
    -- Code / software
    | "github.com"          `T.isInfixOf` url = "github"
    | "git.levineuwirth.org" `T.isInfixOf` url = "forgejo"
    | "tensorflow.org"      `T.isInfixOf` url = "tensorflow"
    -- AI companies (consumer products share a brand icon with the lab)
    | "anthropic.com"       `T.isInfixOf` url = "anthropic"
    | "claude.ai"           `T.isInfixOf` url = "anthropic"
    | "openai.com"          `T.isInfixOf` url = "openai"
    | "chatgpt.com"         `T.isInfixOf` url = "openai"
    -- Social / media
    | "twitter.com"         `T.isInfixOf` url = "twitter"
    | "x.com"               `T.isInfixOf` url = "twitter"
    | "reddit.com"          `T.isInfixOf` url = "reddit"
    | "youtube.com"         `T.isInfixOf` url = "youtube"
    | "youtu.be"            `T.isInfixOf` url = "youtube"
    | "tiktok.com"          `T.isInfixOf` url = "tiktok"
    | "substack.com"        `T.isInfixOf` url = "substack"
    | "news.ycombinator.com" `T.isInfixOf` url = "hacker-news"
    | "lesswrong.com"       `T.isInfixOf` url = "lesswrong"
    -- News
    | "nytimes.com"         `T.isInfixOf` url = "new-york-times"
    -- Institutions
    | "nasa.gov"            `T.isInfixOf` url = "nasa"
    | "apple.com"           `T.isInfixOf` url = "apple"
    | otherwise                                = "external"

-- | Percent-encode characters that would break a @?file=@ query-string value.
--   Slashes are intentionally left unencoded so root-relative paths remain
--   readable and work correctly with PDF.js's internal fetch.
encodeQueryValue :: Text -> Text
encodeQueryValue = T.concatMap enc
  where
    enc ' ' = "%20"
    enc '&' = "%26"
    enc '?' = "%3F"
    enc '+' = "%2B"
    enc '"' = "%22"
    enc c   = T.singleton c
