{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE OverloadedStrings #-}
module Site (rules) where

import Control.Monad (filterM, when)
import Data.List     (isPrefixOf)
import Data.Maybe    (catMaybes, fromMaybe)
import System.Environment (lookupEnv)
import System.FilePath (takeDirectory, takeFileName, replaceExtension)
import Text.Read     (readMaybe)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.Map.Strict as Map
import Hakyll
import Authors    (buildAllAuthors, applyAuthorRules)
import Backlinks  (backlinkRules)
import Compilers  (essayCompiler, postCompiler, pageCompiler, poetryCompiler, fictionCompiler,
                   compositionCompiler)
import Catalog      (musicCatalogCtx)
import Commonplace  (commonplaceCtx)
import Contexts   (siteCtx, essayCtx, postCtx, pageCtx, poetryCtx, fictionCtx, compositionCtx,
                   contentKindField)
import qualified Patterns as P
import Tags       (buildAllTags, applyTagRules)
import Pagination (blogPaginateRules)
import Stats      (statsRules)

-- Poems inside collection subdirectories, excluding their index pages.
collectionPoems :: Pattern
collectionPoems = "content/poetry/*/*.md" .&&. complement "content/poetry/*/index.md"

-- All poetry content (flat + collection), excluding collection index pages.
allPoetry :: Pattern
allPoetry = "content/poetry/*.md" .||. collectionPoems

feedConfig :: FeedConfiguration
feedConfig = FeedConfiguration
    { feedTitle       = "Levi Neuwirth"
    , feedDescription = "Essays, notes, and creative work by Levi Neuwirth"
    , feedAuthorName  = "Levi Neuwirth"
    , feedAuthorEmail = "levi@levineuwirth.org"
    , feedRoot        = "https://levineuwirth.org"
    }

musicFeedConfig :: FeedConfiguration
musicFeedConfig = FeedConfiguration
    { feedTitle       = "Levi Neuwirth — Music"
    , feedDescription = "New compositions by Levi Neuwirth"
    , feedAuthorName  = "Levi Neuwirth"
    , feedAuthorEmail = "levi@levineuwirth.org"
    , feedRoot        = "https://levineuwirth.org"
    }

rules :: Rules ()
rules = do
    -- ---------------------------------------------------------------------------
    -- Build mode. SITE_ENV=dev (set by `make dev` / `make watch`) includes
    -- drafts under content/drafts/**; anything else (unset, "deploy", "build")
    -- excludes them entirely from every match, listing, and asset rule below.
    -- ---------------------------------------------------------------------------
    isDev <- preprocess $ (== Just "dev") <$> lookupEnv "SITE_ENV"
    let allEssays = if isDev
                    then P.essayPattern .||. P.draftEssayPattern
                    else P.essayPattern

    -- ---------------------------------------------------------------------------
    -- Backlinks (pass 1: link extraction; pass 2: JSON generation)
    -- Must run before content rules so dependencies resolve correctly.
    -- ---------------------------------------------------------------------------
    backlinkRules

    -- ---------------------------------------------------------------------------
    -- Author index pages
    -- ---------------------------------------------------------------------------
    authors <- buildAllAuthors
    applyAuthorRules authors siteCtx

    -- ---------------------------------------------------------------------------
    -- Tag index pages
    -- ---------------------------------------------------------------------------
    tags <- buildAllTags
    applyTagRules tags siteCtx
    statsRules tags

    -- Per-page JS files — authored alongside content in content/**/*.js.
    -- Draft JS is handled by a separate dev-only rule below.
    match ("content/**/*.js" .&&. complement "content/drafts/**") $ do
        route   $ gsubRoute "content/" (const "")
        compile copyFileCompiler

    -- Per-page JS co-located with draft essays (dev-only).
    when isDev $ match "content/drafts/**/*.js" $ do
        route   $ gsubRoute "content/" (const "")
        compile copyFileCompiler

    -- CSS — must be matched before the broad static/** rule to avoid
    -- double-matching (compressCssCompiler vs. copyFileCompiler).
    match "static/css/*" $ do
        route   $ gsubRoute "static/" (const "")
        compile compressCssCompiler

    -- All other static files (fonts, JS, images, …)
    match ("static/**" .&&. complement "static/css/*") $ do
        route   $ gsubRoute "static/" (const "")
        compile copyFileCompiler

    -- Templates
    match "templates/**" $ compile templateBodyCompiler

    -- Link annotations — author-defined previews for any URL
    match "data/annotations.json" $ do
        route   idRoute
        compile copyFileCompiler

    -- Semantic search index — produced by tools/embed.py; fetched at runtime
    -- by static/js/semantic-search.js from /data/semantic-index.bin and
    -- /data/semantic-meta.json.
    match ("data/semantic-index.bin" .||. "data/semantic-meta.json") $ do
        route   idRoute
        compile copyFileCompiler

    -- Similar links — produced by tools/embed.py; absent on first build or
    -- when .venv is not set up.  Compiled as a raw string for similarLinksField.
    match "data/similar-links.json" $ compile getResourceBody

    -- Commonplace YAML — compiled as a raw string so it can be loaded
    -- with dependency tracking by the commonplace page compiler.
    match "data/commonplace.yaml" $ compile getResourceBody

    -- ---------------------------------------------------------------------------
    -- Homepage
    -- ---------------------------------------------------------------------------
    match "content/index.md" $ do
        route   $ constRoute "index.html"
        compile $ pageCompiler
            >>= loadAndApplyTemplate "templates/home.html"    pageCtx
            >>= loadAndApplyTemplate "templates/default.html" pageCtx
            >>= relativizeUrls

    -- ---------------------------------------------------------------------------
    -- Standalone pages (me/, colophon.md, …)
    -- ---------------------------------------------------------------------------
    -- me/index.md — compiled as a full essay (TOC, metadata block, sidenotes).
    -- Lives in its own directory so co-located SVG score fragments resolve
    -- correctly: the Score filter reads paths relative to the source file's
    -- directory (content/me/), not the content root.
    match "content/me/index.md" $ do
        route   $ constRoute "me.html"
        compile $ essayCompiler
            >>= loadAndApplyTemplate "templates/essay.html"   essayCtx
            >>= loadAndApplyTemplate "templates/default.html" essayCtx
            >>= relativizeUrls

    -- SVG score fragments co-located with me/index.md.
    match "content/me/scores/*.svg" $ do
        route   $ gsubRoute "content/me/" (const "")
        compile copyFileCompiler

    -- memento-mori/index.md — lives in its own directory so co-located SVG
    -- score fragments resolve correctly (same pattern as me/index.md).
    match "content/memento-mori/index.md" $ do
        route   $ constRoute "memento-mori.html"
        compile $ essayCompiler
            >>= loadAndApplyTemplate "templates/essay.html"
                    (constField "memento-mori" "true" <> essayCtx)
            >>= loadAndApplyTemplate "templates/default.html"
                    (constField "memento-mori" "true" <> essayCtx)
            >>= relativizeUrls

    -- SVG score fragments co-located with memento-mori/index.md.
    match "content/memento-mori/scores/*.svg" $ do
        route   $ gsubRoute "content/memento-mori/" (const "")
        compile copyFileCompiler

    -- ---------------------------------------------------------------------------
    -- Commonplace book
    -- ---------------------------------------------------------------------------
    match "content/commonplace.md" $ do
        route   $ constRoute "commonplace.html"
        compile $ pageCompiler
            >>= loadAndApplyTemplate "templates/commonplace.html" commonplaceCtx
            >>= loadAndApplyTemplate "templates/default.html"     commonplaceCtx
            >>= relativizeUrls

    match "content/colophon.md" $ do
        route   $ constRoute "colophon.html"
        compile $ essayCompiler
            >>= loadAndApplyTemplate "templates/essay.html"   essayCtx
            >>= loadAndApplyTemplate "templates/default.html" essayCtx
            >>= relativizeUrls

    match ("content/*.md"
            .&&. complement "content/index.md"
            .&&. complement "content/commonplace.md"
            .&&. complement "content/colophon.md") $ do
        route   $ gsubRoute "content/" (const "")
                  `composeRoutes` setExtension "html"
        compile $ pageCompiler
            >>= loadAndApplyTemplate "templates/page.html"    pageCtx
            >>= loadAndApplyTemplate "templates/default.html" pageCtx
            >>= relativizeUrls

    -- ---------------------------------------------------------------------------
    -- Essays — flat (content/essays/foo.md → essays/foo.html) and
    --          directory-based (content/essays/slug/index.md → essays/slug/index.html).
    --          In dev mode, drafts under content/drafts/essays/ route to
    --          drafts/essays/foo.html (flat) or drafts/essays/slug/index.html (dir).
    -- ---------------------------------------------------------------------------
    match allEssays $ do
        route $ customRoute $ \ident ->
            let fp       = toFilePath ident
                fname    = takeFileName fp
                isIndex  = fname == "index.md"
                isDraft  = "content/drafts/essays/" `isPrefixOf` fp
            in case (isDraft, isIndex) of
                -- content/drafts/essays/slug/index.md → drafts/essays/slug/index.html
                (True,  True)  -> replaceExtension (drop 8 fp) "html"
                -- content/drafts/essays/foo.md        → drafts/essays/foo.html
                (True,  False) -> "drafts/essays/" ++ replaceExtension fname "html"
                -- content/essays/slug/index.md        → essays/slug/index.html
                (False, True)  -> replaceExtension (drop 8 fp) "html"
                -- content/essays/foo.md               → essays/foo.html
                (False, False) -> "essays/" ++ replaceExtension fname "html"
        compile $ essayCompiler
            >>= saveSnapshot "content"
            >>= loadAndApplyTemplate "templates/essay.html"   essayCtx
            >>= loadAndApplyTemplate "templates/default.html" essayCtx
            >>= relativizeUrls

    -- Static assets co-located with directory-based essays (figures, data, PDFs, …)
    match ("content/essays/**"
           .&&. complement "content/essays/*.md"
           .&&. complement "content/essays/*/index.md") $ do
        route $ gsubRoute "content/" (const "")
        compile copyFileCompiler

    -- Static assets co-located with draft essays (dev-only).
    when isDev $ match ("content/drafts/essays/**"
                        .&&. complement "content/drafts/essays/*.md"
                        .&&. complement "content/drafts/essays/*/index.md") $ do
        route $ gsubRoute "content/" (const "")
        compile copyFileCompiler

    -- ---------------------------------------------------------------------------
    -- Blog posts
    -- ---------------------------------------------------------------------------
    match "content/blog/*.md" $ do
        route   $ gsubRoute "content/blog/" (const "blog/")
                  `composeRoutes` setExtension "html"
        compile $ postCompiler
            >>= saveSnapshot "content"
            >>= loadAndApplyTemplate "templates/blog-post.html" postCtx
            >>= loadAndApplyTemplate "templates/default.html"   postCtx
            >>= relativizeUrls

    -- ---------------------------------------------------------------------------
    -- Poetry
    -- ---------------------------------------------------------------------------
    -- Flat poems (e.g. content/poetry/sonnet-60.md)
    match "content/poetry/*.md" $ do
        route   $ gsubRoute "content/poetry/" (const "poetry/")
                  `composeRoutes` setExtension "html"
        compile $ poetryCompiler
            >>= saveSnapshot "content"
            >>= loadAndApplyTemplate "templates/reading.html"  poetryCtx
            >>= loadAndApplyTemplate "templates/default.html"  poetryCtx
            >>= relativizeUrls

    -- Collection poems (e.g. content/poetry/shakespeare-sonnets/sonnet-1.md)
    match collectionPoems $ do
        route   $ gsubRoute "content/poetry/" (const "poetry/")
                  `composeRoutes` setExtension "html"
        compile $ poetryCompiler
            >>= saveSnapshot "content"
            >>= loadAndApplyTemplate "templates/reading.html"  poetryCtx
            >>= loadAndApplyTemplate "templates/default.html"  poetryCtx
            >>= relativizeUrls

    -- Collection index pages (e.g. content/poetry/shakespeare-sonnets/index.md)
    match "content/poetry/*/index.md" $ do
        route   $ gsubRoute "content/poetry/" (const "poetry/")
                  `composeRoutes` setExtension "html"
        compile $ pageCompiler
            >>= loadAndApplyTemplate "templates/default.html"  pageCtx
            >>= relativizeUrls

    -- ---------------------------------------------------------------------------
    -- Fiction
    -- ---------------------------------------------------------------------------
    match "content/fiction/*.md" $ do
        route   $ gsubRoute "content/fiction/" (const "fiction/")
                  `composeRoutes` setExtension "html"
        compile $ fictionCompiler
            >>= saveSnapshot "content"
            >>= loadAndApplyTemplate "templates/reading.html"  fictionCtx
            >>= loadAndApplyTemplate "templates/default.html"  fictionCtx
            >>= relativizeUrls

    -- ---------------------------------------------------------------------------
    -- Music — catalog index
    -- ---------------------------------------------------------------------------
    match "content/music/index.md" $ do
        route   $ constRoute "music/index.html"
        compile $ pageCompiler
            >>= loadAndApplyTemplate "templates/music-catalog.html" musicCatalogCtx
            >>= loadAndApplyTemplate "templates/default.html"       musicCatalogCtx
            >>= relativizeUrls

    -- ---------------------------------------------------------------------------
    -- Music — composition landing pages + score reader
    -- ---------------------------------------------------------------------------

    -- Static assets (SVG score pages, audio, PDF) served unchanged.
    match "content/music/**/*.svg" $ do
        route   $ gsubRoute "content/" (const "")
        compile copyFileCompiler

    match "content/music/**/*.mp3" $ do
        route   $ gsubRoute "content/" (const "")
        compile copyFileCompiler

    match "content/music/**/*.pdf" $ do
        route   $ gsubRoute "content/" (const "")
        compile copyFileCompiler

    -- Landing page — full essay pipeline.
    match "content/music/*/index.md" $ do
        route   $ gsubRoute "content/" (const "")
                  `composeRoutes` setExtension "html"
        compile $ compositionCompiler
            >>= saveSnapshot "content"
            >>= loadAndApplyTemplate "templates/composition.html"  compositionCtx
            >>= loadAndApplyTemplate "templates/default.html"      compositionCtx
            >>= relativizeUrls

    -- Score reader — separate URL, minimal chrome.
    -- Compiled from the same source with version "score-reader".
    match "content/music/*/index.md" $ version "score-reader" $ do
        route $ customRoute $ \ident ->
            let slug = takeFileName . takeDirectory . toFilePath $ ident
            in  "music/" ++ slug ++ "/score/index.html"
        compile $ do
            makeItem ""
                >>= loadAndApplyTemplate "templates/score-reader.html"
                                         compositionCtx
                >>= loadAndApplyTemplate "templates/score-reader-default.html"
                                         compositionCtx
                >>= relativizeUrls

    -- ---------------------------------------------------------------------------
    -- Blog index (paginated)
    -- ---------------------------------------------------------------------------
    blogPaginateRules postCtx siteCtx

    -- ---------------------------------------------------------------------------
    -- Essay index
    -- ---------------------------------------------------------------------------
    create ["essays/index.html"] $ do
        route idRoute
        compile $ do
            essays <- recentFirst =<< loadAll (allEssays .&&. hasNoVersion)
            let ctx =
                    listField "essays" essayCtx (return essays)
                    <> constField "title" "Essays"
                    <> siteCtx
            makeItem ""
                >>= loadAndApplyTemplate "templates/essay-index.html" ctx
                >>= loadAndApplyTemplate "templates/default.html"      ctx
                >>= relativizeUrls

    -- ---------------------------------------------------------------------------
    -- New page — all content sorted by creation date, newest first
    -- ---------------------------------------------------------------------------
    create ["new.html"] $ do
        route idRoute
        compile $ do
            let allContent = (   allEssays
                             .||. "content/blog/*.md"
                             .||. "content/fiction/*.md"
                             .||. allPoetry
                             .||. "content/music/*/index.md"
                             ) .&&. hasNoVersion
            items <- recentFirst =<< loadAll allContent
            let itemCtx = contentKindField
                       <> dateField "date-iso" "%Y-%m-%d"
                       <> essayCtx
                ctx = listField "recent-items" itemCtx (return items)
                   <> constField "title" "New"
                   <> constField "new-page" "true"
                   <> siteCtx
            makeItem ""
                >>= loadAndApplyTemplate "templates/new.html"     ctx
                >>= loadAndApplyTemplate "templates/default.html" ctx
                >>= relativizeUrls

    -- ---------------------------------------------------------------------------
    -- Library — comprehensive portal-grouped index of all content
    -- ---------------------------------------------------------------------------
    create ["library.html"] $ do
        route idRoute
        compile $ do
            -- Helper: filter all content to items whose tags include a given portal.
            -- A tag matches portal P if it equals "P" or starts with "P/".
            let hasPortal p item = do
                    meta <- getMetadata (itemIdentifier item)
                    let ts = fromMaybe [] (lookupStringList "tags" meta)
                    return $ any (\t -> t == p || (p ++ "/") `isPrefixOf` t) ts

                itemCtx = dateField "date-iso" "%Y-%m-%d" <> essayCtx

                portalList name p = listField name itemCtx $ do
                    essays  <- loadAll (allEssays              .&&. hasNoVersion)
                    posts   <- loadAll ("content/blog/*.md"    .&&. hasNoVersion)
                    fiction <- loadAll ("content/fiction/*.md" .&&. hasNoVersion)
                    poetry  <- loadAll (allPoetry             .&&. hasNoVersion)
                    filtered <- filterM (hasPortal p) (essays ++ posts ++ fiction ++ poetry)
                    recentFirst filtered

            let ctx = portalList "ai-entries"         "ai"
                   <> portalList "fiction-entries"    "fiction"
                   <> portalList "miscellany-entries" "miscellany"
                   <> portalList "music-entries"      "music"
                   <> portalList "nonfiction-entries" "nonfiction"
                   <> portalList "poetry-entries"     "poetry"
                   <> portalList "research-entries"   "research"
                   <> portalList "tech-entries"       "tech"
                   <> constField "title"   "Library"
                   <> constField "library" "true"
                   <> siteCtx

            makeItem ""
                >>= loadAndApplyTemplate "templates/library.html"  ctx
                >>= loadAndApplyTemplate "templates/default.html"  ctx
                >>= relativizeUrls

    -- ---------------------------------------------------------------------------
    -- Random page manifest — essays + blog posts only (no pagination/index pages)
    -- ---------------------------------------------------------------------------
    create ["random-pages.json"] $ do
        route idRoute
        compile $ do
            essays  <- loadAll (allEssays              .&&. hasNoVersion) :: Compiler [Item String]
            posts   <- loadAll ("content/blog/*.md"    .&&. hasNoVersion) :: Compiler [Item String]
            fiction <- loadAll ("content/fiction/*.md" .&&. hasNoVersion) :: Compiler [Item String]
            poetry  <- loadAll ("content/poetry/*.md"  .&&. hasNoVersion) :: Compiler [Item String]
            routes  <- mapM (getRoute . itemIdentifier) (essays ++ posts ++ fiction ++ poetry)
            let urls = [ "/" ++ r | Just r <- routes ]
            makeItem $ LBS.unpack (Aeson.encode urls)

    -- ---------------------------------------------------------------------------
    -- Epistemic metadata manifest — maps page URLs to epistemic fields
    -- (status, confidence, importance, evidence, scope, novelty, practicality,
    -- stability, score) for client-side search filtering.
    -- ---------------------------------------------------------------------------
    create ["data/epistemic-meta.json"] $ do
        route idRoute
        compile $ do
            essays  <- loadAll (allEssays              .&&. hasNoVersion) :: Compiler [Item String]
            posts   <- loadAll ("content/blog/*.md"    .&&. hasNoVersion) :: Compiler [Item String]
            fiction <- loadAll ("content/fiction/*.md"  .&&. hasNoVersion) :: Compiler [Item String]
            poetry  <- loadAll (allPoetry              .&&. hasNoVersion) :: Compiler [Item String]
            music   <- loadAll ("content/music/*/index.md" .&&. hasNoVersion) :: Compiler [Item String]
            let items = essays ++ posts ++ fiction ++ poetry ++ music
            pairs <- mapM epistemicEntry items
            let metaMap = Map.fromList (catMaybes pairs)
            makeItem $ LBS.unpack (Aeson.encode metaMap)

    -- ---------------------------------------------------------------------------
    -- Atom feed — all content sorted by date
    -- ---------------------------------------------------------------------------
    create ["feed.xml"] $ do
        route idRoute
        compile $ do
            posts <- fmap (take 30) . recentFirst
                        =<< loadAllSnapshots
                                (   (    allEssays
                                    .||. "content/blog/*.md"
                                    .||. "content/fiction/*.md"
                                    .||. allPoetry
                                    .||. "content/music/*/index.md"
                                    )
                                .&&. hasNoVersion
                                )
                                "content"
            let feedCtx =
                    dateField "updated"   "%Y-%m-%dT%H:%M:%SZ"
                    <> dateField "published" "%Y-%m-%dT%H:%M:%SZ"
                    <> bodyField "description"
                    <> defaultContext
            renderAtom feedConfig feedCtx posts

    -- ---------------------------------------------------------------------------
    -- Music feed — compositions only
    -- ---------------------------------------------------------------------------
    create ["music/feed.xml"] $ do
        route idRoute
        compile $ do
            compositions <- recentFirst
                        =<< loadAllSnapshots
                                ("content/music/*/index.md" .&&. hasNoVersion)
                                "content"
            let feedCtx =
                    dateField "updated"   "%Y-%m-%dT%H:%M:%SZ"
                    <> dateField "published" "%Y-%m-%dT%H:%M:%SZ"
                    <> bodyField "description"
                    <> defaultContext
            renderAtom musicFeedConfig feedCtx compositions

-- ---------------------------------------------------------------------------
-- Epistemic metadata extraction
-- ---------------------------------------------------------------------------

-- | Extract epistemic metadata from a content item's frontmatter.
--   Returns Nothing if the item has no route or no epistemic fields.
epistemicEntry :: Item String -> Compiler (Maybe (String, Map.Map String String))
epistemicEntry item = do
    let ident = itemIdentifier item
    mRoute <- getRoute ident
    case mRoute of
        Nothing -> return Nothing
        Just r  -> do
            meta <- getMetadata ident
            let url = "/" ++ r
                fields = catMaybes
                    [ grab "status"       meta
                    , grab "confidence"   meta
                    , grab "importance"   meta
                    , grab "evidence"     meta
                    , grab "scope"        meta
                    , grab "novelty"      meta
                    , grab "practicality" meta
                    , grab "stability"    meta
                    ]
                obj = Map.fromList fields
                -- Compute overall-score the same way Contexts.overallScoreField does.
                obj' = case ( readMaybe =<< lookupString "confidence" meta :: Maybe Int
                            , readMaybe =<< lookupString "evidence"   meta :: Maybe Int
                            ) of
                    (Just conf, Just ev) ->
                        let raw :: Double
                            raw   = fromIntegral conf     / 100.0 * 0.6
                                  + fromIntegral (ev - 1) / 4.0   * 0.4
                            score = max 0 (min 100 (round (raw * 100.0) :: Int))
                        in  Map.insert "score" (show score) obj
                    _ -> obj
            if Map.null obj'
                then return Nothing
                else return (Just (url, obj'))
  where
    grab name meta = case lookupString name meta of
        Just v  -> Just (name, v)
        Nothing -> Nothing