{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Monad (Monad(..), filterM, void)
import Data.Bool
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Function (($), (.), const)
import Data.Functor ((<$>))
import Data.Functor.Identity (runIdentity)
import Data.Maybe (Maybe(..))
import Data.Monoid (mconcat)
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Hakyll.Web.Sass (sassCompiler)
import Prelude (error, (-))
import System.IO (IO)
import qualified Data.List as List
import qualified Data.Text as T
import qualified Hakyll as H
import qualified System.Environment as Env
import qualified Text.Pandoc.Options as Pandoc
import qualified Text.Pandoc.Templates as Pandoc

main :: IO ()
main = do
  args <- Env.getArgs
  Env.withArgs args $ H.hakyllWith H.defaultConfiguration $ do
    let postsPattern = "content/posts/*.md"
    tags <- H.buildTags postsPattern $
      H.fromCapture "tags/*/index.html"
    let siteCtx = mconcat
          [ H.defaultContext
          ]
    let tagsCtx = mconcat
          [ H.tagsField "tags-links" tags
          , H.field "tags-counts" (\_ -> H.renderTagList tags)
          ]
    let postCtx = mconcat
          [ H.dateField "date" "%e %B %Y"
          , H.dateField "datetime" "%Y-%m-%d"
          -- , tagLinks H.getTags "tags" tags
          , tagsCtx
          , siteCtx
          ]
    let postList sortFilter = do
          itemTmpl <- H.loadBody "templates/post-link.html"
          H.loadAll postsPattern
            >>= sortFilter
            >>= H.applyTemplateList itemTmpl postCtx

    H.match "content/index.html" $ do
      let ctx = mconcat
            [ H.constField "title" "Index"
            -- , H.field "tags-cloud" $ \_ -> tagCloud 60 150 tags
            , tagsCtx
            , siteCtx
            ]
      H.route $ stripRoute "content/"
      H.compile $ do
        body <- H.itemBody <$> H.templateBodyCompiler
        H.loadAllSnapshots postsPattern "teaser"
          >>= ((List.take 10 <$>) . H.recentFirst)
          >>= H.applyTemplateList body (postCtx <> H.bodyField "posts")
          >>= H.makeItem
          >>= H.loadAndApplyTemplate "templates/index.html" (ctx <> H.bodyField "posts")
          >>= H.loadAndApplyTemplate "templates/default.html" (ctx <> H.bodyField "posts")
          >>= H.relativizeUrls
          >>= chopIndexUrls

    H.create ["posts/index.html"] $ do
      H.route H.idRoute
      H.compile $ do
        let ctx = mconcat
              [ H.constField "title" "Blog"
              , H.constField "description" "Web log entries"
              , H.field "posts" (\_ -> postList H.recentFirst)
              , siteCtx
              ]
        H.makeItem ""
          >>= H.loadAndApplyTemplate "templates/posts-list.html" ctx
          >>= H.loadAndApplyTemplate "templates/default.html" ctx
          >>= H.relativizeUrls
          >>= chopIndexUrls

    H.match postsPattern $ do
      H.route $
        --directorizeDate `H.composeRoutes`
        stripRoute "content/" `H.composeRoutes`
        H.setExtension "html"
      H.compile $ do
        ident <- H.getUnderlying
        toc <- H.getMetadataField ident "tableOfContents"
        source <- H.getResourceFilePath
        updated <- H.unixFilter "git" ["log", "-1", "--format=%ad", "--",  source] ""
        let ctx = mconcat
              [ H.constField "source" source
              , H.constField "updated" updated
              , postCtx
              ]
        compiledContent <- H.pandocCompilerWith H.defaultHakyllReaderOptions $ case toc of
          Just "true" ->
            H.defaultHakyllWriterOptions
              { Pandoc.writerNumberSections = True
              , Pandoc.writerTableOfContents = True
              , Pandoc.writerTOCDepth = 3
              , Pandoc.writerTemplate = Just tocTemplate
              }
            where
            tocTemplate =
              case runIdentity $ Pandoc.compileTemplate "" tmpl of
                Left err -> error err
                Right template -> template
                where
                tmpl = T.unlines
                  [ ""
                  , "<div class=\"toc\"><div class=\"header\">Table des matières</div>"
                  , "$toc$"
                  , "</div>"
                  , "$body$"
                  ]
          _ -> H.defaultHakyllWriterOptions
        compiledTeaser <- H.pandocCompilerWith
          H.defaultHakyllReaderOptions
          H.defaultHakyllWriterOptions
        teaser <- H.loadAndApplyTemplate "templates/post-teaser.html" ctx $
          List.unlines . List.takeWhile (/= "<!--more-->") . List.lines
          <$> compiledTeaser
        void $ H.saveSnapshot "teaser" teaser
        H.loadAndApplyTemplate "templates/post.html" ctx compiledContent
          >>= H.saveSnapshot "content"
          >>= H.loadAndApplyTemplate "templates/default.html" ctx
          >>= H.relativizeUrls
          >>= chopIndexUrls

    H.tagsRules tags $ \tag _ -> do
      H.route H.idRoute
      H.compile $ do
        posts <- postList $ \ps ->
          H.recentFirst ps
          >>= filterM ((List.elem tag <$>) . H.getTags . H.itemIdentifier)
        let ctx = mconcat
              [ H.constField "tag" tag
              , H.constField "title" ("Posts for tag: " <> tag)
              , H.constField "posts" posts
              , H.constField "description" ("Posts for tag: " <> tag)
              , siteCtx
              ]
        H.makeItem ""
          >>= H.loadAndApplyTemplate "templates/posts-list.html" ctx
          >>= H.loadAndApplyTemplate "templates/default.html" ctx
          >>= H.relativizeUrls
          >>= chopIndexUrls

    let feedConfiguration = H.FeedConfiguration
          { H.feedTitle       = "Sourcephile - feed"
          , H.feedDescription = "Logiciellerie"
          , H.feedAuthorName  = "Sourcephile"
          , H.feedAuthorEmail = "contact@sourcephile.fr"
          , H.feedRoot        = "https://sourcephile.fr"
          }
    let feedCtx = postCtx <> H.bodyField "description"
    H.create ["rss.xml"] $ do
      H.route H.idRoute
      H.compile $ do
        posts <- H.loadAllSnapshots postsPattern "content"
        sorted <- H.recentFirst posts
        H.renderRss feedConfiguration feedCtx sorted
    H.create ["atom.xml"] $ do
      H.route H.idRoute
      H.compile $ do
        posts <- H.loadAllSnapshots postsPattern "content"
        sorted <- H.recentFirst posts
        H.renderAtom feedConfiguration feedCtx sorted

    {-
    H.create ["sitemap.xml"] $ do
      H.route iH.dRoute
      H.compile $ sitemapCompiler def
        { sitemapBase     = scSiteRoot siteConfig'
        , sitemapRewriter = ('/' :) . stripIndex
        }
    -}

    scssDependency <- H.makePatternDependency "assets/css/**.scss"
    H.rulesExtraDependencies [scssDependency] .
      H.match "assets/css/default.scss" $ do
        H.route $ H.setExtension "css"
        H.compile ((H.compressCss <$>) <$> sassCompiler)

    H.match "assets/images/**" $ do
      H.route H.idRoute
      H.compile H.copyFileCompiler

    {-
    H.match "assets/js/*.js" $ do
      H.route H.idRoute
      H.compile H.compressJsCompiler
    -}

    H.match "static/*" $ do
      H.route $ stripRoute "static/"
      H.compile H.copyFileCompiler

    H.match "templates/*" $
      H.compile H.templateBodyCompiler

    H.match "content/robots.txt" $ do
      H.route $ stripRoute "content/"
      H.compile H.copyFileCompiler

chopIndexUrls :: H.Item String -> H.Compiler (H.Item String)
chopIndexUrls item = return $ H.withUrls stripIndex <$> item

-- | Strips "index.html" from given URL string.
stripIndex :: String -> String
stripIndex url
  | "index.html" `List.isSuffixOf` url =
    List.take (List.length url - 10) url
  | otherwise = url

stripRoute :: String -> H.Routes
stripRoute r = H.gsubRoute r $ const ""