{-# 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"
}