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)|]