{-# 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 :: FilePath -> Item Translation -> IO ()
write p :: FilePath
p = FilePath -> ByteString -> IO ()
Data.ByteString.writeFile FilePath
p (ByteString -> IO ())
-> (Item Translation -> ByteString) -> Item Translation -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Translation -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Translation -> ByteString)
-> (Item Translation -> Translation)
-> Item Translation
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item Translation -> Translation
forall a. Item a -> a
itemBody

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

-- | Compiles a `Translation` from a `yaml` file.
translationCompiler :: Compiler (Item Translation)
translationCompiler :: Compiler (Item Translation)
translationCompiler = FilePath
-> Compiler (Item Translation) -> Compiler (Item Translation)
forall a.
(Binary a, Typeable a) =>
FilePath -> Compiler a -> Compiler a
cached "TranslationCompiler" (Compiler (Item Translation) -> Compiler (Item Translation))
-> Compiler (Item Translation) -> Compiler (Item Translation)
forall a b. (a -> b) -> a -> b
$
    (ByteString -> Translation) -> Item ByteString -> Item Translation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Translation
parse (ByteString -> Translation)
-> (ByteString -> ByteString) -> ByteString -> Translation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict) (Item ByteString -> Item Translation)
-> Compiler (Item ByteString) -> Compiler (Item Translation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler (Item ByteString)
getResourceLBS

languageFromFilePath :: FilePath -> Language
languageFromFilePath :: FilePath -> FilePath
languageFromFilePath = [FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories

languageFromIdentifier :: Identifier -> Language
languageFromIdentifier :: Identifier -> FilePath
languageFromIdentifier = FilePath -> FilePath
languageFromFilePath (FilePath -> FilePath)
-> (Identifier -> FilePath) -> Identifier -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> FilePath
toFilePath

languageFromItem :: Item a -> Language
languageFromItem :: Item a -> FilePath
languageFromItem = Identifier -> FilePath
languageFromIdentifier (Identifier -> FilePath)
-> (Item a -> Identifier) -> Item a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier

-- | Search for a word's translation in a `Translation`.
-- | If there is none, return the word unchanged.
translate :: Translation -> String -> String
translate :: Translation -> FilePath -> FilePath
translate translation :: Translation
translation word :: FilePath
word = FilePath -> FilePath -> Translation -> FilePath
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
SM.lookupDefault FilePath
word FilePath
word Translation
translation

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

            let translation :: Translation
translation = Translation -> Translation -> Translation
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
SM.union Translation
languageTranslation Translation
defaultTranslation
                dateFormat :: FilePath
dateFormat = Translation -> FilePath -> FilePath
translate Translation
translation "DATE_FORMAT"

            UTCTime
time <- TimeLocale -> Identifier -> Compiler UTCTime
forall (m :: * -> *).
(MonadMetadata m, MonadFail m) =>
TimeLocale -> Identifier -> m UTCTime
getItemUTC TimeLocale
defaultTimeLocale (Identifier -> Compiler UTCTime) -> Identifier -> Compiler UTCTime
forall a b. (a -> b) -> a -> b
$ Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item a
item
            FilePath -> Compiler FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Compiler FilePath) -> FilePath -> Compiler FilePath
forall a b. (a -> b) -> a -> b
$ TimeLocale -> FilePath -> UTCTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
dateFormat UTCTime
time

-- | `Field` containing the `Item`'s language.
languageField :: String -> Context a
languageField :: FilePath -> Context a
languageField key :: FilePath
key = FilePath -> (Item a -> Compiler FilePath) -> Context a
forall a. FilePath -> (Item a -> Compiler FilePath) -> Context a
field FilePath
key (FilePath -> Compiler FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Compiler FilePath)
-> (Item a -> FilePath) -> Item a -> Compiler FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item a -> FilePath
forall a. Item a -> FilePath
languageFromItem)

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

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

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

            [FilePath]
tags' <- Identifier -> Compiler [FilePath]
getter (Identifier -> Compiler [FilePath])
-> Identifier -> Compiler [FilePath]
forall a b. (a -> b) -> a -> b
$ Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item a
item
            [Maybe FilePath]
links <- [FilePath]
-> (FilePath -> Compiler (Maybe FilePath))
-> Compiler [Maybe FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
tags' ((FilePath -> Compiler (Maybe FilePath))
 -> Compiler [Maybe FilePath])
-> (FilePath -> Compiler (Maybe FilePath))
-> Compiler [Maybe FilePath]
forall a b. (a -> b) -> a -> b
$ \tag :: FilePath
tag -> do
                Maybe FilePath
route' <- Identifier -> Compiler (Maybe FilePath)
getRoute (Identifier -> Compiler (Maybe FilePath))
-> Identifier -> Compiler (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Tags -> FilePath -> Identifier
tagsMakeId Tags
tags FilePath
tag
                Maybe FilePath -> Compiler (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> Compiler (Maybe FilePath))
-> Maybe FilePath -> Compiler (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Translation -> FilePath -> Maybe FilePath -> Maybe FilePath
renderer Translation
translation FilePath
tag Maybe FilePath
route'

            FilePath -> Compiler FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Compiler FilePath) -> FilePath -> Compiler FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
join ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes [Maybe FilePath]
links

-- | Hakyll's `tagsField` but with translation applied to the tag name.
tagsField :: String -> Tags -> Context a
tagsField :: FilePath -> Tags -> Context a
tagsField = (Identifier -> Compiler [FilePath])
-> (Translation -> FilePath -> Maybe FilePath -> Maybe FilePath)
-> ([FilePath] -> FilePath)
-> FilePath
-> Tags
-> Context a
forall a.
(Identifier -> Compiler [FilePath])
-> (Translation -> FilePath -> Maybe FilePath -> Maybe FilePath)
-> ([FilePath] -> FilePath)
-> FilePath
-> Tags
-> Context a
Hakyll.Contrib.I18n.tagsFieldWith Identifier -> Compiler [FilePath]
forall (m :: * -> *). MonadMetadata m => Identifier -> m [FilePath]
getTags ((FilePath -> FilePath)
-> Translation -> FilePath -> Maybe FilePath -> Maybe FilePath
renderLink FilePath -> FilePath
Hakyll.toUrl) ([FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
intersperse ", ")

-- | Hakyll's `categoryField` but with translation applied to the tag name.
categoryField :: String -> Tags -> Context a
categoryField :: FilePath -> Tags -> Context a
categoryField = (Identifier -> Compiler [FilePath])
-> (Translation -> FilePath -> Maybe FilePath -> Maybe FilePath)
-> ([FilePath] -> FilePath)
-> FilePath
-> Tags
-> Context a
forall a.
(Identifier -> Compiler [FilePath])
-> (Translation -> FilePath -> Maybe FilePath -> Maybe FilePath)
-> ([FilePath] -> FilePath)
-> FilePath
-> Tags
-> Context a
Hakyll.Contrib.I18n.tagsFieldWith Identifier -> Compiler [FilePath]
forall (m :: * -> *). MonadMetadata m => Identifier -> m [FilePath]
getCategory ((FilePath -> FilePath)
-> Translation -> FilePath -> Maybe FilePath -> Maybe FilePath
renderLink FilePath -> FilePath
Hakyll.toUrl) ([FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
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' :: FilePath -> Tags -> Context a
tagsField' = (Identifier -> Compiler [FilePath])
-> (Translation -> FilePath -> Maybe FilePath -> Maybe FilePath)
-> ([FilePath] -> FilePath)
-> FilePath
-> Tags
-> Context a
forall a.
(Identifier -> Compiler [FilePath])
-> (Translation -> FilePath -> Maybe FilePath -> Maybe FilePath)
-> ([FilePath] -> FilePath)
-> FilePath
-> Tags
-> Context a
Hakyll.Contrib.I18n.tagsFieldWith Identifier -> Compiler [FilePath]
forall (m :: * -> *). MonadMetadata m => Identifier -> m [FilePath]
getTags ((FilePath -> FilePath)
-> Translation -> FilePath -> Maybe FilePath -> Maybe FilePath
renderLink FilePath -> FilePath
Hakyll.Contrib.I18n.toUrl) ([FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
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' :: FilePath -> Tags -> Context a
categoryField' = (Identifier -> Compiler [FilePath])
-> (Translation -> FilePath -> Maybe FilePath -> Maybe FilePath)
-> ([FilePath] -> FilePath)
-> FilePath
-> Tags
-> Context a
forall a.
(Identifier -> Compiler [FilePath])
-> (Translation -> FilePath -> Maybe FilePath -> Maybe FilePath)
-> ([FilePath] -> FilePath)
-> FilePath
-> Tags
-> Context a
Hakyll.Contrib.I18n.tagsFieldWith Identifier -> Compiler [FilePath]
forall (m :: * -> *). MonadMetadata m => Identifier -> m [FilePath]
getCategory ((FilePath -> FilePath)
-> Translation -> FilePath -> Maybe FilePath -> Maybe FilePath
renderLink FilePath -> FilePath
Hakyll.Contrib.I18n.toUrl) ([FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
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 :: FilePath -> Context a
translationField key :: FilePath
key = FilePath
-> ([FilePath] -> Item a -> Compiler FilePath) -> Context a
forall a.
FilePath
-> ([FilePath] -> Item a -> Compiler FilePath) -> Context a
functionField FilePath
key [FilePath] -> Item a -> Compiler FilePath
forall a. [FilePath] -> Item a -> Compiler FilePath
translationField'
    where
        translationField' :: [String] -> Item a -> Compiler String
        translationField' :: [FilePath] -> Item a -> Compiler FilePath
translationField' words :: [FilePath]
words item :: Item a
item = do
            Translation
languageTranslation <- Identifier -> Compiler Translation
forall a. (Binary a, Typeable a) => Identifier -> Compiler a
loadBody (Identifier -> Compiler Translation)
-> Identifier -> Compiler Translation
forall a b. (a -> b) -> a -> b
$ FilePath -> Identifier
fromFilePath (FilePath -> Identifier) -> FilePath -> Identifier
forall a b. (a -> b) -> a -> b
$ Item a -> FilePath
forall a. Item a -> FilePath
languageFromItem Item a
item FilePath -> FilePath -> FilePath
</> "translation.yml"
            Translation
defaultTranslation  <- Identifier -> Compiler Translation
forall a. (Binary a, Typeable a) => Identifier -> Compiler a
loadBody "templates/translation.yml"

            let translation :: Translation
translation = Translation -> Translation -> Translation
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
SM.union Translation
languageTranslation Translation
defaultTranslation
                translations :: [FilePath]
translations = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Translation -> FilePath -> FilePath
translate Translation
translation) [FilePath]
words

            FilePath -> Compiler FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Compiler FilePath) -> FilePath -> Compiler FilePath
forall a b. (a -> b) -> a -> b
$ ([FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
intersperse " ") [FilePath]
translations

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

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