--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}

import           Control.Exception
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Hakyll
import           Hakyll.Web.Sass
import           System.Environment
import           System.FilePath.Posix
import           System.Process

--------------------------------------------------------------------------------
main :: IO ()
main = hakyll $ do
  match "templates/*" $ compile templateBodyCompiler

  match ("assets/images/*" .||. "assets/fonts/*") $ do
    route idRoute
    compile copyFileCompiler

  match "assets/css/*" $ do
    route $ setExtension "css"
    let compressCssItem = fmap compressCss
    compile (compressCssItem <$> sassCompiler)

  match "posts/*" $ do
    route prettyRoute
    compile $
      pandocCompiler
        >>= loadAndApplyTemplate "templates/post.html" postCtx
        >>= saveSnapshot "content"
        >>= loadAndApplyTemplate "templates/default.html" postCtx
        >>= relativizeUrls
        >>= removeIndexHtml

  match "pages/*.html" $ do
    route prettyRoute
    compile $
      pandocCompiler
        >>= loadAndApplyTemplate "templates/default.html" defaultCtx
        >>= relativizeUrls
        >>= removeIndexHtml

  match "404.html" $ do
    route idRoute
    compile $
      pandocCompiler
        >>= loadAndApplyTemplate "templates/default.html" defaultCtx
        -- >>= relativizeUrls
        >>= removeIndexHtml

  create ["archive.html"] $ do
    route prettyRoute
    compile $ do
      posts <- recentFirst =<< loadAll "posts/*"
      let archiveCtx =
            listField "posts" postCtx (return posts)
              <> constField "title" "Archives"
              <> defaultCtx

      makeItem ""
        >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
        >>= loadAndApplyTemplate "templates/default.html" archiveCtx
        >>= relativizeUrls
        >>= removeIndexHtml

  match "index.html" $ do
    route idRoute
    compile $ do
      posts <- recentFirst =<< loadAll "posts/*"
      let indexCtx =
            listField "posts" postCtx (return posts)
              <> defaultCtx

      getResourceBody
        >>= applyAsTemplate indexCtx
        >>= loadAndApplyTemplate "templates/default.html" indexCtx
        >>= relativizeUrls
        >>= removeIndexHtml

  create ["atom.xml"] $ do
    route idRoute
    compile $ do
      let feedCtx = postCtx <> bodyField "description"
      posts <-
        fmap (take 10) . recentFirst
          =<< loadAllSnapshots "posts/*" "content"
      renderAtom feedConfiguration feedCtx posts

  create ["rss.xml"] $ do
    route idRoute
    compile $ do
      let feedCtx = postCtx <> bodyField "description"
      posts <-
        fmap (take 10) . recentFirst
          =<< loadAllSnapshots "posts/*" "content"
      renderRss feedConfiguration feedCtx posts

--------------------------------------------------------------------------------
feedConfiguration :: FeedConfiguration
feedConfiguration =
  FeedConfiguration
    { feedTitle = "Posts on Skiletro.com",
      feedDescription = "Recent posts from Skiletro.com",
      feedAuthorName = "Skiletro",
      feedAuthorEmail = "19377854+skiletro@users.noreply.github.com", -- you're not getting my email that easily
      feedRoot = "https://skiletro.com"
    }

--------------------------------------------------------------------------------

prettyRoute :: Routes
prettyRoute = customRoute createIndexRoute
  where
    createIndexRoute ident =
      takeDirectory p </> takeBaseName p </> "index.html"
      where
        p = toFilePath ident

removeIndexHtml :: Item String -> Compiler (Item String)
removeIndexHtml item = return $ fmap (withUrls removeIndexStr) item
  where
    removeIndexStr :: String -> String
    removeIndexStr url = case splitFileName url of
      (dir, "index.html") | isLocal dir -> dir
      _                                 -> url
      where
        isLocal uri = not ("://" `isInfixOf` uri)

--------------------------------------------------------------------------------

defaultCtx :: Context String
defaultCtx = gitRevisionCtx <> defaultContext

postCtx :: Context String
postCtx = hDateCtx <> cDateCtx <> defaultCtx

hDateCtx :: Context String
hDateCtx = dateField "hdate" "%B %e, %Y"

cDateCtx :: Context String
cDateCtx = dateField "cdate" "%Y-%m-%d"

gitRevisionCtx :: Context String
gitRevisionCtx = field "revision" $ \_ -> do
  mRevision <- unsafeCompiler $ lookupEnv "GIT_REVISION"
  return $ fromMaybe "dev" mRevision

--------------------------------------------------------------------------------