Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

ver 0.1

  • Loading branch information...
commit 07fbfdbbaa54f88f85dca797c0bce6b77f689f52 1 parent 75b9edd
@lymar lymar authored
View
30 LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2011, Sergey S Lymar
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+2. 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.
+
+3. Neither the name of the author nor the names of his contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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.
View
0  README
No changes.
View
13 README.markdown
@@ -0,0 +1,13 @@
+# Hastache
+
+Haskell implementation of [Mustache templates](http://mustache.github.com/)
+
+## Installation
+
+ cabal update
+ cabal install hastache
+
+## Examples
+
+See tests/test.hs for examples of usage
+
View
5 Setup.hs
@@ -0,0 +1,5 @@
+#! /usr/bin/env runhaskell
+
+import Distribution.Simple
+main = defaultMain
+
View
355 Text/Hastache.hs
@@ -0,0 +1,355 @@
+{-# LANGUAGE ExistentialQuantification, FlexibleInstances, FlexibleContexts,
+ IncoherentInstances #-}
+-- Module: Text.Hastache
+-- Copyright: Sergey S Lymar (c) 2011
+-- License: BSD3
+-- Maintainer: Sergey S Lymar <sergey.lymar@gmail.com>
+-- Stability: experimental
+-- Portability: portable
+--
+-- Haskell implementation of Mustache templates
+
+{- | Haskell implementation of Mustache templates
+
+See homepage for examples: <http://github.com/lymar/hastache>
+-}
+module Text.Hastache (
+ hastacheStr
+ , hastacheFile
+ , MuContext
+ , MuType(..)
+ , MuConfig(..)
+ , MuVar
+ , htmlEscape
+ , emptyEscape
+ , defaultConfig
+ , encodeStr
+ , encodeStrLBS
+ , decodeStr
+ , decodeStrLBS
+ ) where
+
+import Prelude hiding (putStrLn, readFile, length, drop, tail, dropWhile,
+ elem, head, last, reverse, take, span)
+import Data.ByteString hiding (map, foldl1)
+import qualified Data.ByteString.Lazy as LZ
+import qualified Codec.Binary.UTF8.String as SU
+import Control.Monad.Writer.Lazy (tell, liftIO, MonadIO, execWriterT,
+ MonadWriter)
+import Data.Char (ord)
+import Data.Word
+import Control.Monad (guard, when)
+import System.FilePath (combine)
+import System.Directory (doesFileExist)
+import Control.Monad.Trans (lift)
+import Data.Int
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as LText
+import Data.Maybe (isJust)
+
+(~>) :: a -> (a -> b) -> b
+x ~> f = f $ x
+infixl 9 ~>
+
+-- | Data for Hastache variable
+type MuContext m =
+ ByteString -- ^ Variable name
+ -> MuType m -- ^ Value
+
+class Show a => MuVar a where
+ toLByteString :: a -> LZ.ByteString
+
+instance MuVar ByteString where
+ toLByteString = toLBS
+
+instance MuVar LZ.ByteString where
+ toLByteString = id
+
+withShowToLBS a = show a ~> encodeStr ~> toLBS
+
+instance MuVar Integer where toLByteString = withShowToLBS
+instance MuVar Int where toLByteString = withShowToLBS
+instance MuVar Float where toLByteString = withShowToLBS
+instance MuVar Double where toLByteString = withShowToLBS
+instance MuVar Int8 where toLByteString = withShowToLBS
+instance MuVar Int16 where toLByteString = withShowToLBS
+instance MuVar Int32 where toLByteString = withShowToLBS
+instance MuVar Int64 where toLByteString = withShowToLBS
+instance MuVar Word where toLByteString = withShowToLBS
+instance MuVar Word8 where toLByteString = withShowToLBS
+instance MuVar Word16 where toLByteString = withShowToLBS
+instance MuVar Word32 where toLByteString = withShowToLBS
+instance MuVar Word64 where toLByteString = withShowToLBS
+
+instance MuVar Text.Text where
+ toLByteString t = Text.unpack t ~> encodeStr ~> toLBS
+
+instance MuVar LText.Text where
+ toLByteString t = LText.unpack t ~> encodeStr ~> toLBS
+
+instance MuVar Char where
+ toLByteString a = (a : "") ~> encodeStr ~> toLBS
+
+instance MuVar a => MuVar [a] where
+ toLByteString a = (toLByteString '[') <+> cnvLst <+> (toLByteString ']')
+ where
+ cnvLst = (map toLByteString a) ~>
+ (LZ.intercalate (toLByteString ','))
+ (<+>) = LZ.append
+
+instance MuVar [Char] where
+ toLByteString k = k ~> encodeStr ~> toLBS
+
+data MuType m =
+ forall a. MuVar a => MuVariable a |
+ MuList [MuContext m] |
+ MuBool Bool |
+ MuLambda (ByteString -> ByteString) |
+ MuLambdaM (ByteString -> m ByteString)
+
+instance Show (MuType m) where
+ show (MuVariable a) = "MuVariable " ++ show a
+ show (MuList _) = "MuList [..]"
+ show (MuBool v) = "MuBool " ++ show v
+ show (MuLambda _) = "MuLambda <..>"
+ show (MuLambdaM _) = "MuLambdaM <..>"
+
+data MuConfig = MuConfig {
+ muEscapeFunc :: LZ.ByteString -> LZ.ByteString,
+ -- ^ Escape function ('htmlEscape', 'emptyEscape' etc.)
+ muTemplateFileDir :: Maybe FilePath,
+ -- ^ Directory for search partial templates ({{> templateName}})
+ muTemplateFileExt :: Maybe String
+ -- ^ Partial template files extension
+ }
+
+-- | Convert String to UTF-8 Bytestring
+encodeStr :: String -> ByteString
+encodeStr = pack . SU.encode
+
+-- | Convert String to UTF-8 Lazy Bytestring
+encodeStrLBS :: String -> LZ.ByteString
+encodeStrLBS = LZ.pack . SU.encode
+
+-- | Convert UTF-8 Bytestring to String
+decodeStr :: ByteString -> String
+decodeStr = SU.decode . unpack
+
+-- | Convert UTF-8 Lazy Bytestring to String
+decodeStrLBS :: LZ.ByteString -> String
+decodeStrLBS = SU.decode . LZ.unpack
+
+ord8 :: Char -> Word8
+ord8 = fromIntegral . ord
+
+-- | Escape HTML symbols
+htmlEscape :: LZ.ByteString -> LZ.ByteString
+htmlEscape str = LZ.unpack str ~> proc ~> LZ.pack
+ where
+ proc :: [Word8] -> [Word8]
+ proc (h:t)
+ | h == ord8 '&' = stp "&amp;" t
+ | h == ord8 '\\'= stp "\\\\" t
+ | h == ord8 '"' = stp "&quot;" t
+ | h == ord8 '\''= stp "&#39;" t
+ | h == ord8 '<' = stp "&lt;" t
+ | h == ord8 '>' = stp "&gt;" t
+ | otherwise = h : (proc t)
+ proc [] = []
+ stp a t = (map ord8 a) ++ (proc t)
+
+-- | No escape
+emptyEscape :: LZ.ByteString -> LZ.ByteString
+emptyEscape = id
+
+{- | Default config: HTML escape function, current directory as
+ template directory, template file extension not specified -}
+defaultConfig :: MuConfig
+defaultConfig = MuConfig {
+ muEscapeFunc = htmlEscape,
+ muTemplateFileDir = Nothing,
+ muTemplateFileExt = Nothing
+ }
+
+defOTag = encodeStr "{{"
+defCTag = encodeStr "}}"
+unquoteCTag = encodeStr "}}}"
+
+findBlock :: ByteString -> ByteString -> ByteString
+ -> Maybe (ByteString, Word8, ByteString, ByteString)
+findBlock str otag ctag = do
+ guard (length fnd > (length otag))
+ Just (pre, symb, inTag, afterClose)
+ where
+ (pre, fnd) = breakSubstring otag str
+ symb = index fnd (length otag)
+ (inTag, afterClose)
+ -- test for unescape ( {{{some}}} )
+ | symb == ord8 '{' && ctag == defCTag =
+ breakSubstring unquoteCTag fnd ~> \(a,b) ->
+ (drop (length otag) a, drop 3 b)
+ | otherwise = breakSubstring ctag fnd ~> \(a,b) ->
+ (drop (length otag) a, drop (length ctag) b)
+
+toLBS :: ByteString -> LZ.ByteString
+toLBS v = LZ.fromChunks [v]
+
+readVar context name = do
+ case context name of
+ MuVariable a -> toLByteString a
+ MuBool a -> show a ~> encodeStr ~> toLBS
+ _ -> LZ.empty
+
+findCloseSection :: ByteString -> ByteString -> ByteString -> ByteString
+ -> Maybe (ByteString, ByteString)
+findCloseSection str name otag ctag = do
+ guard (length after > 0)
+ Just (before, drop (length close) after)
+ where
+ close = foldl1 append [otag, encodeStr "/", name, ctag]
+ (before, after) = breakSubstring close str
+
+trimCharsTest :: Word8 -> Bool
+trimCharsTest = (`elem` (encodeStr " \t"))
+
+trimAll :: ByteString -> ByteString
+trimAll str = span trimCharsTest str ~> snd ~> spanEnd trimCharsTest ~> fst
+
+tellBS :: (MonadWriter LZ.ByteString m) => ByteString -> m ()
+tellBS str = toLBS str ~> tell
+
+processBlock str context otag ctag conf = do
+ case findBlock str otag ctag of
+ Just (pre, symb, inTag, afterClose) -> do
+ tellBS pre
+ renderBlock context symb inTag afterClose
+ otag ctag conf
+ Nothing -> do
+ tellBS str
+ return ()
+
+renderBlock context symb inTag afterClose otag ctag conf
+ -- comment
+ | symb == ord8 '!' = next afterClose
+ -- unescape variable
+ | symb == ord8 '&' || (symb == ord8 '{' && otag == defOTag) = do
+ readVar context (tail inTag ~> trimAll) ~> tell
+ next afterClose
+ -- section. inverted section
+ | symb == ord8 '#' || symb == ord8 '^' =
+ let normalSection = symb == ord8 '#' in do
+ case findCloseSection afterClose (tail inTag) otag ctag of
+ Nothing -> next afterClose
+ Just (sectionContent', afterSection') ->
+ let
+ dropNL str =
+ if (length str) > 0 && (head str) == ord8 '\n'
+ then tail str
+ else str
+ sectionContent = dropNL sectionContent'
+ afterSection =
+ if ord8 '\n' `elem` sectionContent
+ then dropNL afterSection'
+ else afterSection'
+ in do
+ case context (tail inTag) of
+ MuList [] ->
+ if normalSection then do next afterSection
+ else do
+ processBlock sectionContent
+ context otag ctag conf
+ next afterSection
+ MuList b ->
+ if normalSection then do
+ mapM_ (\c -> processBlock sectionContent
+ c otag ctag conf) b
+ next afterSection
+ else do next afterSection
+ MuBool True ->
+ if normalSection then do
+ processBlock sectionContent
+ context otag ctag conf
+ next afterSection
+ else do next afterSection
+ MuBool False ->
+ if normalSection then do next afterSection
+ else do
+ processBlock sectionContent
+ context otag ctag conf
+ next afterSection
+ MuLambda func ->
+ if normalSection then do
+ func sectionContent ~> tellBS
+ next afterSection
+ else do next afterSection
+ MuLambdaM func ->
+ if normalSection then do
+ res <- lift (func sectionContent)
+ tellBS res
+ next afterSection
+ else do next afterSection
+ _ -> next afterSection
+ -- set delimiter
+ | symb == ord8 '=' =
+ let
+ lenInTag = length inTag
+ delimitersCommand = take (lenInTag - 1) inTag ~> drop 1
+ getDelimiter = do
+ guard (lenInTag > 4)
+ guard ((index inTag $ lenInTag - 1) == ord8 '=')
+ [newOTag,newCTag] <- Just $ split (ord8 ' ')
+ delimitersCommand
+ Just (newOTag, newCTag)
+ in do
+ case getDelimiter of
+ Nothing -> next afterClose
+ Just (newOTag, newCTag) ->
+ processBlock (trim' afterClose) context
+ newOTag newCTag conf
+ -- partials
+ | symb == ord8 '>' =
+ let
+ fileName' = tail inTag ~> trimAll
+ fileName'' = case muTemplateFileExt conf of
+ Nothing -> fileName'
+ Just ext -> fileName' `append` (encodeStr ext)
+ fileName = decodeStr fileName''
+ fullFileName = case muTemplateFileDir conf of
+ Nothing -> fileName
+ Just path -> combine path fileName
+ in do
+ fe <- liftIO $ doesFileExist fullFileName
+ when fe $ do
+ cnt <- liftIO $ readFile fullFileName
+ next cnt
+ next (trim' afterClose)
+ -- variable
+ | otherwise = do
+ readVar context (trimAll inTag) ~> muEscapeFunc conf ~> tell
+ next afterClose
+ where
+ next t = processBlock t context otag ctag conf
+ trim' content =
+ dropWhile trimCharsTest content
+ ~> \t -> if (length t > 0 && head t == ord8 '\n')
+ then tail t else content
+
+-- | Render Hastache template from ByteString
+hastacheStr :: (MonadIO m) =>
+ MuConfig -- ^ Configuration
+ -> ByteString -- ^ Template
+ -> MuContext m -- ^ Context
+ -> m LZ.ByteString
+hastacheStr conf str context =
+ execWriterT (processBlock str context defOTag defCTag conf)
+
+-- | Render Hastache template from file
+hastacheFile :: (MonadIO m) =>
+ MuConfig -- ^ Configuration
+ -> String -- ^ Template file name
+ -> MuContext m -- ^ Context
+ -> m LZ.ByteString
+hastacheFile conf file_name context = do
+ str <- liftIO $ readFile file_name
+ hastacheStr conf str context
+
View
147 Text/Hastache/Context.hs
@@ -0,0 +1,147 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+-- Module: Text.Hastache.Context
+-- Copyright: Sergey S Lymar (c) 2011
+-- License: BSD3
+-- Maintainer: Sergey S Lymar <sergey.lymar@gmail.com>
+-- Stability: experimental
+-- Portability: portable
+
+{- |
+Hastache context helpers
+-}
+module Text.Hastache.Context (
+ mkStrContext
+ , mkGenericContext
+ ) where
+
+import Data.Data
+import Data.Generics
+import Data.Int
+import Data.Word
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as LText
+import qualified Data.Map as Map
+
+import Text.Hastache
+
+x ~> f = f $ x
+infixl 9 ~>
+
+-- | Make Hastache context from String -> MuType function
+mkStrContext :: Monad m => (String -> MuType m) -> MuContext m
+mkStrContext f a = decodeStr a ~> f
+
+{- |
+Make Hastache context from Data
+
+@
+data InternalData = InternalData {
+ someField :: String,
+ anotherField :: Int
+ } deriving (Data, Typeable, Show)
+
+data Example = Example {
+ stringField :: String,
+ intField :: Int,
+ dataField :: InternalData,
+ simpleListField :: [String],
+ dataListField :: [InternalData]
+ } deriving (Data, Typeable, Show)
+
+example = hastacheStr defaultConfig (encodeStr template)
+ (mkGenericContext context)
+ where
+ template = concat [
+ \"string: {{stringField}} \\n\",
+ \"int: {{intField}} \\n\",
+ \"data: {{dataField.someField}}, {{dataField.anotherField}} \\n\",
+ \"simple list: {{#simpleListField}}{{.}} {{/simpleListField}} \\n\",
+ \"data list: \\n\",
+ \"{{#dataListField}}\\n\",
+ \" * {{someField}}, {{anotherField}} \\n\",
+ \"{{/dataListField}}\\n\"]
+ context = Example { stringField = \"string value\", intField = 1,
+ dataField = InternalData \"val\" 123, simpleListField = [\"a\",\"b\",\"c\"],
+ dataListField = [InternalData \"aaa\" 1, InternalData \"bbb\" 2] }
+@
+
+Result:
+
+@
+string: string value
+int: 1
+data: val, 123
+simple list: a b c
+data list:
+ * aaa, 1
+ * bbb, 2
+@
+-}
+mkGenericContext :: (Monad m, Data a) => a -> MuContext m
+mkGenericContext val = toGenTemp val ~> convertGenTempToContext
+
+data TD m =
+ TSimple (MuType m)
+ | TObj [(String, TD m)]
+ | TList [TD m]
+ | TUnknown
+ deriving (Show)
+
+toGenTemp :: (Data a, Monad m) => a -> TD m
+toGenTemp a = zip fields (gmapQ procField a) ~> TObj
+ where
+ fields = toConstr a ~> constrFields
+
+procField :: (Data a, Monad m) => a -> TD m
+procField =
+ obj
+ `ext1Q` list
+ `extQ` (\(i::String) -> MuVariable (encodeStr i) ~> TSimple)
+ `extQ` (\(i::Char) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Double) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Float) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Int) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Int8) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Int16) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Int32) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Int64) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Integer) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Word) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Word8) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Word16) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Word32) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Word64) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::BS.ByteString) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::LBS.ByteString) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Text.Text) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::LText.Text) -> MuVariable i ~> TSimple)
+ `extQ` (\(i::Bool) -> MuBool i ~> TSimple)
+ where
+ obj a = case dataTypeRep (dataTypeOf a) of
+ AlgRep [c] -> toGenTemp a
+ _ -> TUnknown
+ list a = map procField a ~> TList
+
+convertGenTempToContext :: TD t -> MuContext t
+convertGenTempToContext v = mkMap "" Map.empty v ~> mkMapContext
+ where
+ mkMap name m (TSimple t) = Map.insert (encodeStr name) t m
+ mkMap name m (TObj lst) = foldl (foldTObj name) m lst
+ mkMap name m (TList lst) = Map.insert (encodeStr name)
+ (map convertGenTempToContext lst ~> MuList) m
+ mkMap _ m _ = m
+
+ mkName name newName = if length name > 0
+ then concat [name, ".", newName]
+ else newName
+ foldTObj name m (fn, fv) = mkMap (mkName name fn) m fv
+
+ mkMapContext m a = case Map.lookup a m of
+ Nothing -> case Map.lookup BS.empty m of
+ Nothing -> MuVariable BS.empty
+ Just a -> a
+ Just a -> a
+
View
43 hastache.cabal
@@ -0,0 +1,43 @@
+name: hastache
+version: 0.1
+license: BSD3
+license-file: LICENSE
+category: Text
+copyright: Sergey S Lymar (c) 2011
+author: Sergey S Lymar <sergey.lymar@gmail.com>
+maintainer: Sergey S Lymar <sergey.lymar@gmail.com>
+stability: experimental
+tested-with: GHC == 7.0.2
+synopsis: Haskell implementation of Mustache templates
+cabal-version: >= 1.8
+homepage: http://github.com/lymar/hastache
+bug-reports: http://github.com/lymar/hastache/issues
+build-type: Simple
+description:
+ Haskell implementation of Mustache templates (<http://mustache.github.com/>).
+ .
+ See homepage for examples: <http://github.com/lymar/hastache>
+
+extra-source-files:
+ Examples/example.hs
+
+library
+ exposed-modules:
+ Text.Hastache
+ Text.Hastache.Context
+
+ build-depends:
+ base == 4.*
+ ,bytestring
+ ,mtl
+ ,directory
+ ,filepath
+ ,utf8-string
+ ,text >= 0.11.0.2
+ ,containers
+ ,syb
+
+source-repository head
+ type: git
+ location: http://github.com/lymar/hastache
+
View
2  tests/RunTest.sh
@@ -0,0 +1,2 @@
+runhaskell -i.. test.hs
+
View
1  tests/partFile
@@ -0,0 +1 @@
+Hi, {{name}}!
View
319 tests/test.hs
@@ -0,0 +1,319 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Tests where
+
+import Test.HUnit
+import Text.Hastache
+import Text.Hastache.Context
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LZ
+import qualified Data.Text as T
+import Control.Monad
+import Control.Monad.Writer
+import Data.Data
+import Data.Generics
+
+-- Hastache comments
+commentsTest = do
+ res <- hastacheStr defaultConfig (encodeStr template) undefined
+ assertEqualStr "result correctness" (decodeStrLBS res) testRes
+ where
+ template = "\
+ \hello {{! comment #1}} world! \n\
+ \hello {{! comment #2 \n\
+ \multiline\n\
+ \}} world! \n\
+ \"
+ testRes = "\
+ \hello world! \n\
+ \hello world! \n\
+ \"
+
+-- Variables
+variablesTest = do
+ res <- hastacheStr defaultConfig (encodeStr template)
+ (mkStrContext context)
+ assertEqualStr "result correctness" (decodeStrLBS res) testRes
+ where
+ template = "\
+ \ Char: [ {{Char}} ] \n\
+ \ Double: [ {{Double}} ] \n\
+ \ Int: [ {{Int}} ] \n\
+ \ ByteString: [ {{ByteString}} ] \n\
+ \ Text: [ {{Text}} ] \n\
+ \ String: [ {{String}} ] \n\
+ \ HtmlString: [ {{HtmlString}} ] \n\
+ \ HtmlStringUnEsc: [ {{{HtmlString}}} ] \n\
+ \ HtmlStringUnEsc2: [ {{&HtmlString}} ] \n\
+ \"
+ context "Char" = MuVariable 'Й'
+ context "Double" = MuVariable (123.45 :: Double)
+ context "Int" = MuVariable (5 :: Int)
+ context "ByteString" = MuVariable (encodeStr "hello - привет")
+ context "Text" = MuVariable (T.pack "hello - привет")
+ context "String" = MuVariable "hello - привет"
+ context "HtmlString" = MuVariable "<p>text</p>"
+
+ testRes = "\
+ \ Char: [ Й ] \n\
+ \ Double: [ 123.45 ] \n\
+ \ Int: [ 5 ] \n\
+ \ ByteString: [ hello - привет ] \n\
+ \ Text: [ hello - привет ] \n\
+ \ String: [ hello - привет ] \n\
+ \ HtmlString: [ &lt;p&gt;text&lt;/p&gt; ] \n\
+ \ HtmlStringUnEsc: [ <p>text</p> ] \n\
+ \ HtmlStringUnEsc2: [ <p>text</p> ] \n\
+ \"
+
+-- Show/hide block according to list state
+emptyListSectionsTest = do
+ res <- hastacheStr defaultConfig (encodeStr template)
+ (mkStrContext context)
+ assertEqualStr "result correctness" (decodeStrLBS res) testRes
+ where
+ template = "\
+ \text 1\n\
+ \{{#blankSection}}\n\
+ \ some text\n\
+ \{{/blankSection}}\n\
+ \text 2\n\
+ \{{^blankSection}}\n\
+ \ empty list. {{someval}}\n\
+ \{{/blankSection}}\n\
+ \inline [{{#blankSection}}txt{{/blankSection}}]\n\
+ \"
+ context "blankSection" = MuList []
+ context "someval" = MuVariable (5 :: Int)
+
+ testRes = "\
+ \text 1\n\
+ \text 2\n\
+ \ empty list. 5\n\
+ \inline []\n\
+ \"
+
+-- Render list
+listSectionTest = do
+ res <- hastacheStr defaultConfig (encodeStr template)
+ (mkStrContext context)
+ assertEqualStr "result correctness" (decodeStrLBS res) testRes
+ where
+ template = "\
+ \text 1\n\
+ \{{#section}}\n\
+ \ * {{name}} \n\
+ \{{/section}}\n\
+ \text 2\n\
+ \inline {{#section}}[{{name}}]{{/section}}\n\
+ \"
+ context "section" = MuList $ map nameCtx ["Neo", "Morpheus", "Trinity"]
+ nameCtx name = mkStrContext (\"name" -> MuVariable name)
+
+ testRes = "\
+ \text 1\n\
+ \ * Neo \n\
+ \ * Morpheus \n\
+ \ * Trinity \n\
+ \text 2\n\
+ \inline [Neo][Morpheus][Trinity]\n\
+ \"
+
+-- Show/hide block according to boolean variable
+boolSectionTest = do
+ res <- hastacheStr defaultConfig (encodeStr template)
+ (mkStrContext context)
+ assertEqualStr "result correctness" (decodeStrLBS res) testRes
+ where
+ template = "\
+ \text 1\n\
+ \{{#bool_true}}\n\
+ \ true: {{someval}} \n\
+ \{{/bool_true}}\n\
+ \{{^bool_true}}\n\
+ \ true inv: {{someval}} \n\
+ \{{/bool_true}}\n\
+ \{{#bool_false}}\n\
+ \ false: {{someval}} \n\
+ \{{/bool_false}}\n\
+ \{{^bool_false}}\n\
+ \ false inv: {{someval}} \n\
+ \{{/bool_false}}\n\
+ \text 2\n\
+ \"
+ context "bool_true" = MuBool True
+ context "bool_false" = MuBool False
+ context "someval" = MuVariable "val"
+
+ testRes = "\
+ \text 1\n\
+ \ true: val \n\
+ \ false inv: val \n\
+ \text 2\n\
+ \"
+
+-- Transorm section
+lambdaSectionTest = do
+ res <- hastacheStr defaultConfig (encodeStr template)
+ (mkStrContext context)
+ assertEqualStr "result correctness" (decodeStrLBS res) testRes
+ where
+ template = "\
+ \text 1\n\
+ \{{#function}}Hello{{/function}}\n\
+ \text 2\n\
+ \"
+ context "function" = MuLambda BS.reverse
+
+ testRes = "\
+ \text 1\n\
+ \olleH\n\
+ \text 2\n\
+ \"
+
+-- Transform section with monadic function
+lambdaMSectionTest = do
+ (res, writerState) <- runWriterT monadicFunction
+ assertEqualStr "result correctness" (decodeStrLBS res) testRes
+ assertEqualStr "monad state correctness" (decodeStr writerState)
+ testMonad
+ where
+ monadicFunction = do
+ res <- hastacheStr defaultConfig (encodeStr template)
+ (mkStrContext context)
+ return res
+ template = "\
+ \[{{#mf}}abc{{/mf}}]\n\
+ \[{{#mf}}def{{/mf}}]\n\
+ \"
+ context "mf" = MuLambdaM $ \i -> do
+ tell i
+ return $ BS.reverse i
+ testRes = "\
+ \[cba]\n\
+ \[fed]\n\
+ \"
+ testMonad = "abcdef"
+
+-- Change delimiters
+setDelimiterTest = do
+ res <- hastacheStr defaultConfig (encodeStr template)
+ (mkStrContext context)
+ assertEqualStr "result correctness" (decodeStrLBS res) testRes
+ where
+ template = "\
+ \text 1\n\
+ \{{someVar}}\n\
+ \{{=<% %>=}}\n\
+ \<%someVar%>\n\
+ \<%={{ }}=%>\n\
+ \{{someVar}}\n\
+ \text 2\n\
+ \"
+ context "someVar" = MuVariable "some value"
+
+ testRes = "\
+ \text 1\n\
+ \some value\n\
+ \some value\n\
+ \some value\n\
+ \text 2\n\
+ \"
+
+-- Render external (partial) template file
+partialsTest = do
+ res <- hastacheStr defaultConfig (encodeStr template)
+ (mkStrContext context)
+ assertEqualStr "result correctness" (decodeStrLBS res) testRes
+ where
+ template = "\
+ \text 1\n\
+ \{{> partFile}}\n\
+ \text 2\n\
+ \"
+ context "name" = MuVariable "Neo"
+
+ testRes = "\
+ \text 1\n\
+ \Hi, Neo!\n\
+ \text 2\n\
+ \"
+
+data InternalData = InternalData {
+ intDataField1 :: String,
+ intDataField2 :: Int
+ }
+ deriving (Data, Typeable, Show)
+
+data SomeData = SomeData {
+ someDataField1 :: String,
+ someDataInternal :: InternalData,
+ someDataList :: [Int],
+ someDataObjList :: [InternalData]
+ }
+ deriving (Data, Typeable, Show)
+
+-- Make hastache context from Data.Data deriving type
+genericContextTest = do
+ res <- hastacheStr defaultConfig (encodeStr template)
+ (mkGenericContext context)
+ assertEqualStr "result correctness" (decodeStrLBS res) testRes
+ where
+ template = "\
+ \text 1\n\
+ \{{someDataField1}} {{someDataInternal.intDataField1}} \n\
+ \{{someDataInternal.intDataField2}} \n\
+ \Simple list:\n\
+ \{{#someDataList}}\n\
+ \* {{.}} \n\
+ \{{/someDataList}}\n\
+ \Obj list:\n\
+ \{{#someDataObjList}}\n\
+ \* {{intDataField1}} : {{intDataField2}} \n\
+ \{{/someDataObjList}}\n\
+ \text 2\n\
+ \"
+ context = SomeData {
+ someDataField1 = "aaa",
+ someDataInternal = InternalData {
+ intDataField1 = "zzz", intDataField2 = 100 },
+ someDataList = [1,2,3],
+ someDataObjList = [InternalData "a" 1, InternalData "b" 2,
+ InternalData "c" 3]
+ }
+
+ testRes = "\
+ \text 1\n\
+ \aaa zzz \n\
+ \100 \n\
+ \Simple list:\n\
+ \* 1 \n\
+ \* 2 \n\
+ \* 3 \n\
+ \Obj list:\n\
+ \* a : 1 \n\
+ \* b : 2 \n\
+ \* c : 3 \n\
+ \text 2\n\
+ \"
+
+tests = TestList [
+ TestLabel "Comments test" (TestCase commentsTest)
+ ,TestLabel "Variables test" (TestCase variablesTest)
+ ,TestLabel "Empty list test" (TestCase emptyListSectionsTest)
+ ,TestLabel "List test" (TestCase listSectionTest)
+ ,TestLabel "Bool test" (TestCase boolSectionTest)
+ ,TestLabel "Lambda test" (TestCase lambdaSectionTest)
+ ,TestLabel "LambdaM test" (TestCase lambdaMSectionTest)
+ ,TestLabel "Set delimiter test" (TestCase setDelimiterTest)
+ ,TestLabel "Partials test" (TestCase partialsTest)
+ ,TestLabel "Generic context test" (TestCase genericContextTest)
+ ]
+
+main = do
+ runTestTT tests
+
+assertEqualStr preface expected actual =
+ unless (actual == expected) (assertFailure msg)
+ where msg = (if null preface then "" else preface ++ "\n") ++
+ "expected: \n" ++ expected ++ "\nbut got: \n" ++ actual
+
Please sign in to comment.
Something went wrong with that request. Please try again.