{-# LANGUAGE OverloadedStrings #-}

import Hakyll

import Control.Monad ((>=>), when)
import Data.Foldable (traverse_)
import Data.List (inits, nub)
import Data.List.Extra (groupSort)
import Data.Maybe (fromMaybe)
import System.FilePath
  ( (</>)
  , dropTrailingPathSeparator
  , joinPath
  , normalise
  , splitDirectories
  )

import Debug.Trace

getMount' :: a -> (String -> a) -> Metadata -> a
getMount' a b = maybe a b . lookupString "mount"

getMount :: Metadata -> Routes
getMount = getMount' idRoute constRoute

indexInDir :: Routes -> Routes
indexInDir = flip composeRoutes . customRoute $ (</> "index.html") . toFilePath

makePage :: Rules ()
makePage = do
  route $ indexInDir (metadataRoute getMount)
  compile $
    pandocCompiler >>= loadAndApplyTemplate "templates/page.html" pageCtx >>=
    loadAndApplyTemplate "templates/default.html" pageCtx >>=
    relativizeUrls

extractRedirs :: Identifier -> Rules (Identifier, [Identifier])
extractRedirs ident = do
  md <- getMetadata ident
  let to = getMount' ident fromFilePath md
      froms =
        fromMaybe [] $
        map (fromFilePath . dropTrailingPathSeparator . normalise) <$>
        lookupStringList "redirects" md
  pure (to, froms)

makeRedirects :: Identifier -> [Identifier] -> Rules ()
makeRedirects to froms =
  create froms $ do
    route $ indexInDir idRoute
    compile . makeItem . Redirect . ('/' :) . toFilePath $ to

spawnRedirects :: [Identifier] -> Rules ()
spawnRedirects = traverse_ (extractRedirs >=> uncurry makeRedirects)

extractHTagLinks :: Identifier -> Rules (Identifier, [[String]])
extractHTagLinks ident = do
  md <- getMetadata ident
  let to = getMount' ident fromFilePath md
      htags = maybe [] (map splitDirectories) $ lookupStringList "tags" md
  when (null htags) . fail $ "Uncategorized: " ++ show ident
  pure (to, htags)

invTags :: [(Identifier, [[String]])] -> [([String], [String])]
invTags x =
  map (fmap (map ('/' :) . nub . map toFilePath)) $
  groupSort [(t, p) | (p, htl) <- x, ht <- htl, t <- inits ht]

makeTag :: [FilePath] -> [String] -> Rules ()
makeTag htag pages =
  create [fromFilePath $ joinPath ("tags" : htag)] $ do
    route (indexInDir idRoute)
    compile $ do
      let ctx =
            mconcat
              [ constField "title" ("Pages tagged " ++ joinPath htag)
              , listField
                  "htags"
                  (field "htag" (return . itemBody))
                  (traverse makeItem htag)
              , listField
                  "pages"
                  (field "page" (return . itemBody))
                  (traverse makeItem pages)
              , defaultContext
              ]
      makeItem "" >>= loadAndApplyTemplate "templates/tag.html" ctx >>=
        loadAndApplyTemplate "templates/default.html" ctx >>=
        relativizeUrls

spawnTags =
  traverse extractHTagLinks >=> pure . invTags >=> traverse_ (uncurry makeTag)

main :: IO ()
main =
  hakyll $
    {- Source the pages -}
   do
    match "external/**/*.md" makePage
    {- Source and process the redirects -}
    getMatches "external/**/*.md" >>= spawnRedirects
    {- Source and process the tags -}
    getMatches "external/**/*.md" >>= spawnTags
    {- Compile the templates (no routing, cache-only) -}
    match "templates/*" $ compile templateBodyCompiler

pageCtx :: Context String
pageCtx = defaultContext