Skip to content
Browse files

init 0.0.1 snaplet-i18n

  • Loading branch information...
0 parents commit 1b7b56e29a57d377b96e627dcbd40c447115a7f4 @freizl freizl committed May 14, 2012
Showing with 378 additions and 0 deletions.
  1. +4 −0 .gitignore
  2. +30 −0 LICENSE
  3. +25 −0 Makefile
  4. +5 −0 README
  5. +2 −0 Setup.hs
  6. +56 −0 snaplet-i10n.cabal
  7. +113 −0 src/Snap/Snaplet/I18N.hs
  8. +2 −0 test/data/message_en.cfg
  9. +119 −0 test/snap.hs
  10. +22 −0 test/snaplets/heist/templates/index.tpl
4 .gitignore
@@ -0,0 +1,4 @@
+dist
+*.o
+*.hi
+log
30 LICENSE
@@ -0,0 +1,30 @@
+Copyright (c)2012, Haisheng,Wu
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Haisheng,Wu nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
25 Makefile
@@ -0,0 +1,25 @@
+
+
+HC=ghc
+
+DIST=dist
+
+default: build
+
+clean:
+ rm -rf $(DIST)
+
+conf:
+ cabal configure
+
+build: conf
+ cabal build
+
+rebuild: clean build
+
+install: build
+ cabal install
+
+test-demo:
+ cd test/ && runghc snap.hs -b 127.0.0.1 -p 8888
+
5 README
@@ -0,0 +1,5 @@
+snaplet-i18n
+
+- [what is snaplet]
+
+[what is snaplet]: http://snapframework.com/docs/tutorials/snaplets-tutorial
2 Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
56 snaplet-i10n.cabal
@@ -0,0 +1,56 @@
+-- snaplet-i10n.cabal auto-generated by cabal init. For additional
+-- options, see
+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
+-- The name of the package.
+Name: snaplet-i10n
+Version: 0.0.1
+-- Description:
+Synopsis: snaplet-i18n
+Homepage: freizl.github.com
+License: BSD3
+License-file: LICENSE
+Author: Haisheng,Wu
+Maintainer: freizl@gmail.com
+Copyright: Haisheng Wu
+Category: Web
+Build-type: Simple
+Stability: Alpha
+Cabal-version: >=1.6
+
+-- Extra files to be distributed with the package, such as examples or
+-- a README.
+-- Extra-source-files:
+
+Library
+ Hs-Source-Dirs: src
+ Exposed-modules:
+ Snap.Snaplet.I18N
+
+ Build-Depends:
+ base >= 4 && < 5,
+ snap >= 0.8 && < 0.9,
+ snap-core >= 0.8 && < 0.9,
+ bytestring >= 0.9 && < 1.0,
+ data-lens-template >= 2.1 && < 2.2,
+ data-lens >= 2.0 && < 2.1,
+-- containers >= 0.4 && < 0.5,
+ filepath >= 1.2 && < 1.3,
+ directory >= 1.1 && < 1.2,
+ configurator >= 0.2 && < 0.3,
+ text >= 0.11 && < 0.12,
+ xmlhtml >= 0.1.7 && < 0.2,
+ heist >= 0.8 && < 0.9
+
+ if impl(ghc >= 6.12.0)
+ ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
+ -fno-warn-orphans -fno-warn-unused-do-bind
+ else
+ ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
+ -fno-warn-orphans
+
+ -- Modules not exported by this package.
+ -- Other-modules:
+
+ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+ -- Build-tools:
+
113 src/Snap/Snaplet/I18N.hs
@@ -0,0 +1,113 @@
+{-# LANGUAGE OverloadedStrings, FlexibleInstances, MultiParamTypeClasses #-}
+
+module Snap.Snaplet.I18N where
+
+import Control.Monad
+import Data.Lens.Common
+import Data.Maybe
+import qualified Data.Text as T
+import System.Directory
+import System.FilePath.Posix
+import qualified Data.Configurator as Config
+import qualified Data.Configurator.Types as Config
+import qualified Text.XmlHtml as X
+import Text.Templating.Heist
+import Text.XmlHtml hiding (render)
+
+import Snap
+import Snap.Snaplet.Heist
+-------------------------------------------------------
+--
+--
+--
+--
+-------------------------------------------------------
+
+type Locale = String
+type MessageFile = String
+
+data I18NConfig = I18NConfig { _getLocale :: Locale -- ^ locale, default "en"
+ , _getMessageFile :: MessageFile -- ^ message file name, default to "message"
+ } deriving (Show)
+
+-- | A simple mapping to hold i18n messages
+--
+data I18NMessage = I18NMessage Config.Config
+
+-- | data type
+--
+data I18NSnaplet = I18NSnaplet
+ { _getI18NConfig :: I18NConfig
+ , _getI18NMessage :: I18NMessage
+ }
+
+
+class HasI18N b where
+ i18nLens :: Lens b (Snaplet I18NSnaplet)
+
+i18nLens' :: HasI18N b => Lens (Snaplet b) (Snaplet I18NSnaplet)
+i18nLens' = subSnaplet i18nLens
+
+getI18NSnaplet :: HasI18N b => Handler b b I18NSnaplet
+getI18NSnaplet = with i18nLens Snap.get
+
+getI18NMessages :: HasI18N b => Handler b b I18NMessage
+getI18NMessages = liftM _getI18NMessage getI18NSnaplet
+
+-------------------------------------------------------
+
+-- | Default I18N snaplet
+--
+defaultI18NSnaplet :: (HasHeist b, HasI18N b) => SnapletInit b I18NSnaplet
+defaultI18NSnaplet = initI18NSnaplet Nothing Nothing
+
+-- | Init this I18NSnaplet snaplet.
+--
+initI18NSnaplet :: (HasHeist b, HasI18N b) => Maybe Locale -> Maybe MessageFile -> SnapletInit b I18NSnaplet
+initI18NSnaplet l m = makeSnaplet "I18NSnaplet" "" Nothing $ do
+ --mainConfig <- getSnapletUserConfig
+ i18nConfig <- return $ I18NConfig (fromMaybe "en" l) (fromMaybe "data/message" m)
+ config <- liftIO $ readMessageFile i18nConfig
+ defaultSplices
+ return $ I18NSnaplet i18nConfig $ I18NMessage config
+ where defaultSplices = addSplices [(i18nSpliceName, liftHeist i18nSplice)]
+
+-------------------------------------------------------
+-- Load file
+
+readMessageFile :: I18NConfig -> IO Config.Config
+readMessageFile config = do
+ base <- getCurrentDirectory
+ fullname <- return $ base </> (file config)
+ print fullname
+ Config.load [Config.Required fullname]
+ where file c = _getMessageFile c ++ "_" ++ _getLocale c ++ ".cfg"
+
+
+lookupText :: Config.Config -> Config.Name -> IO (Maybe T.Text)
+lookupText = Config.lookup
+
+-------------------------------------------------------
+
+i18nSpliceName :: T.Text
+i18nSpliceName = "i18n"
+
+i18nSpliceElement :: T.Text
+i18nSpliceElement = "span"
+
+i18nSpliceAttr :: T.Text
+i18nSpliceAttr = "name"
+
+-- | Splices
+--
+i18nSplice :: HasI18N b => Splice (Handler b b)
+i18nSplice = do
+ input <- getParamNode
+ (I18NMessage messages) <- lift getI18NMessages
+ value <- liftIO $ getValue messages input
+ return [X.Element i18nSpliceElement [] [X.TextNode $ T.pack value]]
+ where getValue :: Config.Config -> Node -> IO String
+ getValue m i = Config.lookupDefault "Cannot find i18n message" m (getAttr' i)
+ getAttr' i = case getAttribute i18nSpliceAttr i of
+ Just x -> x
+ _ -> ""
2 test/data/message_en.cfg
@@ -0,0 +1,2 @@
+hello = "Hello"
+shanghai = "ShangHai"
119 test/snap.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE RankNTypes #-}
+
+
+module Main where
+
+------------------------------------------------------------------------------
+import Control.Category
+import Control.Monad
+import Control.Exception (SomeException, try)
+import Data.ByteString (ByteString)
+import Data.Maybe
+import Network.HTTP.Conduit (responseBody)
+import Network.HTTP.Types (renderSimpleQuery)
+import Prelude hiding ((.))
+import Snap hiding (Config)
+import qualified Data.Configurator as CF
+import qualified Data.Configurator.Types as CF
+import Snap.Core
+import Snap.Http.Server
+import Snap.Snaplet.Heist
+import Snap.Snaplet.OAuth
+import Snap.Util.FileServe
+import System.IO
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Text.XmlHtml as X
+import Text.Templating.Heist
+import Text.XmlHtml hiding (render)
+
+#ifdef DEVELOPMENT
+import Snap.Loader.Devel
+#else
+import Snap.Loader.Prod
+#endif
+
+import Snap.Snaplet.I18N
+
+------------------------------------------------------------------------------
+
+data App = App
+ { _heist :: Snaplet (Heist App)
+ , _i18n :: Snaplet I18NSnaplet
+ }
+
+makeLens ''App
+
+instance HasHeist App where
+ heistLens = subSnaplet heist
+
+instance HasI18N App where
+ i18nLens = i18n
+
+type AppHandler = Handler App App
+
+------------------------------------------------------------------------------
+
+decodedParam :: MonadSnap m => ByteString -> m ByteString
+decodedParam p = fromMaybe "" <$> getParam p
+
+------------------------------------------------------------------------------
+
+
+testHandler :: Handler App App ()
+testHandler = do
+ (I18NMessage messages) <- getI18NMessages
+ msg <- liftIO $ (CF.lookup messages "hello" :: IO (Maybe String) )
+ liftIO $ print msg
+ writeBS "test"
+
+index :: AppHandler ()
+index = do
+ render "index"
+
+-- | wrap to element span
+--
+
+------------------------------------------------------------------------------
+
+-- | The application's routes.
+routes :: [(ByteString, Handler App App ())]
+routes = [ ("/", index)
+ , ("/test", testHandler)
+ , ("", with heist heistServe)
+ ]
+
+-- | The application initializer.
+app :: SnapletInit App App
+app = makeSnaplet "app" "An snaplet example application." Nothing $ do
+ h <- nestSnaplet "heist" heist $ heistInit "templates"
+ i <- nestSnaplet "i18n" i18n $ defaultI18NSnaplet
+ addRoutes routes
+ return $ App h i
+
+
+------------------------------------------------------------------------------
+
+main :: IO ()
+main = do
+ (conf, site, cleanup) <- $(loadSnapTH [| getConf |]
+ 'getActions
+ ["heist/templates"])
+
+ _ <- try $ httpServe conf $ site :: IO (Either SomeException ())
+ cleanup
+
+getConf :: IO (Config Snap ())
+getConf = commandLineConfig defaultConfig
+
+getActions :: Config Snap () -> IO (Snap (), IO ())
+getActions _ = do
+ (msgs, site, cleanup) <- runSnaplet app
+ hPutStrLn stderr $ T.unpack msgs
+ return (site, cleanup)
+
22 test/snaplets/heist/templates/index.tpl
@@ -0,0 +1,22 @@
+<!DOCTYPE html>
+<html>
+<head>
+
+<style>
+ p > span { display: block; }
+</style>
+
+</head>
+
+<body>
+
+<h2>Test I18N</h2>
+
+<p>
+<i18n name="shanghai"></i18n>
+<i18n name="hello"></i18n>
+<i18n name="invalidekey"></i18n>
+</p>
+
+</body>
+</html>

0 comments on commit 1b7b56e

Please sign in to comment.
Something went wrong with that request. Please try again.