fradrive/src/Handler/Utils/I18n.hs
2019-08-20 15:02:23 +02:00

43 lines
1.9 KiB
Haskell
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

module Handler.Utils.I18n
where
import Import
import Language.Haskell.TH
import Language.Haskell.TH.Syntax (qRunIO)
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import System.Directory (listDirectory)
import System.FilePath.Posix (takeBaseName)
-- | Add language dependent template files
--
-- For large files which are translated as a whole.
--
-- Argument musst be a directory under @/templates@,
-- which contains a file for each language,
-- eg. @imprint@ for choosing between
-- @/templates/imprint/de.hamlet@, @/templates/imprint/de-at.hamlet@,
-- and @/templates/imprint/en.hamlet@
--
-- Dependency detection cannot work properly (no `addDependentFile`-equivalent
-- for directories)
-- @$ stack clean@ is required so new translations show up
i18nWidgetFile :: FilePath -> Q Exp
i18nWidgetFile basename = do
-- Construct list of available translations (@de@, @en@, ...) at compile time
let i18nDirectory = "templates" </> "i18n" </> basename
availableFiles <- qRunIO $ listDirectory i18nDirectory
let availableTranslations = sortWith (NTop . flip List.elemIndex (NonEmpty.toList appLanguages)) . List.nub $ pack . takeBaseName <$> availableFiles
availableTranslations' <- maybe (fail $ "" <> i18nDirectory <> " is empty") return $ NonEmpty.nonEmpty availableTranslations
-- Dispatch to correct language (depending on user settings via `selectLanguage`) at run time
ws <- newName "ws" -- Name for dispatch function
letE
[ funD ws $ [ clause [litP $ stringL l] (normalB . widgetFile $ "i18n" </> basename </> l) []
| l <- unpack <$> NonEmpty.toList availableTranslations' -- One function definition for every available language
] ++ [ clause [wildP] (normalB [e| error "selectLanguage returned an invalid translation" |]) [] ] -- Fallback mostly there so compiler does not complain about non-exhaustive pattern match
] [e|selectLanguage availableTranslations' >>= $(varE ws)|]