module Snap.Snaplet.I18N
( I18N
, HasI18N (..)
, I18NMessage (..)
, initI18N
, getI18NMessages
, lookupI18NValue
) where
import Control.Monad
import qualified Data.Configurator as Config
import qualified Data.Configurator.Types as Config
import Data.Maybe
import qualified Data.Text as T
import Heist
import qualified Heist.Interpreted as I
import System.FilePath.Posix
import Text.XmlHtml hiding (render)
import qualified Text.XmlHtml as X
import Paths_snaplet_i18n
import Snap
import Snap.Snaplet.Heist
type Locale = String
type MessageFile = String
defaultLocale :: Locale
defaultLocale = "en_US"
defaultMessageFilePrefix :: MessageFile
defaultMessageFilePrefix = "message"
data I18NConfig = I18NConfig { _getLocale :: Locale
, _getMessageFile :: MessageFile
} deriving (Show)
newtype I18NMessage = I18NMessage Config.Config
data I18N = I18N
{ _getI18NConfig :: I18NConfig
, _getI18NMessage :: I18NMessage
}
class HasI18N b where
i18nLens :: SnapletLens b I18N
getI18N :: HasI18N b => Handler b b I18N
getI18N = with i18nLens Snap.get
getI18NMessages :: HasI18N b => Handler b b I18NMessage
getI18NMessages = liftM _getI18NMessage getI18N
lookupI18NValue :: HasI18N b => T.Text -> Handler b b T.Text
lookupI18NValue key = do
(I18NMessage msg) <- getI18NMessages
liftIO $ Config.lookupDefault "Error: no value found." msg key
initI18N :: (HasHeist b, HasI18N b)
=> Maybe Locale
-> SnapletInit b I18N
initI18N l = makeSnaplet "i18n" description datadir $ do
let i18nConfig = I18NConfig (fromMaybe defaultLocale l) defaultMessageFilePrefix
fp <- getSnapletFilePath
msg <- liftIO $ readMessageFile fp i18nConfig
modifyHeistState addDefaultSplices
return $ I18N i18nConfig msg
where addDefaultSplices = I.bindSplices splices
splices = do
"i18n" ## i18nSplice
"i18nSpan" ## i18nSpanSplice
datadir = Just $ liftM (++ "/resources") getDataDir
description = "light weight i18n snaplet"
readMessageFile :: FilePath -> I18NConfig -> IO I18NMessage
readMessageFile base config = do
let fullname = base </> file config
fmap I18NMessage (Config.load [Config.Required fullname])
where
file c = _getMessageFile c ++ "-" ++ _getLocale c ++ ".cfg"
i18nSpliceAttr :: T.Text
i18nSpliceAttr = "name"
i18nSplice :: HasI18N b => I.Splice (Handler b b)
i18nSplice = do
input <- getParamNode
value <- lift . lookupI18NValue $ getNameAttr input
case childElements input of
[] -> return [X.TextNode value]
_ -> I.runChildrenWithText ("i18nValue" ## value)
i18nSpanSplice :: HasI18N b => I.Splice (Handler b b)
i18nSpanSplice = do
input <- getParamNode
v <- lift . lookupI18NValue $ getNameAttr input
return [X.Element "span" (elementAttrs input) [X.TextNode v]]
getNameAttr :: Node -> T.Text
getNameAttr n = case getAttribute i18nSpliceAttr n of
Just x -> x
_ -> ""