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

import Hakyll

import Hakyll.Contrib.I18n
    ( Language
    , categoryField'
    , feedConfiguration
    , tagsField'
    , translate
    , translationCompiler
    , translationContext
    )

import Control.Monad (mplus)
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import System.FilePath ((</>), splitExtension, splitFileName, takeDirectory)
import Text.Pandoc (Format (..), Pandoc)
import Text.Pandoc.Filter.IncludeCode (includeCode)
import Text.Pandoc.Walk (walkM)

import qualified Data.HashMap.Strict as SM (union)
import qualified GHC.IO.Encoding as E

includeCodePandocCompiler :: Compiler (Item String)
includeCodePandocCompiler =
  pandocCompilerWithTransformM
    defaultHakyllReaderOptions
    defaultHakyllWriterOptions
    (unsafeCompiler . (walkM (includeCode (Just (Format "html5")))))

main :: IO ()
main = do
    E.setLocaleEncoding E.utf8
    hakyll $ do
        match "assets/**/*" $ do
            route idRoute
            compile copyFileCompiler

        match "css/*" $ do
            route idRoute
            compile compressCssCompiler

        match "*/translation.yml" $
            compile translationCompiler

        match ("snippets/*" .||. "*/snippets/*") $
            compile getResourceBody

        match ("templates/*" .&&. complement "templates/translation.yml") $
            compile templateBodyCompiler

        create ["index.html"] $ do
            route idRoute
            compile $ do
                defaultTranslation <- loadBody "templates/translation.yml"
                makeItem $ Redirect $ translate defaultTranslation "DEFAULT_LANGUAGE"

        create ["sitemap.xml"] $ do
            route idRoute
            compile $ do
                archives               <- loadAll $ hasVersion "archive"
                archivesAllLanguages   <- loadAll $ hasVersion "archiveAllLanguages"
                categories             <- loadAll $ ("*/categories/*" .&&. hasNoVersion)
                categoriesAllLanguages <- loadAll $ ("*/categories/*" .&&. hasVersion "categoryAllLanguages")
                index                  <- loadAll $ hasVersion "index"
                pages                  <- loadAll $ hasVersion "page"
                posts                  <- loadAll "*/posts/*/*"
                tags                   <- loadAll $ ("*/tags/*" .&&. hasNoVersion)
                tagsAllLanguages       <- loadAll $ ("*/tags/*" .&&. hasVersion "tagAllLanguages")

                let context =
                        listField "archives"               generalContext (return archives)               <>
                        listField "archivesAllLanguages"   generalContext (return archivesAllLanguages)   <>
                        listField "categories"             generalContext (return categories)             <>
                        listField "categoriesAllLanguages" generalContext (return categoriesAllLanguages) <>
                        listField "index"                  generalContext (return index)                  <>
                        listField "pages"                  generalContext (return pages)                  <>
                        listField "posts"                  generalContext (return posts)                  <>
                        listField "tags"                   generalContext (return tags)                   <>
                        listField "tagsAllLanguages"       generalContext (return tagsAllLanguages)

                makeItem ""
                    >>= loadAndApplyTemplate "templates/sitemap.xml" context
                    >>= relativizeUrls

        sequence_ $ [archives, categories, feeds, index, pages, posts, tags] <*> ["en", "fr"]

archives :: Language -> Rules ()
archives language = sequence_ $ [archives', archives''] <*> pure language where
    archives' :: Language -> Rules ()
    archives' language = do
        categories <- buildCategories (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "categories/*.html")
        tags       <- buildTags       (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "tags/*.html")

        create [fromFilePath $ language </> "archive.html"] $ version "archive" $ do
            route indexRoute
            compile $ do
                posts <- recentFirst =<< (loadAll $ fromGlob $ language </> "posts/*/*")

                let context =
                        boolField "single" (const True)                                <>
                        constField "switch" ("/archive" </> language)                  <>
                        listField "posts" (postContext tags categories) (return posts) <>
                        generalContext

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

    archives'' :: Language -> Rules ()
    archives'' language = do
        categories <- buildCategories "*/posts/*/*" (fromCapture $ fromGlob $ language </> "categories/*.html")
        tags       <- buildTags       "*/posts/*/*" (fromCapture $ fromGlob $ language </> "tags/*.html")

        create [fromFilePath $ language </> "archive.html"] $ version "archiveAllLanguages" $ do
            route $ gsubRoute (language </> "archive") (const $ "archive" </> language) `composeRoutes` indexRoute
            compile $ do
                posts <- recentFirst =<< loadAll ("*/posts/*/*")

                let context =
                        boolField "single" (const False)                               <>
                        constField "switch" ("/" ++ language </> "archive")            <>
                        listField "posts" (postContext tags categories) (return posts) <>
                        generalContext

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

categories :: Language -> Rules ()
categories language = sequence_ $ [categories', categories''] <*> pure language where
    categories' :: Language -> Rules ()
    categories' language = do
        categories <- buildCategories (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "categories/*.html")
        tags       <- buildTags       (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "tags/*.html")

        tagsRules categories $ \category pattern -> do
            route indexRoute
            compile $ do
                posts <- recentFirst =<< loadAll pattern

                let context =
                        boolField "single" (const True)                                <>
                        constField "switch" ("/categories" </> language </> category)  <>
                        listField "posts" (postContext tags categories) (return posts) <>
                        generalContext

                makeItem ""
                    >>= loadAndApplyTemplate "templates/category.html" context
                    >>= loadAndApplyTemplate "templates/default.html"  context
                    >>= relativizeUrls

    categories'' :: Language -> Rules ()
    categories'' language = do
        categories <- buildCategories "*/posts/*/*" (fromCapture $ fromGlob $ language </> "categories/*.html")
        tags       <- buildTags "*/posts/*/*"       (fromCapture $ fromGlob $ language </> "tags/*.html")

        version "categoryAllLanguages" $ tagsRules categories $ \category pattern -> do
            route $ gsubRoute (language </> "categories") (const $ "categories" </> language) `composeRoutes` indexRoute
            compile $ do
                posts <- recentFirst =<< loadAll pattern

                let context =
                        boolField "single" (const False)                                    <>
                        constField "switch" ("/" ++ language </> "categories" </> category) <>
                        listField "posts" (postContext tags categories) (return posts)      <>
                        generalContext

                makeItem ""
                    >>= loadAndApplyTemplate "templates/category.html" context
                    >>= loadAndApplyTemplate "templates/default.html"  context
                    >>= relativizeUrls

feeds :: Language -> Rules ()
feeds language = sequence_ $ [atom, rss] <*> pure language where
    atom :: Language -> Rules ()
    atom language = create [fromFilePath $ language </> "atom.xml"] $ do
        route idRoute
        compile $ do
            posts <- fmap (take 10) . recentFirst =<< (loadAll $ fromGlob $ language </> "posts/*/*")

            languageTranslation <- loadBody $ fromFilePath $ language </> "translation.yml"
            defaultTranslation  <- loadBody "templates/translation.yml"

            let translation = SM.union languageTranslation defaultTranslation
                context = listField "posts" generalContext (return posts) <> generalContext

            renderAtom (feedConfiguration translation) generalContext posts

    rss :: Language -> Rules ()
    rss language = create [fromFilePath $ language </> "rss.xml"] $ do
        route idRoute
        compile $ do
            posts <- fmap (take 10) . recentFirst =<< (loadAll $ fromGlob $ language </> "posts/*/*")

            languageTranslation <- loadBody $ fromFilePath $ language </> "translation.yml"
            defaultTranslation  <- loadBody "templates/translation.yml"

            let translation = SM.union languageTranslation defaultTranslation
                context = listField "posts" generalContext (return posts) <> generalContext

            renderRss (feedConfiguration translation) generalContext posts

index :: Language -> Rules ()
index language = do
    categories <- buildCategories (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "categories/*.html")
    tags       <- buildTags       (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "tags/*.html")

    match (fromGlob $ language </> "index.*") $ version "index" $ do
        route $ setExtension "html"
        compile $ do
            posts <- fmap (take 10) . recentFirst =<< (loadAll $ fromGlob $ language </> "posts/*/*")
            let context = listField "posts" (postContext tags categories) (return posts) <> generalContext
            pandocCompiler
                >>= applyAsTemplate                               context
                >>= loadAndApplyTemplate "templates/main.html"    context
                >>= loadAndApplyTemplate "templates/default.html" context
                >>= relativizeUrls

pages :: Language -> Rules ()
pages language = match ((fromGlob $ language </> "*.*") .&&. (complement . fromGlob $ language </> "index.*") .&&. (complement . fromGlob $ language </> "translation.yml")) $ version "page" $ do
    route $ indexRoute
    compile $
        pandocCompiler
            >>= applyAsTemplate                               generalContext
            >>= loadAndApplyTemplate "templates/main.html"    generalContext
            >>= loadAndApplyTemplate "templates/default.html" generalContext
            >>= relativizeUrls

posts :: Language -> Rules ()
posts language = do
    categories <- buildCategories (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "categories/*.html")
    tags       <- buildTags       (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "tags/*.html")

    match (fromGlob $ language </> "posts/*/*") $ do
        route indexRoute
        compile $ do
            let context = postContext tags categories

            pandocCompiler
                >>= saveSnapshot "teaser"
                >>= loadAndApplyTemplate "templates/post.html"    context
                >>= loadAndApplyTemplate "templates/main.html"    context
                >>= loadAndApplyTemplate "templates/default.html" context
                >>= relativizeUrls

tags :: Language -> Rules ()
tags language = sequence_ $ [tags', tags''] <*> pure language where
    tags' :: Language -> Rules ()
    tags' language = do
        categories <- buildCategories (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "categories/*.html")
        tags       <- buildTags       (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "tags/*.html")

        tagsRules tags $ \tag pattern -> do
            route indexRoute
            compile $ do
                posts <- recentFirst =<< loadAll pattern

                let context =
                        boolField "single" (const True)                                <>
                        constField "switch" ("/tags" </> language </> tag)             <>
                        listField "posts" (postContext tags categories) (return posts) <>
                        generalContext

                makeItem ""
                    >>= loadAndApplyTemplate "templates/tag.html"     context
                    >>= loadAndApplyTemplate "templates/default.html" context
                    >>= relativizeUrls

    tags'' :: Language -> Rules ()
    tags'' language = do
        categories <- buildCategories (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "categories/*.html")
        tags       <- buildTags       (fromGlob $ language </> "posts/*/*") (fromCapture $ fromGlob $ language </> "tags/*.html")

        version "tagAllLanguages" $ tagsRules tags $ \tag pattern -> do
            route $ gsubRoute (language </> "tags") (const $ "tags" </> language) `composeRoutes` indexRoute
            compile $ do
                posts <- recentFirst =<< loadAll pattern

                let context =
                        boolField "single" (const False)                               <>
                        constField "switch" ("/" ++ language </> "tags" </> tag)       <>
                        listField "posts" (postContext tags categories) (return posts) <>
                        generalContext

                makeItem ""
                    >>= loadAndApplyTemplate "templates/tag.html"     context
                    >>= loadAndApplyTemplate "templates/default.html" context
                    >>= relativizeUrls

indexRoute :: Routes
indexRoute = customRoute $ (\(p, _) -> p </> "index.html") . splitExtension . toFilePath

dropIndexHtml :: Context a
dropIndexHtml = mapContext transform (urlField "url")
    where
        transform :: FilePath -> FilePath
        transform url = case splitFileName url of
            (p, "index.html") -> takeDirectory p
            _                 -> url

customListField :: String -> String -> Context a
customListField key custom = listFieldWith key (field custom $ return . itemBody) customListField'
    where
        customListField' :: Item b -> Compiler [Item String]
        customListField' item = do
            metadata <- getMetadata $ itemIdentifier item
            let customs = fromMaybe [] $
                    lookupStringList key metadata `mplus`
                    (map trim . splitAll "," <$> lookupString key metadata)
            mapM makeItem customs

generalContext :: Context String
generalContext =
    dropIndexHtml                      <>
    translationContext                 <>
    customListField "scripts" "script" <>
    defaultContext

postContext :: Tags -> Tags -> Context String
postContext tags categories =
    Hakyll.Contrib.I18n.categoryField' "category" categories <>
    Hakyll.Contrib.I18n.tagsField' "tags" tags               <>
    teaserField "teaser" "teaser"                            <>
    generalContext