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

module Hakyll.Contrib.I18n
    ( Hakyll.Contrib.I18n.categoryField
    , Hakyll.Contrib.I18n.categoryField'
    , Hakyll.Contrib.I18n.dateField
    , Hakyll.Contrib.I18n.tagsField
    , Hakyll.Contrib.I18n.tagsField'
    , Language
    , feedConfiguration
    , languageField
    , translate
    , translationCompiler
    , translationContext
    , translationField
    ) where

import Hakyll

import Control.Applicative
import Control.Monad (forM)
import Data.Binary.Instances.UnorderedContainers
import Data.ByteString (ByteString, writeFile)
import Data.ByteString.Lazy (toStrict)
import Data.List (intersperse)
import Data.Maybe (catMaybes)
import Data.Time.Format (formatTime)
import Data.Time.Locale.Compat (defaultTimeLocale)
import Data.Yaml ((.:), ParseException, Object, encode, parseEither, decodeEither', prettyPrintParseException)
import System.FilePath ((</>), joinPath, splitDirectories, splitFileName, takeDirectory)

import qualified Data.HashMap.Strict as SM (HashMap, lookupDefault, union)
import qualified Data.Text as T (pack)

type Language = String
type Translation = SM.HashMap String String

instance Writable Translation where
    write p = Data.ByteString.writeFile p . encode . itemBody

-- | Parse a `ByteString` into a `Translation` HashMap.
-- | Fails if there is no `translation` key.
parse :: ByteString -> Translation
parse = either error id . parse' . decodeEither'
    where
        parse' :: Either ParseException Object -> Either String Translation
        parse' = either (Left . prettyPrintParseException) (parseEither (.: T.pack "translation"))

-- | Compiles a `Translation` from a `yaml` file.
translationCompiler :: Compiler (Item Translation)
translationCompiler = cached "TranslationCompiler" $
    fmap (parse . toStrict) <$> getResourceLBS

languageFromFilePath :: FilePath -> Language
languageFromFilePath = head . splitDirectories

languageFromIdentifier :: Identifier -> Language
languageFromIdentifier = languageFromFilePath . toFilePath

languageFromItem :: Item a -> Language
languageFromItem = languageFromIdentifier . itemIdentifier

-- | Search for a word's translation in a `Translation`.
-- | If there is none, return the word unchanged.
translate :: Translation -> String -> String
translate translation word = SM.lookupDefault word word translation

-- | Hakyll's `dateField` but uses a format base on the `item`'s language.
dateField :: String -> Context a
dateField key = field key dateField'
    where
        dateField' :: Item a -> Compiler String
        dateField' item = do
            languageTranslation <- loadBody $ fromFilePath $ languageFromItem item </> "translation.yml"
            defaultTranslation  <- loadBody "templates/translation.yml"

            let translation = SM.union languageTranslation defaultTranslation
                dateFormat = translate translation "DATE_FORMAT"

            time <- getItemUTC defaultTimeLocale $ itemIdentifier item
            return $ formatTime defaultTimeLocale dateFormat time

-- | `Field` containing the `Item`'s language.
languageField :: String -> Context a
languageField key = field key (return . languageFromItem)

toUrl :: FilePath -> String
toUrl = Hakyll.toUrl . transform
    where
        transform :: FilePath -> FilePath
        transform url = case splitFileName url of
            (p, "index.html") -> takeDirectory p
            _                 -> url

renderLink :: (FilePath -> String) -> Translation -> String -> (Maybe FilePath) -> Maybe String
renderLink _ _ _ Nothing                             = Nothing
renderLink sanitizer translation tag (Just filePath) = Just $ "<a href=\"" ++ (sanitizer filePath) ++ "\">" ++ translate translation tag ++ "</a>"

tagsFieldWith
    :: (Identifier -> Compiler [String])
    -> (Translation -> String -> (Maybe FilePath) -> Maybe String)
    -> ([String] -> String)
    -> String
    -> Tags
    -> Context a
tagsFieldWith getter renderer join key tags = field key tagsFieldWith'
    where
        tagsFieldWith' :: Item a -> Compiler String
        tagsFieldWith' item = do
            languageTranslation <- loadBody $ fromFilePath $ languageFromItem item </> "translation.yml"
            defaultTranslation  <- loadBody "templates/translation.yml"
            let translation = SM.union languageTranslation defaultTranslation

            tags' <- getter $ itemIdentifier item
            links <- forM tags' $ \tag -> do
                route' <- getRoute $ tagsMakeId tags tag
                return $ renderer translation tag route'

            return $ join $ catMaybes links

-- | Hakyll's `tagsField` but with translation applied to the tag name.
tagsField :: String -> Tags -> Context a
tagsField = Hakyll.Contrib.I18n.tagsFieldWith getTags (renderLink Hakyll.toUrl) (mconcat . intersperse ", ")

-- | Hakyll's `categoryField` but with translation applied to the tag name.
categoryField :: String -> Tags -> Context a
categoryField = Hakyll.Contrib.I18n.tagsFieldWith getCategory (renderLink Hakyll.toUrl) (mconcat . intersperse ", ")

-- | Hakyll's `tagsField` but with translation applied to the tag name.
-- | It also remove any trailing `/index.html` in the route.
tagsField' :: String -> Tags -> Context a
tagsField' = Hakyll.Contrib.I18n.tagsFieldWith getTags (renderLink Hakyll.Contrib.I18n.toUrl) (mconcat . intersperse ", ")

-- | Hakyll's `categoryField` but with translation applied to the tag name.
-- | It also remove any trailing `/index.html` in the route.
categoryField' :: String -> Tags -> Context a
categoryField' = Hakyll.Contrib.I18n.tagsFieldWith getCategory (renderLink Hakyll.Contrib.I18n.toUrl) (mconcat . intersperse ", ")

-- | A function one can use to translate `String`s and `Field`s in the `Template`s base on the `Item`'s language.
translationField :: String -> Context a
translationField key = functionField key translationField'
    where
        translationField' :: [String] -> Item a -> Compiler String
        translationField' words item = do
            languageTranslation <- loadBody $ fromFilePath $ languageFromItem item </> "translation.yml"
            defaultTranslation  <- loadBody "templates/translation.yml"

            let translation = SM.union languageTranslation defaultTranslation
                translations = map (translate translation) words

            return $ (mconcat . intersperse " ") translations

-- | Helper `Context` exposing all the modules `Field`s in the same place.
translationContext :: Context a
translationContext
    = Hakyll.Contrib.I18n.dateField "date"
    <> languageField "language"
    <> translationField "translate"

-- | `FeedConfiguration` but with translated fields.
feedConfiguration :: Translation -> FeedConfiguration
feedConfiguration translation =
    FeedConfiguration
        { feedTitle       = translate translation "FEED_TITLE"
        , feedDescription = translate translation "FEED_DESCRIPTION"
        , feedAuthorName  = translate translation "FEED_AUTHOR_NAME"
        , feedAuthorEmail = translate translation "FEED_AUTHOR_EMAIL"
        , feedRoot        = translate translation "FEED_ROOT"
        }