hastache-0.6.1/0000755000000000000000000000000012446243210011462 5ustar0000000000000000hastache-0.6.1/ChangeLog0000644000000000000000000000206312446243210013235 0ustar0000000000000000# 0.6.1 - Fixing documentation typos - Implementing basic context merging (see ) - `mkGenericContext'` takes an additional `(String -> String)` argument which is applied to record field names, much like aeson's `fieldLabelModifier` - Removing unnecessary `utf8-string` dependency - Implementing the generic context creation for `Maybe` (see and `nestedPolyGenericContextTest` test), `Either`, `()`, and `Version`. - `mkReadme` is now officially an executable - Big change: custom extensions for generic contexts (should solve #30). See the documentation for `Text.Hastache.Context` and the `genericCustom.hs` example. - Making Hastache work with new base-4.8 (see #41) Thanks to: Tobias Florek, Edsko de Vries, Janne Hellsten, @clinty, Stefan Kersten, Herbert Valerio Riedel, and others # 0.6.0 - Switching from lazy ByteString to lazy Text - Support for multiple constructors in generic contexts (issue #16) - Additional `MuVar` instances (`Maybe`, `Either`, `()`) hastache-0.6.1/hastache.cabal0000644000000000000000000000311112446243210014222 0ustar0000000000000000name: hastache version: 0.6.1 license: BSD3 license-file: LICENSE category: Text copyright: Sergey S Lymar (c) 2011-2014 author: Sergey S Lymar maintainer: Daniil Frumin stability: experimental 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 (). . See homepage for examples of usage: extra-source-files: tests/partFile tests/RunTest.sh tests/test.hs README.md ChangeLog executable mkReadme main-is: mkReadme.hs build-depends: hastache, process, base >=4 && <4.9 ,bytestring ,mtl ,transformers ,directory ,filepath ,text ,containers ,syb ,blaze-builder ,ieee754 library exposed-modules: Text.Hastache Text.Hastache.Context build-depends: base >=4 && <4.9 ,bytestring ,mtl ,transformers ,directory ,filepath ,text ,containers ,syb ,blaze-builder ,ieee754 source-repository head type: git location: http://github.com/lymar/hastache test-suite test-hastache type: exitcode-stdio-1.0 main-is: test.hs hs-source-dirs: tests build-depends: hastache ,base >=4 && <4.9 ,directory ,mtl ,HUnit ,text ,bytestring ,syb hastache-0.6.1/LICENSE0000644000000000000000000000266712446243210012502 0ustar0000000000000000Copyright (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. hastache-0.6.1/mkReadme.hs0000644000000000000000000000275112446243210013550 0ustar0000000000000000#!/usr/local/bin/runhaskell import Text.Hastache import Text.Hastache.Context import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL import System.Process (readProcess) import System.Directory (setCurrentDirectory, getCurrentDirectory) import System.FilePath (()) import Data.List (span, lines, intersperse) import Data.Char (isSpace) main = do res <- hastacheFile defaultConfig "README.md.ha" (mkStrContext context) TL.writeFile "README.md" res where context "example" = MuLambdaM $ \fn -> do cd <- setExampleDir fc <- readFile $ exampleFile fn let { forTC = case span (\t -> trim t /= be) (lines $ trim fc) of (a,[]) -> a (_,a) -> drop 1 a } let explText = concat $ intersperse "\n" forTC setCurrentDirectory cd return $ concat [ "```haskell\n" , explText , "\n```" ] context "runExample" = MuLambdaM $ \fn -> do cd <- setExampleDir explRes <- readProcess "runhaskell" [exampleFile fn] [] setCurrentDirectory cd return $ concat [ "```\n" , trim explRes , "\n```" ] be = "-- begin example" setExampleDir = do cd <- getCurrentDirectory setCurrentDirectory $ cd "examples" return cd exampleFile fn = decodeStr fn ++ ".hs" trim :: String -> String trim = f . f where f = reverse . dropWhile isSpace hastache-0.6.1/README.md0000644000000000000000000002222112446243210012740 0ustar0000000000000000# Hastache Haskell implementation of [Mustache templates](http://mustache.github.com/) ## Installation cabal update cabal install hastache ## Usage Read [Mustache documentation](http://mustache.github.com/mustache.5.html) for template syntax. See [Hastache hackage page](http://hackage.haskell.org/package/hastache). ### Examples #### Variables ```haskell import Text.Hastache import Text.Hastache.Context import qualified Data.Text.Lazy.IO as TL main = hastacheStr defaultConfig (encodeStr template) (mkStrContext context) >>= TL.putStrLn template = "Hello, {{name}}!\n\nYou have {{unread}} unread messages." context "name" = MuVariable "Haskell" context "unread" = MuVariable (100 :: Int) ``` ``` Hello, Haskell! You have 100 unread messages. ``` With Generics ```haskell {-# LANGUAGE DeriveDataTypeable #-} import Text.Hastache import Text.Hastache.Context import qualified Data.Text.Lazy.IO as TL import Data.Data import Data.Generics main = hastacheStr defaultConfig (encodeStr template) context >>= TL.putStrLn data Info = Info { name :: String, unread :: Int } deriving (Data, Typeable) template = "Hello, {{name}}!\n\nYou have {{unread}} unread messages." context = mkGenericContext $ Info "Haskell" 100 ``` #### Lists ```haskell template = concat [ "{{#heroes}}\n", "* {{name}} \n", "{{/heroes}}\n"] context "heroes" = MuList $ map (mkStrContext . mkListContext) ["Nameless","Long Sky","Flying Snow","Broken Sword","Qin Shi Huang"] where mkListContext name = \"name" -> MuVariable name ``` ``` * Nameless * Long Sky * Flying Snow * Broken Sword * Qin Shi Huang ``` With Generics ```haskell data Hero = Hero { name :: String } deriving (Data, Typeable) data Heroes = Heroes { heroes :: [Hero] } deriving (Data, Typeable) template = concat [ "{{#heroes}}\n", "* {{name}} \n", "{{/heroes}}\n"] context = mkGenericContext $ Heroes $ map Hero ["Nameless","Long Sky", "Flying Snow","Broken Sword","Qin Shi Huang"] ``` Another Generics version ```haskell data Heroes = Heroes { heroes :: [String] } deriving (Data, Typeable) template = concat [ "{{#heroes}}\n", "* {{.}} \n", "{{/heroes}}\n"] context = mkGenericContext $ Heroes ["Nameless","Long Sky","Flying Snow", "Broken Sword","Qin Shi Huang"] ``` List item by index ```haskell main = mapM_ (\(template,context) -> hastacheStr defaultConfig (encodeStr template) context >>= TL.putStrLn) [(template1, mkStrContext context1), (template1, context2), (template3, context3)] names = ["Nameless","Long Sky","Flying Snow","Broken Sword","Qin Shi Huang"] template1 = concat [ "{{heroes.1.name}}\n", "{{heroes.0.name}}\n"] -- Context as function context1 "heroes" = MuList $ map (mkStrContext . mkListContext) names where mkListContext name = \"name" -> MuVariable name context1 _ = MuNothing -- With Generics data Hero = Hero { name :: String } deriving (Data, Typeable) data Heroes = Heroes { heroes :: [Hero] } deriving (Data, Typeable) context2 = mkGenericContext $ Heroes $ map Hero names -- With Generics (another way) template3 = concat [ "{{heroName.3}}\n", "{{heroName.2}}\n"] data HeroesStr = HeroesStr { heroName :: [String] } deriving (Data, Typeable) context3 = mkGenericContext $ HeroesStr names ``` ``` Long Sky Nameless Long Sky Nameless Broken Sword Flying Snow ``` #### Conditional evaluation Boolean ```haskell template = "{{#boolean}}true{{/boolean}}{{^boolean}}false{{/boolean}}" context "boolean" = MuBool False ``` ``` false ``` List ```haskell template = "{{^messages}}No new messages{{/messages}}" context "messages" = MuList [] ``` ``` No new messages ``` Number ```haskell main = mapM_ (\ctx -> hastacheStr defaultConfig (encodeStr template) (mkStrContext ctx) >>= TL.putStrLn) [context1,context2] template = "{{#msg}}{{msg}}{{/msg}}{{^msg}}No{{/msg}} new messages." context1 "msg" = MuVariable (100 :: Int) context2 "msg" = MuVariable (0 :: Int) ``` ``` 100 new messages. No new messages. ``` Multiple constructors (in generic context) ```haskell #!/usr/local/bin/runhaskell -- | Multiple constructors in generic contexts {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} import Data.Data import Data.Monoid import Data.Typeable () import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL import Text.Hastache import Text.Hastache.Context data Hero = SuperHero { name :: String , powers :: [String] , companion :: String } | EvilHero { name :: String , minion :: String } deriving (Show, Data, Typeable) template :: String template = mconcat [ "{{#SuperHero}}\n", "Hero: {{name}}\n", " * Powers: {{#powers}}\n", "\n - {{.}}{{/powers}} \n", " * Companion: {{companion}}\n", "{{/SuperHero}}\n", "{{#EvilHero}}\n", "Evil hero: {{name}}\n", " * Minion: {{minion}}\n", "{{/EvilHero}}"] render :: Hero -> IO TL.Text render = hastacheStr defaultConfig (encodeStr template) . mkGenericContext main :: IO () main = do let batman = SuperHero "Batman" ["ht","ht"] "Robin" let doctorEvil = EvilHero "Doctor Evil" "Mini-Me" render batman >>= TL.putStrLn render doctorEvil >>= TL.putStrLn ``` ``` Hero: Batman * Powers: - ht - ht * Companion: Robin Evil hero: Doctor Evil * Minion: Mini-Me ``` #### Functions ```haskell template = "Hello, {{#reverse}}world{{/reverse}}!" context "reverse" = MuLambda (reverse . decodeStr) ``` ``` Hello, dlrow! ``` #### Monadic functions ```haskell {-# LANGUAGE FlexibleContexts #-} import Text.Hastache import Text.Hastache.Context import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL import Control.Monad.State main = run >>= TL.putStrLn run = evalStateT stateFunc "" stateFunc :: StateT String IO TL.Text stateFunc = hastacheStr defaultConfig (encodeStr template) (mkStrContext context) template = "{{#arg}}aaa{{/arg}} {{#arg}}bbb{{/arg}} {{#arg}}ccc{{/arg}}" context "arg" = MuLambdaM $ arg . decodeStr arg :: MonadState String m => String -> m String arg a = do v <- get let nv = v ++ a put nv return nv ``` ``` aaa aaabbb aaabbbccc ``` #### Custom queries and field renaming ```haskell {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeSynonymInstances #-} -- Custom extension function for types that are not supported out of -- the box in generic contexts import Text.Hastache import Text.Hastache.Context import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL import Data.Data (Data, Typeable) import Data.Decimal import Data.Generics.Aliases (extQ) data DecimalOrInf = Inf | Dec Decimal deriving (Data, Typeable) deriving instance Data Decimal data Test = Test {n::Int, m::DecimalOrInf} deriving (Data, Typeable) val1 :: Test val1 = Test 1 (Dec $ Decimal 3 1500) val2 :: Test val2 = Test 2 Inf query :: Ext query = defaultExt `extQ` f where f Inf = "+inf" f (Dec i) = show i r "m" = "moo" r x = x example :: Test -> IO TL.Text example v = hastacheStr defaultConfig (encodeStr template) (mkGenericContext' r query v) template = concat [ "An int: {{n}}\n", "{{#moo.Dec}}A decimal number: {{moo.Dec}}{{/moo.Dec}}", "{{#moo.Inf}}An infinity: {{moo.Inf}}{{/moo.Inf}}" ] main = do example val1 >>= TL.putStrLn example val2 >>= TL.putStrLn ``` ``` An int: 1 A decimal number: 1.500 An int: 2 An infinity: +inf ``` #### Generics big example ```haskell data Book = Book { title :: String, publicationYear :: Integer } deriving (Data, Typeable) data Life = Life { born :: Integer, died :: Integer } deriving (Data, Typeable) data Writer = Writer { name :: String, life :: Life, books :: [Book] } deriving (Data, Typeable) template = concat [ "Name: {{name}} ({{life.born}} - {{life.died}})\n", "{{#life}}\n", "Born: {{born}}\n", "Died: {{died}}\n", "{{/life}}\n", "Bibliography:\n", "{{#books}}\n", " {{title}} ({{publicationYear}})\n", "{{/books}}\n" ] context = mkGenericContext Writer { name = "Mikhail Bulgakov", life = Life 1891 1940, books = [ Book "Heart of a Dog" 1987, Book "Notes of a country doctor" 1926, Book "The Master and Margarita" 1967] } ``` ``` Name: Mikhail Bulgakov (1891 - 1940) Born: 1891 Died: 1940 Bibliography: Heart of a Dog (1987) Notes of a country doctor (1926) The Master and Margarita (1967) ``` #### More examples * [Hastache test](https://github.com/lymar/hastache/blob/master/tests/test.hs) * Real world example: [README.md file generator](https://github.com/lymar/hastache/blob/master/mkReadme.hs) * [examples/ directory](https://github.com/lymar/hastache/tree/master/examples)hastache-0.6.1/Setup.hs0000644000000000000000000000011312446243210013111 0ustar0000000000000000#! /usr/bin/env runhaskell import Distribution.Simple main = defaultMain hastache-0.6.1/tests/0000755000000000000000000000000012446243210012624 5ustar0000000000000000hastache-0.6.1/tests/partFile0000644000000000000000000000001612446243210014312 0ustar0000000000000000Hi, {{name}}! hastache-0.6.1/tests/RunTest.sh0000755000000000000000000000003212446243210014562 0ustar0000000000000000runhaskell -i.. test.hs hastache-0.6.1/tests/test.hs0000644000000000000000000004600612446243210014145 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Main where import Control.Monad import Control.Monad.Error import Control.Monad.Writer import Data.Char import Data.Data import Data.Generics import System.Directory import System.Exit 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 qualified Data.Text.Lazy as TL resCorrectness = "result correctness" -- Hastache comments commentsTest = do res <- hastacheStr defaultConfig (encodeStr template) undefined assertEqualStr resCorrectness (decodeStrLT 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 resCorrectness (decodeStrLT 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 "

text (\\)

" testRes = "\ \ Char: [ Й ] \n\ \ Double: [ 123.45 ] \n\ \ Int: [ 5 ] \n\ \ ByteString: [ hello - привет ] \n\ \ Text: [ hello - привет ] \n\ \ String: [ hello - привет ] \n\ \ HtmlString: [ <p>text (\)</p> ] \n\ \ HtmlStringUnEsc: [

text (\\)

] \n\ \ HtmlStringUnEsc2: [

text (\\)

] \n\ \" -- Show/hide sections showHideSectionsTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context) assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \no context : {{^noCtx}}Should render{{/noCtx}}\n\ \text 1\n\ \{{#emptyList}}\n\ \ some text\n\ \{{/emptyList}}\n\ \text 2\n\ \{{^emptyList}}\n\ \ empty list. {{someval}}\n\ \{{/emptyList}}\n\ \inline [{{#emptyList}}txt{{/emptyList}}]\n\ \{{#emptyString}}no {{someval}}{{/emptyString}}\ \{{^emptyString}}yes {{someval}}{{/emptyString}}\n\ \{{#emptyInt}}no {{emptyInt}}{{/emptyInt}}\ \{{^emptyInt}}yes {{emptyInt}}{{/emptyInt}}\n\ \{{#emptyDouble}}no {{emptyDouble}}{{/emptyDouble}}\ \{{^emptyDouble}}yes {{emptyDouble}}{{/emptyDouble}}\n\ \{{#nonEmptyString}}yes {{nonEmptyString}}{{/nonEmptyString}}\ \{{^nonEmptyString}}no{{/nonEmptyString}}\n\ \{{#nonEmptyInt}}yes {{nonEmptyInt}}{{/nonEmptyInt}}\ \{{^nonEmptyInt}}no{{/nonEmptyInt}}\n\ \{{#nonEmptyDouble}}yes {{nonEmptyDouble}}{{/nonEmptyDouble}}\ \{{^nonEmptyDouble}}no{{/nonEmptyDouble}}\n\ \" context "noCtx" = MuNothing context "emptyList" = MuList [] context "someval" = MuVariable (5 :: Int) context "emptyString" = MuVariable "" context "emptyInt" = MuVariable (0 :: Int) context "emptyDouble" = MuVariable (0 :: Double) context "nonEmptyString" = MuVariable "some" context "nonEmptyInt" = MuVariable (1 :: Int) context "nonEmptyDouble" = MuVariable (1 :: Double) testRes = "\ \no context : Should render\n\ \text 1\n\ \text 2\n\ \ empty list. 5\n\ \inline []\n\ \yes 5\n\ \yes 0\n\ \yes 0.0\n\ \yes some\n\ \yes 1\n\ \yes 1.0\n\ \" -- Render list listSectionTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context) assertEqualStr resCorrectness (decodeStrLT 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 resCorrectness (decodeStrLT 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 resCorrectness (decodeStrLT res) testRes where template = "\ \text 1\n\ \{{#function}}Hello{{/function}}\n\ \text 2\n\ \" context "function" = MuLambda T.reverse testRes = "\ \text 1\n\ \olleH\n\ \text 2\n\ \" -- Transform section with monadic function lambdaMSectionTest = do (res, writerState) <- runWriterT monadicFunction assertEqualStr resCorrectness (decodeStrLT res) testRes assertEqualStr "monad state correctness" (decodeStr writerState) testMonad where monadicFunction = hastacheStr defaultConfig (encodeStr template) (mkStrContext context) template = "\ \[{{#mf}}abc{{/mf}}]\n\ \[{{#mf}}def{{/mf}}]\n\ \" context "mf" = MuLambdaM $ \i -> do tell i return $ T.reverse i testRes = "\ \[cba]\n\ \[fed]\n\ \" testMonad = "abcdef" -- Monadic context function monadicContextTest = do r <- runErrorT $ hastacheStr defaultConfig (encodeStr template) (mkStrContextM context) let { res = case r of Left err -> "error: " ++ err Right res -> decodeStrLT res } assertEqualStr resCorrectness res testRes where template = "Hello, {{name}}! You have {{unread}} unread messages. {{some}}" context "name" = return $ MuVariable "Haskell" context "unread" = return $ MuVariable (100 :: Int) context var = throwError $ "{{" ++ var ++ "}} not found!" testRes = "error: {{some}} not found!" -- Change delimiters setDelimiterTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context) assertEqualStr resCorrectness (decodeStrLT 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 resCorrectness (decodeStrLT 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) data SomeData = SomeData { someDataField1 :: String, someDataInternal :: InternalData, someDataList :: [Int], someDataObjList :: [InternalData], someMuLambdaBS :: BS.ByteString -> BS.ByteString, someMuLambdaS :: String -> String, someMuLambdaMBS :: BS.ByteString -> IO BS.ByteString, someMuLambdaMS :: String -> IO String, someEitherValue :: Either String Int } deriving (Data, Typeable) -- Make hastache context from Data.Data deriving type genericContextTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkGenericContext context) assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \text 1\n\ \{{someDataField1}} {{someDataInternal.intDataField1}} \n\ \{{someDataInternal.intDataField2}} \n\ \{{#someDataInternal}}\n\ \* {{intDataField1}} {{intDataField2}} \n\ \{{/someDataInternal}}\n\ \Simple list:\n\ \{{#someDataList}}\n\ \* {{.}} \n\ \{{/someDataList}}\n\ \List item by index: {{someDataList.1}} \n\ \Obj list:\n\ \{{#someDataObjList}}\n\ \* {{intDataField1}} : {{intDataField2}} \n\ \{{/someDataObjList}}\n\ \{{#someMuLambdaBS}}reverse{{/someMuLambdaBS}}\n\ \{{#someMuLambdaS}}upper{{/someMuLambdaS}}\n\ \{{#someMuLambdaMBS}}reverse in IO lambda{{/someMuLambdaMBS}}\n\ \{{#someMuLambdaMS}}upper in IO lambda{{/someMuLambdaMS}}\n\ \{{someEitherValue}}\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], someMuLambdaBS = BS.reverse, someMuLambdaS = map toUpper, someMuLambdaMBS = return . BS.reverse, someMuLambdaMS = return . map toUpper, someEitherValue = Right 123 } testRes = "\ \text 1\n\ \aaa zzz \n\ \100 \n\ \* zzz 100 \n\ \Simple list:\n\ \* 1 \n\ \* 2 \n\ \* 3 \n\ \List item by index: 2 \n\ \Obj list:\n\ \* a : 1 \n\ \* b : 2 \n\ \* c : 3 \n\ \esrever\n\ \UPPER\n\ \adbmal OI ni esrever\n\ \UPPER IN IO LAMBDA\n\ \123\n\ \text 2\n\ \" -- Up-level context from nested block nestedContextTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context) assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \{{top}}\n\ \{{#section}}\n\ \ * {{val}}. {{top}}\n\ \{{/section}}\n\ \" context "section" = MuList $ map elemCtx ["elem 1", "elem 2"] context "top" = MuVariable "top" elemCtx vl = mkStrContext (\v -> case v of "val" -> MuVariable vl _ -> MuNothing ) testRes = "\ \top\n\ \ * elem 1. top\n\ \ * elem 2. top\n\ \" -- Up-level context from nested block (Generic version) data TopData = TopData { topDataTop :: String, topDataItems :: [NestedData] } deriving (Data, Typeable) data NestedData = NestedData { nestedDataNested :: String } deriving (Data, Typeable) nestedGenericContextTest = do res <- hastacheStr defaultConfig (encodeStr template) context assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \Top variable : {{topDataTop}}\n\ \{{#topDataItems}}\n\ \-- Nested section\n\ \Top variable : {{topDataTop}}\n\ \Nested variable : {{nestedDataNested}}\n\ \{{/topDataItems}}\n\ \" context = mkGenericContext $ TopData { topDataTop = "TOP", topDataItems = [ NestedData "NESTED_ONE", NestedData "NESTED_TWO"] } testRes = "\ \Top variable : TOP\n\ \-- Nested section\n\ \Top variable : TOP\n\ \Nested variable : NESTED_ONE\n\ \-- Nested section\n\ \Top variable : TOP\n\ \Nested variable : NESTED_TWO\n\ \" -- Nested generic context with polymorphic datatypes data Person = Person { personName :: String } deriving (Data, Typeable) data Info = Info { person :: Maybe Person } deriving (Data, Typeable) data Infos = Infos { infos :: [Info] } deriving (Data, Typeable) nestedPolyGenericContextTest = do res <- hastacheStr defaultConfig (encodeStr template) context assertEqualStr resCorrectness (decodeStrLT res) testRes where datum = Infos [Info Nothing, Info $ Just $ Person "Dude", Info $ Just $ Person "Dude2"] template = "Greetings: {{#infos}}{{#person}}Hello, {{personName}}!\n{{/person}}{{/infos}}" context = mkGenericContext datum testRes = "Greetings: Hello, Dude!\nHello, Dude2!\n" -- Generic context with custom extension data MyData = MyData Int deriving (Data, Typeable) data TestInfo = TestInfo {n::Int,m::MyData} deriving (Data, Typeable) testExt :: Ext testExt = defaultExt `extQ` (\(MyData i) -> "Data " ++ show i) genericExtTest = do res <- hastacheStr defaultConfig (encodeStr template) context assertEqualStr resCorrectness (decodeStrLT res) testRes where datum = TestInfo 1 (MyData 0) template = "{{n}}\n{{m.MyData}}" context = mkGenericContext' id testExt datum testRes = "1\nData 0" -- Accessing array item by index arrayItemsTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context) assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \{{section.0.name}} {{section.1.name}} {{section.2.name}}\n\ \{{#flags.0.val}}yes{{/flags.0.val}}\n\ \{{^flags.1.val}}no{{/flags.0.val}}\n\ \" context "section" = MuList $ map nameCtx ["Neo", "Morpheus", "Trinity"] context "flags" = MuList $ map flagCtx [True, False] context n = MuNothing nameCtx name = mkStrContext (\"name" -> MuVariable name) flagCtx val = mkStrContext (\"val" -> MuBool val) testRes = "\ \Neo Morpheus Trinity\n\ \yes\n\ \no\n\ \" -- Accessing array item by index (generic version) data ArrayItemTest_Item = ArrayItemTest_Item { name :: String } deriving (Data, Typeable) data ArrayItemTest_Container = ArrayItemTest_Container { items :: [ArrayItemTest_Item], itemsStr :: [String] } deriving (Data, Typeable) arrayItemsTestGeneric = do res <- hastacheStr defaultConfig (encodeStr template) context assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \{{items.0.name}} {{items.2.name}}\n\ \{{itemsStr.0}} {{itemsStr.1}}\n\ \" context = mkGenericContext $ ArrayItemTest_Container { items = [ArrayItemTest_Item "Bob", ArrayItemTest_Item "Alice", ArrayItemTest_Item "Zoe"], itemsStr = ["Bob", "Alice", "Zoe"] } testRes = "\ \Bob Zoe\n\ \Bob Alice\n\ \" -- Multiple constructors in generic contexts data Hero = Good { goodness :: Int } | Evil { evilness :: Int } deriving (Data, Typeable) data Heroes = Heroes { heroes :: [Hero] } deriving (Data, Typeable) multipleConstrTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkGenericContext context) assertEqualStr resCorrectness (decodeStrLT res) testRes where context = Heroes [Good 4, Evil 2] template = "\ \{{#heroes}}\ \{{#Good}}{{goodness}}{{/Good}}\ \{{#Evil}}{{evilness}}{{/Evil}}\ \{{/heroes}}\ \" testRes = "42" -- Context composition compositionTest = do res <- hastacheStr defaultConfig (encodeStr template) $ mkGenericContext context `composeCtx` mempty `composeCtx` mkStrContext context2 assertEqualStr resCorrectness (decodeStrLT res) testRes where context = Heroes [Good 4, Evil 2] context2 "Ugly" = MuVariable (3::Int) context2 _ = MuNothing template = "\ \{{#heroes}}\ \{{#Good}}{{goodness}}{{/Good}}\ \{{#Evil}}{{evilness}}{{/Evil}}\ \{{#Ugly}}{{Ugly}}{{/Ugly}}\ \{{/heroes}}\ \" testRes = "4323" tests = TestList [ TestLabel "Comments test" (TestCase commentsTest) , TestLabel "Variables test" (TestCase variablesTest) , TestLabel "Show/hide sections test" (TestCase showHideSectionsTest) , TestLabel "List test" (TestCase listSectionTest) , TestLabel "Bool test" (TestCase boolSectionTest) , TestLabel "Lambda test" (TestCase lambdaSectionTest) , TestLabel "LambdaM test" (TestCase lambdaMSectionTest) , TestLabel "Monadic context test" (TestCase monadicContextTest) , TestLabel "Set delimiter test" (TestCase setDelimiterTest) , TestLabel "Partials test" (TestCase partialsTest) , TestLabel "Generic context test" (TestCase genericContextTest) , TestLabel "Multiple constructors in a generic context" (TestCase multipleConstrTest) , TestLabel "Nested context test" (TestCase nestedContextTest) , TestLabel "Nested generic context test" (TestCase nestedGenericContextTest) , TestLabel "Nested generic context with polymorphic datatypes test" (TestCase nestedPolyGenericContextTest) , TestLabel "Accessing array item by index" (TestCase arrayItemsTest) , TestLabel "Accessing array item by index (generic version)" (TestCase arrayItemsTestGeneric) , TestLabel "Composing contexts" (TestCase compositionTest) , TestLabel "Generic contexts with custom extensions" (TestCase genericExtTest) ] main = do setCurrentDirectory "./tests/" trs <- runTestTT tests if (errors trs /= 0) || (failures trs /= 0) then exitFailure else exitSuccess assertEqualStr preface actual expected = unless (actual == expected) (assertFailure msg) where msg = (if null preface then "" else preface ++ "\n") ++ "expected: \n" ++ expected ++ "\nbut got: \n" ++ actual hastache-0.6.1/Text/0000755000000000000000000000000012446243210012406 5ustar0000000000000000hastache-0.6.1/Text/Hastache.hs0000644000000000000000000004410412446243210014465 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification, FlexibleInstances, IncoherentInstances, OverloadedStrings #-} -- Module: Text.Hastache -- Copyright: Sergey S Lymar (c) 2011-2013 -- License: BSD3 -- Maintainer: Sergey S Lymar -- Stability: experimental -- Portability: portable -- -- Haskell implementation of Mustache templates {- | Haskell implementation of Mustache templates See homepage for examples of usage: Simplest example: @ import Text.Hastache import Text.Hastache.Context import qualified Data.Text.Lazy.IO as TL main = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context) TL.putStrLn res where template = \"Hello, {{name}}!\\n\\nYou have {{unread}} unread messages.\" context \"name\" = MuVariable \"Haskell\" context \"unread\" = MuVariable (100 :: Int) @ Result: @ Hello, Haskell! You have 100 unread messages. @ Using Generics: @ {-\# LANGUAGE DeriveDataTypeable, OverloadedStrings \#-} import Text.Hastache import Text.Hastache.Context import qualified Data.Text.Lazy.IO as TL import Data.Data data Info = Info { name :: String, unread :: Int } deriving (Data, Typeable) main = do res <- hastacheStr defaultConfig template (mkGenericContext inf) TL.putStrLn res where template = \"Hello, {{name}}!\\n\\nYou have {{unread}} unread messages.\" inf = Info \"Haskell\" 100 @ -} module Text.Hastache ( hastacheStr , hastacheFile , hastacheStrBuilder , hastacheFileBuilder , MuContext , MuType(..) , MuConfig(..) , MuVar(..) , composeCtx , htmlEscape , emptyEscape , defaultConfig , encodeStr , encodeStrLT , decodeStr , decodeStrLT ) where import Control.Monad (guard, mplus, mzero, liftM ) import Control.Monad.Reader (ask, runReaderT, MonadReader, ReaderT) import Control.Monad.Trans (lift, liftIO, MonadIO) import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT) import Data.AEq (AEq,(~==)) import Data.Functor ((<$>)) import Data.IORef import Data.Int import Data.Maybe (isJust) import Data.Monoid (Monoid, mappend, mempty) import Data.Text hiding (map, foldl1) import Data.Text.IO import Data.Version (Version) import Data.Word import Prelude hiding (putStrLn, readFile, length, drop, tail, dropWhile, elem, head, last, reverse, take, span, null) import System.Directory (doesFileExist) import System.FilePath (combine) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LZ import qualified Data.List as List import qualified Data.Text as T import qualified Data.Text.Read as T import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Text.Lazy.Encoding as TL import qualified Data.Foldable as F import qualified Prelude (~>) :: a -> (a -> b) -> b x ~> f = f x infixl 9 ~> -- | Data for Hastache variable type MuContext m = Text -- ^ Variable name -> m (MuType m) -- ^ Value instance (Monad m) => Monoid (MuContext m) where mempty = const $ return MuNothing a `mappend` b = \v -> do x <- a v case x of MuNothing -> b v _ -> return x -- | Left-leaning compoistion of contexts. Given contexts @c1@ and -- @c2@, the behaviour of @(c1 <> c2) x@ is following: if @c1 x@ -- produces 'MuNothing', then the result is @c2 x@. Otherwise the -- result is @c1 x@. Even if @c1 x@ is 'MuNothing', the monadic -- effects of @c1@ are still to take place. composeCtx :: (Monad m) => MuContext m -> MuContext m -> MuContext m composeCtx = mappend class Show a => MuVar a where -- | Convert to lazy 'Data.Text.Lazy.Text' toLText :: a -> TL.Text -- | Is empty variable (empty string, zero number etc.) isEmpty :: a -> Bool isEmpty _ = False instance MuVar Text where toLText = TL.fromStrict isEmpty = T.null instance MuVar TL.Text where toLText = id isEmpty a = TL.length a == 0 instance MuVar BS.ByteString where toLText = TL.fromStrict . T.decodeUtf8 isEmpty a = BS.length a == 0 instance MuVar LZ.ByteString where toLText = TL.decodeUtf8 isEmpty a = LZ.length a == 0 withShowToText :: Show a => a -> TL.Text withShowToText a = show a ~> TL.pack numEmpty :: (Num a,AEq a) => a -> Bool numEmpty a = a ~== 0 instance MuVar Integer where {toLText = withShowToText; isEmpty = numEmpty} instance MuVar Int where {toLText = withShowToText; isEmpty = numEmpty} instance MuVar Float where {toLText = withShowToText; isEmpty = numEmpty} instance MuVar Double where {toLText = withShowToText; isEmpty = numEmpty} instance MuVar Int8 where {toLText = withShowToText; isEmpty = numEmpty} instance MuVar Int16 where {toLText = withShowToText; isEmpty = numEmpty} instance MuVar Int32 where {toLText = withShowToText; isEmpty = numEmpty} instance MuVar Int64 where {toLText = withShowToText; isEmpty = numEmpty} instance MuVar Word where {toLText = withShowToText; isEmpty = numEmpty} instance MuVar Word8 where {toLText = withShowToText; isEmpty = numEmpty} instance MuVar Word16 where {toLText = withShowToText; isEmpty = numEmpty} instance MuVar Word32 where {toLText = withShowToText; isEmpty = numEmpty} instance MuVar Word64 where {toLText = withShowToText; isEmpty = numEmpty} instance MuVar () where {toLText = withShowToText} instance MuVar Version where {toLText = withShowToText } instance MuVar Char where toLText = TL.singleton instance MuVar a => MuVar [a] where toLText a = toLText '[' <+> cnvLst <+> toLText ']' where cnvLst = map toLText a ~> TL.intercalate (toLText ',') (<+>) = TL.append instance MuVar a => MuVar (Maybe a) where toLText (Just a) = toLText a toLText Nothing = "" isEmpty Nothing = True isEmpty (Just a) = isEmpty a instance (MuVar a, MuVar b) => MuVar (Either a b) where toLText (Left a) = toLText a toLText (Right b) = toLText b isEmpty (Left a) = isEmpty a isEmpty (Right b) = isEmpty b instance MuVar [Char] where toLText = TL.pack isEmpty a = Prelude.length a == 0 data MuType m = forall a. MuVar a => MuVariable a | MuList [MuContext m] | MuBool Bool | forall a. MuVar a => MuLambda (Text -> a) | forall a. MuVar a => MuLambdaM (Text -> m a) | MuNothing 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 <..>" show MuNothing = "MuNothing" data MuConfig m = MuConfig { muEscapeFunc :: TL.Text -> TL.Text, -- ^ Escape function ('htmlEscape', 'emptyEscape' etc.) muTemplateFileDir :: Maybe FilePath, -- ^ Directory for search partial templates (@{{> templateName}}@) muTemplateFileExt :: Maybe String, -- ^ Partial template files extension muTemplateRead :: FilePath -> m (Maybe Text) -- ^ Template retrieval function. 'Nothing' indicates that the -- template could not be found. } -- | Convert 'String' to 'Text' encodeStr :: String -> Text encodeStr = T.pack -- | Convert 'String' to Lazy 'Data.Text.Lazy.Text' encodeStrLT :: String -> TL.Text encodeStrLT = TL.pack -- | Convert 'Text' to 'String' decodeStr :: Text -> String decodeStr = T.unpack -- | Convert Lazy 'Data.Text.Lazy.Text' to 'String' decodeStrLT :: TL.Text -> String decodeStrLT = TL.unpack -- | isMuNothing x = x == MuNothing isMuNothing :: MuType t -> Bool isMuNothing MuNothing = True isMuNothing _ = False -- | Escape HTML symbols htmlEscape :: TL.Text -> TL.Text htmlEscape = TL.concatMap proc where proc '&' = "&" proc '\\' = "\" proc '"' = """ proc '\'' = "'" proc '<' = "<" proc '>' = ">" proc h = TL.singleton h -- | No escape emptyEscape :: TL.Text -> TL.Text emptyEscape = id {- | Default config: HTML escape function, current directory as template directory, template file extension not specified -} defaultConfig :: MonadIO m => MuConfig m defaultConfig = MuConfig { muEscapeFunc = htmlEscape, muTemplateFileDir = Nothing, muTemplateFileExt = Nothing, muTemplateRead = liftIO . defaultTemplateRead } defaultTemplateRead :: FilePath -> IO (Maybe Text) defaultTemplateRead fullFileName = do fe <- doesFileExist fullFileName if fe then Just <$> readFile fullFileName else return Nothing defOTag = "{{" :: Text defCTag = "}}" :: Text unquoteCTag = "}}}" :: Text findBlock :: Text -> Text -> Text -> Maybe (Text, Char, Text, Text) findBlock str otag ctag = do guard (length fnd > length otag) Just (pre, symb, inTag, afterClose) where (pre, fnd) = breakOn otag str symb = index fnd (length otag) (inTag, afterClose) -- test for unescape ( {{{some}}} ) | symb == '{' && ctag == defCTag = breakOn unquoteCTag fnd ~> \(a,b) -> (drop (length otag) a, drop 3 b) | otherwise = breakOn ctag fnd ~> \(a,b) -> (drop (length otag) a, drop (length ctag) b) readVar :: MonadIO m => [MuContext m] -> Text -> m TL.Text readVar [] _ = return TL.empty readVar (context:parentCtx) name = do muType <- context name case muType of MuVariable a -> return $ toLText a MuBool a -> return . withShowToText $ a MuNothing -> do mb <- runMaybeT $ tryFindArrayItem context name case mb of Just (nctx,nn) -> readVar [nctx] nn _ -> readVar parentCtx name _ -> return TL.empty readInt :: Text -> Maybe (Int,Text) readInt t = eitherMaybe $ T.decimal t where eitherMaybe (Left _) = Nothing eitherMaybe (Right x) = Just x tryFindArrayItem :: MonadIO m => MuContext m -> Text -> MaybeT m (MuContext m, Text) tryFindArrayItem context name = do guard $ length idx > 1 (idx,nxt) <- MaybeT $ return $ readInt $ tail idx guard $ idx >= 0 guard $ (null nxt) || (head nxt == '.') muType <- lift $ context nm case muType of MuList l -> do guard $ idx < (List.length l) let ncxt = l !! idx if null nxt then return (ncxt, dotStr) -- {{some.0}} else return (ncxt, tail nxt) -- {{some.0.field}} _ -> mzero where (nm,idx) = breakOn dotStr name dotStr = "." findCloseSection :: Text -> Text -> Text -> Text -> Maybe (Text, Text) findCloseSection str name otag ctag = do guard (length after > 0) Just (before, drop (length close) after) where close = foldl1 append [otag, "/", name, ctag] (before, after) = breakOn close str trimCharsTest :: Char -> Bool trimCharsTest = (`Prelude.elem` [' ', '\t']) trimAll :: Text -> Text trimAll = dropAround trimCharsTest addRes :: MonadIO m => (Either T.Text TL.Text) -> ReaderT (IORef TLB.Builder) m () addRes str = do rf <- ask b <- readIORef rf ~> liftIO let l = mappend b t writeIORef rf l ~> liftIO return () where t = either TLB.fromText TLB.fromLazyText str addResT :: MonadIO m => T.Text -> ReaderT (IORef TLB.Builder) m () addResT = addRes . Left addResTL :: MonadIO m => TL.Text -> ReaderT (IORef TLB.Builder) m () addResTL = addRes . Right processBlock :: MonadIO m => Text -> [MuContext m] -> Text -> Text -> MuConfig m -> ReaderT (IORef TLB.Builder) m () processBlock str contexts otag ctag conf = case findBlock str otag ctag of Just (pre, symb, inTag, afterClose) -> do addResT pre renderBlock contexts symb inTag afterClose otag ctag conf Nothing -> do addResT str return () elem :: Char -> Text -> Bool elem c = isJust . find (==c) renderBlock :: MonadIO m => [MuContext m] -> Char -> Text -> Text -> Text -> Text -> MuConfig m -> ReaderT (IORef TLB.Builder) m () renderBlock contexts symb inTag afterClose otag ctag conf -- comment | symb == '!' = next afterClose -- unescape variable | symb == '&' || (symb == '{' && otag == defOTag) = do addResTL =<< lift (readVar contexts (tail inTag ~> trimAll)) next afterClose -- section, inverted section | symb == '#' || symb == '^' = case findCloseSection afterClose (tail inTag) otag ctag of Nothing -> next afterClose Just (sectionContent', afterSection') -> let dropNL str = if length str > 0 && head str == '\n' then tail str else str sectionContent = dropNL sectionContent' afterSection = if '\n' `elem` sectionContent then dropNL afterSection' else afterSection' tlInTag = tail inTag readContext' = MaybeT $ liftM (List.find (not . isMuNothing)) $ mapM ($ tlInTag) contexts readContextWithIdx = do (ctx,name) <- Prelude.foldr mplus mzero $ map (\c -> tryFindArrayItem c tlInTag) contexts lift $ ctx name readContext = readContext' `mplus` readContextWithIdx processAndNext = do processBlock sectionContent contexts otag ctag conf next afterSection in do mbCtx <- lift $ runMaybeT readContext if symb == '#' then case mbCtx of -- section Just (MuList []) -> next afterSection Just (MuList b) -> do mapM_ (\c -> processBlock sectionContent (c:contexts) otag ctag conf) b next afterSection Just (MuVariable a) -> if isEmpty a then next afterSection else processAndNext Just (MuBool True) -> processAndNext Just (MuLambda func) -> do func sectionContent ~> toLText ~> addResTL next afterSection Just (MuLambdaM func) -> do res <- lift (func sectionContent) res ~> toLText ~> addResTL next afterSection _ -> next afterSection else case mbCtx of -- inverted section Just (MuList []) -> processAndNext Just (MuBool False) -> processAndNext Just (MuVariable a) -> if isEmpty a then processAndNext else next afterSection Nothing -> processAndNext _ -> next afterSection -- set delimiter | symb == '=' = let lenInTag = length inTag delimitersCommand = take (lenInTag - 1) inTag ~> drop 1 getDelimiter = do guard $ lenInTag > 4 guard $ index inTag (lenInTag - 1) == '=' [newOTag,newCTag] <- Just $ splitOn (singleton ' ') delimitersCommand Just (newOTag, newCTag) in case getDelimiter of Nothing -> next afterClose Just (newOTag, newCTag) -> processBlock (trim' afterClose) contexts newOTag newCTag conf -- partials | symb == '>' = 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 F.mapM_ next =<< lift (muTemplateRead conf fullFileName) next (trim' afterClose) -- variable | otherwise = do addResTL . muEscapeFunc conf =<< lift (readVar contexts $ trimAll inTag) next afterClose where next t = processBlock t contexts otag ctag conf trim' content = dropWhile trimCharsTest content ~> \t -> if length t > 0 && head t == '\n' then tail t else content -- | Render Hastache template from 'Text' hastacheStr :: (MonadIO m) => MuConfig m -- ^ Configuration -> Text -- ^ Template -> MuContext m -- ^ Context -> m TL.Text hastacheStr conf str context = hastacheStrBuilder conf str context >>= return . TLB.toLazyText -- | Render Hastache template from file hastacheFile :: (MonadIO m) => MuConfig m -- ^ Configuration -> FilePath -- ^ Template file name -> MuContext m -- ^ Context -> m TL.Text hastacheFile conf file_name context = hastacheFileBuilder conf file_name context >>= return . TLB.toLazyText -- | Render Hastache template from 'Text' hastacheStrBuilder :: (MonadIO m) => MuConfig m -- ^ Configuration -> Text -- ^ Template -> MuContext m -- ^ Context -> m TLB.Builder hastacheStrBuilder conf str context = do rf <- newIORef mempty ~> liftIO runReaderT (processBlock str [context] defOTag defCTag conf) rf readIORef rf ~> liftIO -- | Render Hastache template from file hastacheFileBuilder :: (MonadIO m) => MuConfig m -- ^ Configuration -> FilePath -- ^ Template file name -> MuContext m -- ^ Context -> m TLB.Builder hastacheFileBuilder conf file_name context = do str <- readFile file_name ~> liftIO hastacheStrBuilder conf str context hastache-0.6.1/Text/Hastache/0000755000000000000000000000000012446243210014126 5ustar0000000000000000hastache-0.6.1/Text/Hastache/Context.hs0000644000000000000000000003024712446243210016114 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} -- Module: Text.Hastache.Context -- Copyright: Sergey S Lymar (c) 2011-2013 -- License: BSD3 -- Maintainer: Sergey S Lymar -- Stability: experimental -- Portability: portable {- | Hastache context helpers -} module Text.Hastache.Context ( mkStrContext , mkStrContextM , mkGenericContext , mkGenericContext' , Ext , defaultExt ) where import Data.Data import Data.Generics import Data.Int import Data.Version (Version) import Data.Ratio (Ratio) import Data.Word import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Map as Map import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as TL 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 ~> return -- | Make Hastache context from monadic String -> MuType function mkStrContextM :: Monad m => (String -> m (MuType m)) -> MuContext m mkStrContextM f a = decodeStr a ~> f type Ext = forall b. (Data b, Typeable b) => b -> String -- | @defaultExt ==@ 'gshow' defaultExt :: Ext defaultExt = gshow {- | Make Hastache context from Data.Data deriving type Supported field types: * () * String * Char * Double * Float * Int * Int8 * Int16 * Int32 * Int64 * Integer * Word * Word8 * Word16 * Word32 * Word64 * Data.ByteString.ByteString * Data.ByteString.Lazy.ByteString * Data.Text.Text * Data.Text.Lazy.Text * Bool * Version * Maybe @a@ (where @a@ is a supported datatype) * Either @a@ @b@ (where @a@ and @b@ are supported datatypes) * Data.Text.Text -> Data.Text.Text * Data.Text.Text -> Data.Text.Lazy.Text * Data.Text.Lazy.Text -> Data.Text.Lazy.Text * Data.ByteString.ByteString -> Data.ByteString.ByteString * String -> String * Data.ByteString.ByteString -> Data.ByteString.Lazy.ByteString * MonadIO m => Data.Text.Text -> m Data.Text.Text * MonadIO m => Data.Text.Text -> m Data.Text.Lazy.Text * MonadIO m => Data.Text.Lazy.Text -> m Data.Text.Lazy.Text * MonadIO m => Data.ByteString.ByteString -> m Data.ByteString.ByteString * MonadIO m => String -> m String * MonadIO m => Data.ByteString.ByteString -> m Data.ByteString.Lazy.ByteString Example: @ import Text.Hastache import Text.Hastache.Context import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL import Data.Data import Data.Generics import Data.Char data InternalData = InternalData { someField :: String, anotherField :: Int } deriving (Data, Typeable, Show) data Example = Example { stringField :: String, intField :: Int, dataField :: InternalData, simpleListField :: [String], dataListField :: [InternalData], stringFunc :: String -> String, textFunc :: T.Text -> T.Text, monadicStringFunc :: String -> IO String, monadicTextFunc :: T.Text -> IO T.Text } deriving (Data, Typeable) example = hastacheStr defaultConfig (encodeStr template) (mkGenericContext context) where template = unlines [ \"string: {{stringField}}\", \"int: {{intField}}\", \"data: {{dataField.someField}}, {{dataField.anotherField}}\", \"data: {{#dataField}}{{someField}}, {{anotherField}}{{/dataField}}\", \"simple list: {{#simpleListField}}{{.}} {{/simpleListField}}\", \"data list:\", \"{{#dataListField}}\", \" * {{someField}}, {{anotherField}}. top level var: {{intField}}\", \"{{/dataListField}}\", \"{{#stringFunc}}upper{{/stringFunc}}\", \"{{#textFunc}}reverse{{/textFunc}}\", \"{{#monadicStringFunc}}upper (monadic){{/monadicStringFunc}}\", \"{{#monadicTextFunc}}reverse (monadic){{/monadicTextFunc}}\"] context = Example { stringField = \"string value\", intField = 1, dataField = InternalData \"val\" 123, simpleListField = [\"a\",\"b\",\"c\"], dataListField = [InternalData \"aaa\" 1, InternalData \"bbb\" 2], stringFunc = map toUpper, textFunc = T.reverse, monadicStringFunc = return . map toUpper, monadicTextFunc = return . T.reverse } main = example >>= TL.putStrLn @ Result: @ string: string value int: 1 data: val, 123 data: val, 123 simple list: a b c data list: * aaa, 1. top level var: 1 * bbb, 2. top level var: 1 UPPER esrever UPPER (MONADIC) )cidanom( esrever @ Hastache also supports datatypes with multiple constructors: @ data A = A { str :: String } | B { num :: Int } {{#A}} A : {{str}} {{/A}} {{#B}} B : {{num}} {{/B}} @ -} #if MIN_VERSION_base(4,7,0) mkGenericContext :: (Monad m, Data a, Typeable m) => a -> MuContext m #else mkGenericContext :: (Monad m, Data a, Typeable1 m) => a -> MuContext m #endif mkGenericContext val = toGenTemp id defaultExt val ~> convertGenTempToContext {-| Like 'mkGenericContext', but apply the first function to record field names when constructing the context. The second function is used to constructing values for context from datatypes that are nor supported as primitives in the library. The resulting value can be accessed using the @.DatatypeName@ field: @ \{\-\# LANGUAGE DeriveDataTypeable \#\-\} \{\-\# LANGUAGE FlexibleInstances \#\-\} \{\-\# LANGUAGE ScopedTypeVariables \#\-\} \{\-\# LANGUAGE StandaloneDeriving \#\-\} \{\-\# LANGUAGE TypeSynonymInstances \#\-\} import Text.Hastache import Text.Hastache.Context import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL import Data.Data (Data, Typeable) import Data.Decimal import Data.Generics.Aliases (extQ) data Test = Test {n::Int, m::Decimal} deriving (Data, Typeable) deriving instance Data Decimal val :: Test val = Test 1 (Decimal 3 1500) q :: Ext q = defaultExt \`extQ\` (\(i::Decimal) -> "A decimal: " ++ show i) r "m" = "moo" r x = x example :: IO TL.Text example = hastacheStr defaultConfig (encodeStr template) (mkGenericContext' r q val) template = concat [ "{{n}}\\n", "{{moo.Decimal}}" ] main = example >>= TL.putStrLn @ Result: @ 1 A decimal: 1.500 @ -} #if MIN_VERSION_base(4,7,0) mkGenericContext' :: (Monad m, Data a, Typeable m) => (String -> String) -> Ext -> a -> MuContext m #else mkGenericContext' :: (Monad m, Data a, Typeable1 m) => (String -> String) -> Ext -> a -> MuContext m #endif mkGenericContext' f ext val = toGenTemp f ext val ~> convertGenTempToContext data TD m = TSimple (MuType m) | TObj [(String, TD m)] | TList [TD m] | TUnknown deriving (Show) #if MIN_VERSION_base(4,7,0) toGenTemp :: (Data a, Monad m, Typeable m) => (String -> String) -> Ext -> a -> TD m #else toGenTemp :: (Data a, Monad m, Typeable1 m) => (String -> String) -> Ext -> a -> TD m #endif toGenTemp f g a = TObj $ conName : zip fields (gmapQ (procField f g) a) where fields = toConstr a ~> constrFields ~> map f conName = (toConstr a ~> showConstr, TSimple . MuVariable $ g a) #if MIN_VERSION_base(4,7,0) procField :: (Data a, Monad m, Typeable m) => (String -> String) -> Ext -> a -> TD m #else procField :: (Data a, Monad m, Typeable1 m) => (String -> String) -> Ext -> a -> TD m #endif procField f g a = case res a of TUnknown -> TSimple . MuVariable . g $ a b -> b where res = 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::T.Text) -> MuVariable i ~> TSimple) `extQ` (\(i::TL.Text) -> MuVariable i ~> TSimple) `extQ` (\(i::Bool) -> MuBool i ~> TSimple) `extQ` (\() -> MuVariable () ~> TSimple) `extQ` (\(i::Version) -> MuVariable i ~> TSimple) `extQ` muLambdaTT `extQ` muLambdaTTL `extQ` muLambdaTLTL `extQ` muLambdaBSBS `extQ` muLambdaSS `extQ` muLambdaBSLBS `extQ` muLambdaMTT `extQ` muLambdaMTTL `extQ` muLambdaMTLTL `extQ` muLambdaMBSBS `extQ` muLambdaMSS `extQ` muLambdaMBSLBS `ext1Q` muMaybe `ext2Q` muEither obj a = case dataTypeRep (dataTypeOf a) of AlgRep (_:_) -> toGenTemp f g a _ -> TUnknown list a = map (procField f g) a ~> TList muMaybe Nothing = TSimple MuNothing muMaybe (Just a) = TList [procField f g a] muEither (Left a) = procField f g a muEither (Right b) = procField f g b muLambdaTT :: (T.Text -> T.Text) -> TD m muLambdaTT f = MuLambda f ~> TSimple muLambdaTLTL :: (TL.Text -> TL.Text) -> TD m muLambdaTLTL f = MuLambda (f . TL.fromStrict) ~> TSimple muLambdaTTL :: (T.Text -> TL.Text) -> TD m muLambdaTTL f = MuLambda f ~> TSimple muLambdaBSBS :: (BS.ByteString -> BS.ByteString) -> TD m muLambdaBSBS f = MuLambda (f . T.encodeUtf8) ~> TSimple muLambdaBSLBS :: (BS.ByteString -> LBS.ByteString) -> TD m muLambdaBSLBS f = MuLambda (f . T.encodeUtf8) ~> TSimple muLambdaSS :: (String -> String) -> TD m muLambdaSS f = MuLambda fd ~> TSimple where fd s = decodeStr s ~> f -- monadic muLambdaMTT :: (T.Text -> m T.Text) -> TD m muLambdaMTT f = MuLambdaM f ~> TSimple muLambdaMTLTL :: (TL.Text -> m TL.Text) -> TD m muLambdaMTLTL f = MuLambdaM (f . TL.fromStrict) ~> TSimple muLambdaMTTL :: (T.Text -> m TL.Text) -> TD m muLambdaMTTL f = MuLambdaM f ~> TSimple muLambdaMBSBS :: (BS.ByteString -> m BS.ByteString) -> TD m muLambdaMBSBS f = MuLambdaM (f . T.encodeUtf8) ~> TSimple muLambdaMBSLBS :: (BS.ByteString -> m LBS.ByteString) -> TD m muLambdaMBSLBS f = MuLambdaM (f . T.encodeUtf8) ~> TSimple muLambdaMSS :: (String -> m String) -> TD m muLambdaMSS f = MuLambdaM fd ~> TSimple where fd s = decodeStr s ~> f convertGenTempToContext :: Monad m => TD m -> MuContext m 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 ~> Map.insert (encodeStr name) ([foldl (foldTObj "") Map.empty lst ~> mkMapContext] ~> MuList) 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 = return $ case Map.lookup a m of Nothing -> case a == dotT of True -> case Map.lookup T.empty m of Nothing -> MuNothing Just a -> a _ -> MuNothing Just a -> a dotT :: T.Text dotT = T.singleton '.'