module Snap.Snaplet.I18N
( I18NSnaplet
, HasI18N (..)
, I18NMessage (..)
, initI18NSnaplet
, getI18NMessages
, lookupI18NValue
) where
import Control.Monad
import Data.Lens.Common
import Data.Maybe
import System.Directory
import System.FilePath.Posix
import Text.Templating.Heist
import Text.XmlHtml hiding (render)
import qualified Data.Configurator as Config
import qualified Data.Configurator.Types as Config
import qualified Data.Text as T
import qualified Text.XmlHtml as X
import Snap
import Snap.Snaplet.Heist
type Locale = String
type MessageFile = String
defaultLocale :: Locale
defaultLocale = "en_US"
defaultMessageFilePrefix :: MessageFile
defaultMessageFilePrefix = "data/message"
data I18NConfig = I18NConfig { _getLocale :: Locale
, _getMessageFile :: MessageFile
} deriving (Show)
data I18NMessage = I18NMessage Config.Config
data I18NSnaplet = I18NSnaplet
{ _getI18NConfig :: I18NConfig
, _getI18NMessage :: I18NMessage
}
class HasI18N b where
i18nLens :: Lens b (Snaplet I18NSnaplet)
getI18NSnaplet :: HasI18N b => Handler b b I18NSnaplet
getI18NSnaplet = with i18nLens Snap.get
getI18NMessages :: HasI18N b => Handler b b I18NMessage
getI18NMessages = liftM _getI18NMessage getI18NSnaplet
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
initI18NSnaplet :: (HasHeist b, HasI18N b)
=> Maybe Locale
-> SnapletInit b I18NSnaplet
initI18NSnaplet l = makeSnaplet "I18NSnaplet" "" Nothing $ do
let i18nConfig = I18NConfig (fromMaybe defaultLocale l) defaultMessageFilePrefix
config <- liftIO $ readMessageFile i18nConfig
addDefaultSplices
return $ I18NSnaplet i18nConfig $ I18NMessage config
where addDefaultSplices = addSplices [ ("i18n", liftHeist i18nSplice)
, ("i18nSpan", liftHeist i18nSpanSplice)]
readMessageFile :: I18NConfig -> IO Config.Config
readMessageFile config = do
base <- getCurrentDirectory
let fullname = base </> file config
Config.load [Config.Required fullname]
where
file c = _getMessageFile c ++ "-" ++ _getLocale c ++ ".cfg"
i18nSpliceAttr :: T.Text
i18nSpliceAttr = "name"
i18nSplice :: HasI18N b => Splice (Handler b b)
i18nSplice = do
input <- getParamNode
value <- lift . lookupI18NValue $ getNameAttr input
case childElements input of
[] -> return [X.TextNode value]
_ -> runChildrenWithText [("i18nValue", value)]
i18nSpanSplice :: HasI18N b => Splice (Handler b b)
i18nSpanSplice = do
input <- getParamNode
value <- lift . lookupI18NValue $ getNameAttr input
return [X.Element "span" (elementAttrs input) [X.TextNode value]]
getNameAttr :: Node -> T.Text
getNameAttr n = case getAttribute i18nSpliceAttr n of
Just x -> x
_ -> ""