--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
import           Control.Monad (filterM)
import           Data.Maybe (fromMaybe)
import           Data.Monoid (mappend)
import           Data.Time
import           Data.Time.Format (parseTimeM, defaultTimeLocale, formatTime)
import           Hakyll


--------------------------------------------------------------------------------
main :: IO ()
main = hakyll $ do
    match "images/**" $ do
        route   idRoute
        compile copyFileCompiler

    match "lib/**" $ do
        route   idRoute
        compile copyFileCompiler

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

    match (fromList ["about.rst", "contact.markdown"]) $ do
        route   $ setExtension "html"
        compile $ pandocCompiler
            >>= loadAndApplyTemplate "templates/default.html" staticPageContext
            >>= relativizeUrls

    match "posts/*" $ do
        route $ setExtension "html"
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata

            pandocCompiler
                >>= loadAndApplyTemplate "templates/post.html"    (postCtx language)
                >>= loadAndApplyTemplate "templates/default.html" (postCtx language)
                >>= relativizeUrls

    match "events/*" $ do
        route $ setExtension "html"
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata

            pandocCompiler
                >>= loadAndApplyTemplate "templates/event.html"   (postCtx language)
                >>= loadAndApplyTemplate "templates/default.html" (postCtx language)
                >>= relativizeUrls

    match "pages/en/japan/language/**" $ do
        route $ setExtension "html"
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata

            pandocCompiler
                >>= loadAndApplyTemplate "templates/japan-language-note.html"   (postCtx language)
                >>= loadAndApplyTemplate "templates/default.html" (postCtx language)
                >>= relativizeUrls

    match "pages/*/plamo/equipment/**" $ do
        route $ setExtension "html"
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata

            pandocCompiler
                >>= loadAndApplyTemplate "templates/equipment.html" (postCtx language)
                >>= loadAndApplyTemplate "templates/default.html" (postCtx language)
                >>= relativizeUrls

    match "pages/*/plamo/model-kits/**" $ do
        route $ setExtension "html"
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata

            let dateValue = lookupString "date" metadata
                purchaseDateValue = lookupString "purchase_date" metadata
                formattedPurchaseDate = maybe "" formatDate purchaseDateValue
                modelKitTemplate = 
                    if dateValue == Just "1990-01-01"
                        then "templates/model-kit-not-ready.html"
                        else "templates/model-kit.html"

                extendedCtx = constField "formatted_purchase_date" formattedPurchaseDate <> (postCtx language)

            pandocCompiler
                >>= loadAndApplyTemplate modelKitTemplate extendedCtx
                >>= loadAndApplyTemplate "templates/default.html" extendedCtx
                >>= relativizeUrls

    match "pages/*/radio/fielddays/*" $ do
        route $ setExtension "html"
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata

            pandocCompiler
                >>= loadAndApplyTemplate "templates/radio.html" (postCtx language)
                >>= loadAndApplyTemplate "templates/default.html" (postCtx language)
                >>= relativizeUrls

    match "pages/*/software/**" $ do
        route $ setExtension "html"
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata

            pandocCompiler
                -- >>= loadAndApplyTemplate "templates/software-post.html"   (postCtx language)
                >>= loadAndApplyTemplate "templates/default.html" (postCtx language)
                >>= relativizeUrls

    create ["archive.html"] $ do
        route idRoute
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata
            let lang = fromMaybe "en" language

            posts <- recentFirst =<< loadAll "posts/*"
            let archiveCtx =
                    listField  "posts"    (postCtx language) (return posts) <>
                    constField "title"    "Archives" <>
                    constField "language" lang   <>
                    langDict lang <>
                    defaultContext

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

    match (fromList
        [ "nl/plamo.html"
        , "jp/plamo.html"
        , "en/plamo.html"
        ]) $ do
        route idRoute
        compile $ do
            -- ident <- getUnderlying
            -- language <- getMetadataField' ident "language"

            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata
            let lang = fromMaybe "en" language

            let urla = "pages/" ++ lang ++ "/plamo/model-kits/**"
            kits <- recentFirst =<< loadAll (fromGlob (urla))

            let plamoCtx =
                    listField  "kits" kitCtx (return kits) <>
                    langDict lang <>
                    defaultContext

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

    match (fromList
        [ "nl/japan.html"
        , "jp/japan.html"
        , "en/japan.html"
        ]) $ do
        route idRoute
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata
            let lang = fromMaybe "en" language

            notes <- loadAll "pages/en/japan/language/notes/*"

            let japanCtx =
                    listField "notes" (postCtx language) (return notes) <>
                    langDict lang <>
                    defaultContext

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

    match (fromList
        [ "nl/radio.html"
        , "jp/radio.html"
        , "en/radio.html"
        ]) $ do
        route idRoute
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata
            let lang = fromMaybe "en" language

            fielddays <- loadAll $ (fromGlob ("pages/" ++ lang ++ "/radio/fielddays/*"))
            fielddays <- recentFirst fielddays

            let radioCtx =
                    listField "fielddays" (postCtx language) (return fielddays) <>
                    langDict lang <>
                    defaultContext

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

    match (fromList
        [ "nl/software.html"
        , "jp/software.html"
        , "en/software.html"
        ]) $ do
        route idRoute
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata
            let lang = fromMaybe "en" language

            projects <- loadAll $ (fromGlob ("pages/" ++ lang ++ "/software/projects/*"))
            projects <- recentFirst projects

            let softwareCtx =
                    listField "projects" (postCtx language) (return projects) <>
                    langDict lang <>
                    defaultContext

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

    match (fromList
        [ "nl/code/blazor.html"
        , "jp/code/blazor.html"
        , "en/code/blazor.html"
        ]) $ do
        route idRoute
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata
            let lang = fromMaybe "en" language

            blazorPages  <- loadAll "pages/en/software/code/blazor/*"

            let softwareCtx =
                    listField "blazorPages"  (postCtx language) (return blazorPages) <>
                    langDict lang <>
                    defaultContext

            pandocCompiler
                >>= loadAndApplyTemplate "templates/code.html"    softwareCtx
                >>= loadAndApplyTemplate "templates/default.html" softwareCtx
                >>= relativizeUrls

    match (fromList
        [ "nl/code/elm.html"
        , "jp/code/elm.html"
        , "en/code/elm.html"
        ]) $ do
        route idRoute
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata
            let lang = fromMaybe "en" language

            elmPages     <- loadAll "pages/en/software/code/elm/*"

            let softwareCtx =
                    listField "elmPages"     (postCtx language) (return elmPages) <>
                    langDict lang <>
                    defaultContext

            pandocCompiler
                >>= loadAndApplyTemplate "templates/code.html"    softwareCtx
                >>= loadAndApplyTemplate "templates/default.html" softwareCtx
                >>= relativizeUrls

    match (fromList
        [ "nl/code/haskell.html"
        , "jp/code/haskell.html"
        , "en/code/haskell.html"
        ]) $ do
        route idRoute
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata
            let lang = fromMaybe "en" language

            haskellPages <- loadAll "pages/en/software/code/haskell/*"

            let softwareCtx =
                    listField "haskellPages" (postCtx language) (return haskellPages) <>
                    langDict lang <>
                    defaultContext

            pandocCompiler
                >>= loadAndApplyTemplate "templates/code.html"    softwareCtx
                >>= loadAndApplyTemplate "templates/default.html" softwareCtx
                >>= relativizeUrls

    match (fromList
        [ "nl/equipment.html"
        , "jp/equipment.html"
        , "en/equipment.html"
        ]) $ do
        route idRoute
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata
            let lang = fromMaybe "en" language

            equipment <- loadAll $ (fromGlob ("pages/" ++ lang ++ "/plamo/equipment/*"))

            let equipmentCtx =
                    listField "equipment" (postCtx language) (return equipment) <>
                    langDict lang <>
                    defaultContext

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

    match (fromList
        [ "nl/paints.html"
        , "jp/paints.html"
        , "en/paints.html"
        ]) $ do
        route idRoute
        compile $ do
            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata
            let lang = fromMaybe "en" language

            let paintsCtx =
                    langDict lang <>
                    defaultContext

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

    match (fromList
        [ "index.html"
        , "nl/index.html"
        , "jp/index.html"
        , "en/index.html"
        ]) $ do
        route idRoute
        compile $ do
            posts  <- recentFirst =<< loadAll "posts/*"
            now    <- unsafeCompiler getCurrentTime
            ident  <- getUnderlying
            --language <- getMetadataField' ident "language"

            identifier <- getUnderlying
            metadata   <- getMetadata identifier
            let language = lookupString "language" metadata
            let lang = fromMaybe "en" language

            -- Seven days from today.
            let cutoff = addUTCTime (7 * 24 * 60 * 60) now

            events <-
                loadAll "events/*"
                    >>= filterM (isUpcoming cutoff)
                    >>= chronological

            let indexCtx =
                    -- (<> is the modern version of `mappend`.)
                    listField "posts"  (postCtx language) (return posts)  <>
                    listField "events" (postCtx language) (return events) <>
                    langDict lang <>
                    defaultContext

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

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


--------------------------------------------------------------------------------
staticPageContext :: Context String
staticPageContext =
        langDict "en" <>
        defaultContext

formatDate :: String -> String
formatDate s =
    case parseTimeM True defaultTimeLocale "%Y-%m-%d" s :: Maybe Day of
        Just day -> formatTime defaultTimeLocale "%e %B %Y" day
        Nothing  -> s

postCtx :: Maybe String -> Context String
postCtx language =
    let lang = fromMaybe "en" language
    in
        dateField "date" "%e %B %Y" <>
        constField "language" lang  <>
        langDict lang <>
        defaultContext

kitCtx :: Context String
kitCtx =
    (field "formatted_purchase_date" $ \item -> do
        metadata <- getMetadata (itemIdentifier item)
        let purchaseDateValue = lookupString "purchase_date" metadata
        return $ maybe "" formatDate purchaseDateValue
    )
    <> postCtx Nothing

isUpcoming :: UTCTime -> Item a -> Compiler Bool
isUpcoming cutoff item = do
    metadata <- getMetadata (itemIdentifier item)
    case lookupString "date" metadata of
        Nothing   -> return False
        Just ds ->
            case parseTimeM True defaultTimeLocale "%Y-%m-%d" ds of
                Nothing   -> return False
                Just date -> return (date >= cutoff)

langDict :: String -> Context a
langDict "nl" =
    constField "switcher" "Taal" <>
    constField "title-japan" "Japan" <>
    constField "title-plamo" "Plamo" <>
    constField "title-radio" "Radio" <>
    constField "title-software" "Software" <>
    constField "text-plamo-not-ready" "Deze model-kit heeft nog geen gepubliceerd werk." <>
    constField "text-plamo-back" "Terug naar plamo kits" <>
    constField "text-radio-back" "Terug naar radio overzicht" <>
    mempty

langDict "jp" =
    constField "switcher" "言語" <>
    constField "title-japan" "日本" <>
    constField "title-plamo" "プラモ" <>
    constField "title-radio" "ラジオ" <>
    constField "title-software" "ソフトウェア" <>
    constField "text-plamo-not-ready" "この模型キットには、まだ制作例が公開されていません。" <>
    constField "text-plamo-back" "プラモデルキットに戻る" <>
    constField "text-radio-back" "ラジオに戻る" <>
    mempty

langDict "en" =
    constField "switcher" "Language" <>
    constField "title-japan" "Japan" <>
    constField "title-plamo" "Plamo" <>
    constField "title-radio" "Radio" <>
    constField "title-software" "Software" <>
    constField "text-plamo-not-ready" "This model kit has no work published for it yet." <>
    constField "text-plamo-back" "Back to plamo kits" <>
    constField "text-radio-back" "Back to radio overview" <>
    mempty

langDict _ = mempty
