{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE OverloadedStrings #-}
module Contexts
    ( siteCtx
    , essayCtx
    , postCtx
    , pageCtx
    , poetryCtx
    , fictionCtx
    , compositionCtx
    , contentKindField
    ) where

import Data.Aeson              (Value (..))
import qualified Data.Aeson.KeyMap  as KM
import qualified Data.Vector        as V
import Data.List               (isPrefixOf)
import Data.Maybe              (catMaybes, fromMaybe)
import Data.Time.Calendar      (toGregorian)
import Data.Time.Clock         (getCurrentTime, utctDay)
import Data.Time.Format        (formatTime, defaultTimeLocale)
import System.FilePath         (takeDirectory, takeFileName)
import Text.Read               (readMaybe)
import qualified Data.Text     as T
import Text.Pandoc             (runPure, readMarkdown, writeHtml5String, Pandoc(..), Block(..), Inline(..))
import Text.Pandoc.Options     (WriterOptions(..), HTMLMathMethod(..))
import Hakyll
import Hakyll.Core.Metadata    (lookupStringList)
import Authors      (authorLinksField)
import Backlinks    (backlinksField)
import SimilarLinks (similarLinksField)
import Stability    (stabilityField, lastReviewedField, versionHistoryField)
import Tags       (tagLinksField)

-- ---------------------------------------------------------------------------
-- Affiliation field
-- ---------------------------------------------------------------------------

-- | Parses the @affiliation@ frontmatter key and exposes each entry as
--   @affiliation-name@ / @affiliation-url@ pairs.
--
--   Accepts a scalar string or a YAML list. Each entry may use pipe syntax:
--     @"Brown University | https://cs.brown.edu"@
--   Entries without a URL still produce a row; @affiliation-url@ fails
--   (evaluates to noResult), so @$if(affiliation-url)$@ works in templates.
--
--   Usage:
--     $for(affiliation-links)$
--       $if(affiliation-url)$<a href="$affiliation-url$">$affiliation-name$</a>
--       $else$$affiliation-name$$endif$$sep$ · $endfor$
affiliationField :: Context a
affiliationField = listFieldWith "affiliation-links" ctx $ \item -> do
    meta <- getMetadata (itemIdentifier item)
    let entries = case lookupStringList "affiliation" meta of
                    Just xs -> xs
                    Nothing -> maybe [] (:[]) (lookupString "affiliation" meta)
    return $ map (Item (fromFilePath "") . parseEntry) entries
  where
    ctx = field "affiliation-name" (return . fst . itemBody)
       <> field "affiliation-url"  (\i -> let u = snd (itemBody i)
                                           in if null u then noResult "no url" else return u)
    parseEntry s = case break (== '|') s of
        (name, '|' : url) -> (trim name, trim url)
        (name, _)         -> (trim name, "")

-- ---------------------------------------------------------------------------
-- Build time field
-- ---------------------------------------------------------------------------

-- | Resolves to the time the current item was compiled, formatted as
--   "Saturday, November 15th, 2025 15:05:55" (UTC).
buildTimeField :: Context String
buildTimeField = field "build-time" $ \_ ->
    unsafeCompiler $ do
        t <- getCurrentTime
        let (_, _, d) = toGregorian (utctDay t)
            prefix    = formatTime defaultTimeLocale "%A, %B " t
            suffix    = formatTime defaultTimeLocale ", %Y %H:%M:%S" t
        return (prefix ++ show d ++ ordSuffix d ++ suffix)
  where
    ordSuffix n
        | n `elem` [11,12,13] = "th"
        | n `mod` 10 == 1     = "st"
        | n `mod` 10 == 2     = "nd"
        | n `mod` 10 == 3     = "rd"
        | otherwise            = "th"

-- ---------------------------------------------------------------------------
-- Content kind field
-- ---------------------------------------------------------------------------

-- | @$item-kind$@: human-readable content type derived from the item's route.
-- Used on the New page to label each entry (Essay, Post, Poem, etc.).
contentKindField :: Context String
contentKindField = field "item-kind" $ \item -> do
    r <- getRoute (itemIdentifier item)
    return $ case r of
        Nothing -> "Page"
        Just route
            | "essays/"  `isPrefixOf` route -> "Essay"
            | "blog/"    `isPrefixOf` route -> "Post"
            | "poetry/"  `isPrefixOf` route -> "Poem"
            | "fiction/" `isPrefixOf` route -> "Fiction"
            | "music/"   `isPrefixOf` route -> "Composition"
            | otherwise                      -> "Page"

-- ---------------------------------------------------------------------------
-- Site-wide context
-- ---------------------------------------------------------------------------

-- | @$page-scripts$@ — list field providing @$script-src$@ for each entry
-- in the @js:@ frontmatter key (accepts a scalar string or a YAML list).
-- Returns an empty list when absent; $for iterates zero times, emitting nothing.
-- NOTE: do not use fail here — $for does not catch noResult the way $if does.
pageScriptsField :: Context String
pageScriptsField = listFieldWith "page-scripts" ctx $ \item -> do
    meta <- getMetadata (itemIdentifier item)
    let scripts = case lookupStringList "js" meta of
                    Just xs -> xs
                    Nothing -> maybe [] (:[]) (lookupString "js" meta)
    return $ map (\s -> Item (fromFilePath s) s) scripts
  where
    ctx = field "script-src" (return . itemBody)

-- ---------------------------------------------------------------------------
-- Abstract field
-- ---------------------------------------------------------------------------

-- | Renders the abstract using Pandoc to support Markdown and LaTeX math.
--   Strips the outer <p> tag if the abstract is a single paragraph.
abstractField :: Context String
abstractField = field "abstract" $ \item -> do
    meta <- getMetadata (itemIdentifier item)
    case lookupString "abstract" meta of
        Nothing -> fail "no abstract"
        Just src -> do
            let pandocResult = runPure $ do
                    doc <- readMarkdown defaultHakyllReaderOptions (T.pack src)
                    let doc' = case doc of
                                 Pandoc m [Para ils] -> Pandoc m [Plain ils]
                                 _                   -> doc
                    let wOpts = defaultHakyllWriterOptions { writerHTMLMathMethod = KaTeX "" }
                    writeHtml5String wOpts doc'
            case pandocResult of
                Left err -> fail $ "Pandoc error rendering abstract: " ++ show err
                Right html -> return (T.unpack html)

siteCtx :: Context String
siteCtx =
    constField "site-title" "Levi Neuwirth"
    <> constField "site-url" "https://levineuwirth.org"
    <> buildTimeField
    <> pageScriptsField
    <> abstractField
    <> defaultContext

-- ---------------------------------------------------------------------------
-- Helper: load a named snapshot as a context field
-- ---------------------------------------------------------------------------

-- | @snapshotField name snap@ creates a context field @name@ whose value is
--   the body of the snapshot @snap@ saved for the current item.
snapshotField :: String -> Snapshot -> Context String
snapshotField name snap = field name $ \item ->
    itemBody <$> loadSnapshot (itemIdentifier item) snap

-- ---------------------------------------------------------------------------
-- Essay context
-- ---------------------------------------------------------------------------

-- | Bibliography field: loads the citation HTML saved by essayCompiler.
--   Returns noResult (making $if(bibliography)$ false) when empty.
--   Also provides $has-citations$ for conditional JS loading.
bibliographyField :: Context String
bibliographyField = bibContent <> hasCitations
  where
    bibContent = field "bibliography" $ \item -> do
        bib <- itemBody <$> loadSnapshot (itemIdentifier item) "bibliography"
        if null bib then fail "no bibliography" else return bib
    hasCitations = field "has-citations" $ \item -> do
        bib <- itemBody <$> (loadSnapshot (itemIdentifier item) "bibliography"
                              :: Compiler (Item String))
        if null bib then fail "no citations" else return "true"

-- | Further-reading field: loads the further-reading HTML saved by essayCompiler.
--   Returns noResult (making $if(further-reading-refs)$ false) when empty.
furtherReadingField :: Context String
furtherReadingField = field "further-reading-refs" $ \item -> do
    fr <- itemBody <$> (loadSnapshot (itemIdentifier item) "further-reading-refs"
                          :: Compiler (Item String))
    if null fr then fail "no further reading" else return fr

-- ---------------------------------------------------------------------------
-- Epistemic fields
-- ---------------------------------------------------------------------------

-- | Render an integer 1–5 frontmatter key as filled/empty dot chars.
-- Returns @noResult@ when the key is absent or unparseable.
dotsField :: String -> String -> Context String
dotsField ctxKey metaKey = field ctxKey $ \item -> do
    meta <- getMetadata (itemIdentifier item)
    case lookupString metaKey meta >>= readMaybe of
        Nothing -> fail (ctxKey ++ ": not set")
        Just (n :: Int) ->
            let v = max 0 (min 5 n)
            in  return (replicate v '\x25CF' ++ replicate (5 - v) '\x25CB')

-- | @$confidence-trend$@: ↑, ↓, or → derived from the last two entries
-- in the @confidence-history@ frontmatter list.  Returns @noResult@ when
-- there is no history or only a single entry.
confidenceTrendField :: Context String
confidenceTrendField = field "confidence-trend" $ \item -> do
    meta <- getMetadata (itemIdentifier item)
    case lookupStringList "confidence-history" meta of
        Nothing                -> fail "no confidence history"
        Just xs | length xs < 2 -> fail "no confidence history"
        Just xs ->
            let prev = readMaybe (xs !! (length xs - 2)) :: Maybe Int
                cur  = readMaybe (last xs)               :: Maybe Int
            in  case (prev, cur) of
                    (Just p, Just c)
                        | c - p >  5 -> return "\x2191"   -- ↑
                        | p - c >  5 -> return "\x2193"   -- ↓
                        | otherwise  -> return "\x2192"   -- →
                    _ -> return "\x2192"

-- | @$overall-score$@: weighted composite of confidence (50 %),
--   evidence quality (30 %), and importance (20 %), expressed as an
--   integer on a 0–100 scale.
--   Returns @noResult@ when any contributing field is absent, so
--   @$if(overall-score)$@ guards the template safely.
--
--   Formula:  raw   = conf/100·0.5 + ev/5·0.3 + imp/5·0.2   (0–1)
--             score = clamp₀₋₁₀₀(round(raw · 100))
overallScoreField :: Context String
overallScoreField = field "overall-score" $ \item -> do
    meta <- getMetadata (itemIdentifier item)
    let readInt s = readMaybe s :: Maybe Int
    case ( readInt =<< lookupString "confidence" meta
         , readInt =<< lookupString "evidence"   meta
         , readInt =<< lookupString "importance" meta
         ) of
        (Just conf, Just ev, Just imp) ->
            let raw :: Double
                raw   = fromIntegral conf / 100.0 * 0.5
                      + fromIntegral ev  / 5.0   * 0.3
                      + fromIntegral imp / 5.0   * 0.2
                score = max 0 (min 100 (round (raw * 100.0) :: Int))
            in  return (show score)
        _ -> fail "overall-score: confidence, evidence, or importance not set"

-- | All epistemic context fields composed.
epistemicCtx :: Context String
epistemicCtx =
    dotsField "importance-dots" "importance"
    <> dotsField "evidence-dots" "evidence"
    <> overallScoreField
    <> confidenceTrendField
    <> stabilityField
    <> lastReviewedField

-- ---------------------------------------------------------------------------
-- Essay context
-- ---------------------------------------------------------------------------

essayCtx :: Context String
essayCtx =
    authorLinksField
    <> affiliationField
    <> snapshotField "toc"          "toc"
    <> snapshotField "word-count"   "word-count"
    <> snapshotField "reading-time" "reading-time"
    <> bibliographyField
    <> furtherReadingField
    <> backlinksField
    <> similarLinksField
    <> epistemicCtx
    <> versionHistoryField
    <> dateField "date-created" "%-d %B %Y"
    <> dateField "date-modified" "%-d %B %Y"
    <> constField "math" "true"
    <> tagLinksField "essay-tags"
    <> siteCtx

-- ---------------------------------------------------------------------------
-- Post context
-- ---------------------------------------------------------------------------

postCtx :: Context String
postCtx =
    authorLinksField
    <> affiliationField
    <> backlinksField
    <> similarLinksField
    <> dateField "date"     "%-d %B %Y"
    <> dateField "date-iso" "%Y-%m-%d"
    <> constField "math" "true"
    <> siteCtx

-- ---------------------------------------------------------------------------
-- Page context
-- ---------------------------------------------------------------------------

pageCtx :: Context String
pageCtx = authorLinksField <> affiliationField <> siteCtx

-- ---------------------------------------------------------------------------
-- Reading contexts (fiction + poetry)
-- ---------------------------------------------------------------------------

-- | Base reading context: essay fields + the "reading" flag (activates
--   reading.css / reading.js via head.html and body class via default.html).
readingCtx :: Context String
readingCtx = essayCtx <> constField "reading" "true"

-- | Poetry context: reading mode + "poetry" flag for CSS body class.
poetryCtx :: Context String
poetryCtx = readingCtx <> constField "poetry" "true"

-- | Fiction context: reading mode + "fiction" flag for CSS body class.
fictionCtx :: Context String
fictionCtx = readingCtx <> constField "fiction" "true"

-- ---------------------------------------------------------------------------
-- Composition context (music landing pages + score reader)
-- ---------------------------------------------------------------------------

data Movement = Movement
    { movName     :: String
    , movPage     :: Int
    , movDuration :: String
    , movAudio    :: Maybe String
    }

parseMovements :: Metadata -> [Movement]
parseMovements meta =
    case KM.lookup "movements" meta of
        Just (Array v) -> catMaybes $ map parseOne (V.toList v)
        _              -> []
  where
    parseOne (Object o) = Movement
        <$> (getString =<< KM.lookup "name"     o)
        <*> (getInt    =<< KM.lookup "page"     o)
        <*> (getString =<< KM.lookup "duration" o)
        <*> pure (getString =<< KM.lookup "audio" o)
    parseOne _ = Nothing

    getString (String t) = Just (T.unpack t)
    getString _          = Nothing

    getInt (Number n) = Just (floor (fromRational (toRational n) :: Double))
    getInt _          = Nothing

-- | Extract the composition slug from an item's identifier.
--   "content/music/symphonic-dances/index.md" → "symphonic-dances"
compSlug :: Item a -> String
compSlug = takeFileName . takeDirectory . toFilePath . itemIdentifier

-- | Context for music composition landing pages and the score reader.
--   Extends essayCtx with composition-specific fields:
--     $slug$             — URL slug (e.g. "symphonic-dances")
--     $score-url$        — absolute URL of the score reader page
--     $has-score$        — present when score-pages frontmatter is non-empty
--     $score-page-count$ — total number of score pages
--     $score-pages$      — list of {score-page-url} items
--     $has-movements$    — present when movements frontmatter is non-empty
--     $movements$        — list of {movement-name, movement-page,
--                            movement-duration, movement-audio, has-audio}
--   All other frontmatter keys (instrumentation, duration, premiere,
--   commissioned-by, pdf, abstract, etc.) are available via defaultContext.
compositionCtx :: Context String
compositionCtx =
    constField "composition" "true"
    <> slugField
    <> scoreUrlField
    <> hasScoreField
    <> scorePageCountField
    <> scorePagesListField
    <> hasMovementsField
    <> movementsListField
    <> essayCtx
  where
    slugField = field "slug" (return . compSlug)

    scoreUrlField = field "score-url" $ \item ->
        return $ "/music/" ++ compSlug item ++ "/score/"

    hasScoreField = field "has-score" $ \item -> do
        meta <- getMetadata (itemIdentifier item)
        let pages = fromMaybe [] (lookupStringList "score-pages" meta)
        if null pages then fail "no score pages" else return "true"

    scorePageCountField = field "score-page-count" $ \item -> do
        meta <- getMetadata (itemIdentifier item)
        let pages = fromMaybe [] (lookupStringList "score-pages" meta)
        return $ show (length pages)

    scorePagesListField = listFieldWith "score-pages" spCtx $ \item -> do
        meta <- getMetadata (itemIdentifier item)
        let slug  = compSlug item
            base  = "/music/" ++ slug ++ "/"
            pages = fromMaybe [] (lookupStringList "score-pages" meta)
        return $ map (\p -> Item (fromFilePath p) (base ++ p)) pages
      where
        spCtx = field "score-page-url" (return . itemBody)

    hasMovementsField = field "has-movements" $ \item -> do
        meta <- getMetadata (itemIdentifier item)
        if null (parseMovements meta) then fail "no movements" else return "true"

    movementsListField = listFieldWith "movements" movCtx $ \item -> do
        meta <- getMetadata (itemIdentifier item)
        let mvs = parseMovements meta
        return $ zipWith
            (\idx mv -> Item (fromFilePath ("mv" ++ show (idx :: Int))) mv)
            [1..] mvs
      where
        movCtx =
            field "movement-name"     (return . movName     . itemBody)
            <> field "movement-page"  (return . show . movPage . itemBody)
            <> field "movement-duration" (return . movDuration . itemBody)
            <> field "movement-audio"
                (\i -> maybe (fail "no audio") return (movAudio (itemBody i)))
            <> field "has-audio"
                (\i -> maybe (fail "no audio") (const (return "true"))
                             (movAudio (itemBody i)))