hastache-0.3.3/0000755000175000017500000000000011712751135012656 5ustar sergeysergeyhastache-0.3.3/README.md0000644000175000017500000001060111712751135014133 0ustar sergeysergey# 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. ### Examples #### Variables ```haskell import Text.Hastache import Text.Hastache.Context import qualified Data.ByteString.Lazy as LZ main = hastacheStr defaultConfig (encodeStr template) (mkStrContext context) >>= LZ.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.ByteString.Lazy as LZ import Data.Data import Data.Generics main = hastacheStr defaultConfig (encodeStr template) context >>= LZ.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"] ``` #### 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.ByteString.Lazy as LZ import Control.Monad.State main = run >>= LZ.putStrLn run = evalStateT stateFunc "" stateFunc :: StateT String IO LZ.ByteString 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 ``` #### 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) hastache-0.3.3/Text/0000755000175000017500000000000011712751135013602 5ustar sergeysergeyhastache-0.3.3/Text/Hastache/0000755000175000017500000000000011712751135015322 5ustar sergeysergeyhastache-0.3.3/Text/Hastache/Context.hs0000644000175000017500000001706111712751135017307 0ustar sergeysergey{-# LANGUAGE ScopedTypeVariables #-} -- Module: Text.Hastache.Context -- Copyright: Sergey S Lymar (c) 2011 -- License: BSD3 -- Maintainer: Sergey S Lymar -- 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.Map as Map import qualified Data.Text as Text import qualified Data.Text.Lazy as LText 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 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 * Data.ByteString.ByteString -> Data.ByteString.ByteString * String -> String * Data.ByteString.ByteString -> Data.ByteString.Lazy.ByteString * 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.ByteString as B import qualified Data.ByteString.Lazy as LZ 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, byteStringFunc :: B.ByteString -> B.ByteString, monadicStringFunc :: String -> IO String, monadicByteStringFunc :: B.ByteString -> IO B.ByteString } deriving (Data, Typeable) example = hastacheStr defaultConfig (encodeStr template) (mkGenericContext context) where template = concat $ map (++ \"\\n\") [ \"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}}\", \"{{#byteStringFunc}}reverse{{/byteStringFunc}}\", \"{{#monadicStringFunc}}upper (monadic){{/monadicStringFunc}}\", \"{{#monadicByteStringFunc}}reverse (monadic){{/monadicByteStringFunc}}\"] 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, byteStringFunc = B.reverse, monadicStringFunc = return . map toUpper, monadicByteStringFunc = return . B.reverse } main = example >>= LZ.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 @ -} mkGenericContext :: (Monad m, Data a, Typeable1 m) => 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, Typeable1 m) => a -> TD m toGenTemp a = zip fields (gmapQ procField a) ~> TObj where fields = toConstr a ~> constrFields procField :: (Data a, Monad m, Typeable1 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) `extQ` muLambdaBSBS `extQ` muLambdaSS `extQ` muLambdaBSLBS `extQ` muLambdaMBSBS `extQ` muLambdaMSS `extQ` muLambdaMBSLBS where obj a = case dataTypeRep (dataTypeOf a) of AlgRep [c] -> toGenTemp a _ -> TUnknown list a = map procField a ~> TList muLambdaBSBS :: (BS.ByteString -> BS.ByteString) -> TD m muLambdaBSBS f = MuLambda f ~> TSimple muLambdaSS :: (String -> String) -> TD m muLambdaSS f = MuLambda fd ~> TSimple where fd s = decodeStr s ~> f muLambdaBSLBS :: (BS.ByteString -> LBS.ByteString) -> TD m muLambdaBSLBS f = MuLambda f ~> TSimple -- monadic muLambdaMBSBS :: (BS.ByteString -> m BS.ByteString) -> TD m muLambdaMBSBS f = MuLambdaM f ~> TSimple muLambdaMSS :: (String -> m String) -> TD m muLambdaMSS f = MuLambdaM fd ~> TSimple where fd s = decodeStr s ~> f muLambdaMBSLBS :: (BS.ByteString -> m LBS.ByteString) -> TD m muLambdaMBSLBS f = MuLambdaM f ~> TSimple 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 ~> 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 = case Map.lookup a m of Nothing -> case a == dotBS of True -> case Map.lookup BS.empty m of Nothing -> MuNothing Just a -> a _ -> MuNothing Just a -> a dotBS = encodeStr "." hastache-0.3.3/Text/Hastache.hs0000644000175000017500000003721011712751135015661 0ustar sergeysergey{-# LANGUAGE ExistentialQuantification, FlexibleInstances, IncoherentInstances #-} -- Module: Text.Hastache -- Copyright: Sergey S Lymar (c) 2011 -- 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.ByteString.Lazy as LZ main = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context) LZ.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: @ import Text.Hastache import Text.Hastache.Context import qualified Data.ByteString.Lazy as LZ import Data.Data import Data.Generics data Info = Info { name :: String, unread :: Int } deriving (Data, Typeable) main = do res <- hastacheStr defaultConfig (encodeStr template) (mkGenericContext inf) LZ.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(..) , htmlEscape , emptyEscape , defaultConfig , encodeStr , encodeStrLBS , decodeStr , decodeStrLBS ) where import Control.Monad (guard, when) import Control.Monad.Reader (ask, runReaderT, MonadReader, ReaderT) import Control.Monad.Trans (lift, liftIO, MonadIO) import Data.AEq ((~==)) import Data.ByteString hiding (map, foldl1) import Data.Char (ord) import Data.Int import Data.IORef import Data.Maybe (isJust) import Data.Monoid (mappend, mempty) import Data.Word import Prelude hiding (putStrLn, readFile, length, drop, tail, dropWhile, elem, head, last, reverse, take, span) import System.Directory (doesFileExist) import System.FilePath (combine) import qualified Blaze.ByteString.Builder as BSB import qualified Codec.Binary.UTF8.String as SU import qualified Data.ByteString.Lazy as LZ import qualified Data.List as List import qualified Data.Text as Text import qualified Data.Text.Lazy as LText import qualified Prelude (~>) :: 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 -- | Convert to Lazy ByteString toLByteString :: a -> LZ.ByteString -- | Is empty variable (empty string, zero number etc.) isEmpty :: a -> Bool isEmpty _ = False instance MuVar ByteString where toLByteString = toLBS isEmpty a = length a == 0 instance MuVar LZ.ByteString where toLByteString = id isEmpty a = LZ.length a == 0 withShowToLBS a = show a ~> encodeStr ~> toLBS numEmpty a = a ~== 0 instance MuVar Integer where {toLByteString = withShowToLBS; isEmpty = numEmpty} instance MuVar Int where {toLByteString = withShowToLBS; isEmpty = numEmpty} instance MuVar Float where {toLByteString = withShowToLBS; isEmpty = numEmpty} instance MuVar Double where {toLByteString = withShowToLBS; isEmpty = numEmpty} instance MuVar Int8 where {toLByteString = withShowToLBS; isEmpty = numEmpty} instance MuVar Int16 where {toLByteString = withShowToLBS; isEmpty = numEmpty} instance MuVar Int32 where {toLByteString = withShowToLBS; isEmpty = numEmpty} instance MuVar Int64 where {toLByteString = withShowToLBS; isEmpty = numEmpty} instance MuVar Word where {toLByteString = withShowToLBS; isEmpty = numEmpty} instance MuVar Word8 where {toLByteString = withShowToLBS; isEmpty = numEmpty} instance MuVar Word16 where {toLByteString = withShowToLBS; isEmpty = numEmpty} instance MuVar Word32 where {toLByteString = withShowToLBS; isEmpty = numEmpty} instance MuVar Word64 where {toLByteString = withShowToLBS; isEmpty = numEmpty} instance MuVar Text.Text where toLByteString t = Text.unpack t ~> encodeStr ~> toLBS isEmpty a = Text.length a == 0 instance MuVar LText.Text where toLByteString t = LText.unpack t ~> encodeStr ~> toLBS isEmpty a = LText.length a == 0 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 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 (ByteString -> a) | forall a. MuVar a => MuLambdaM (ByteString -> 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 = 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 isMuNothing MuNothing = True isMuNothing _ = False -- | 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 "&" t | h == ord8 '\\'= stp "\" t | h == ord8 '"' = stp """ t | h == ord8 '\''= stp "'" t | h == ord8 '<' = stp "<" t | h == ord8 '>' = stp ">" 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 [] _ = LZ.empty readVar (context:parentCtx) name = case context name of MuVariable a -> toLByteString a MuBool a -> show a ~> encodeStr ~> toLBS MuNothing -> readVar parentCtx name _ -> 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 addRes :: MonadIO m => LZ.ByteString -> ReaderT (IORef BSB.Builder) m () addRes str = do rf <- ask b <- readIORef rf ~> liftIO let l = mappend b (BSB.fromLazyByteString str) writeIORef rf l ~> liftIO return () addResBS :: MonadIO m => ByteString -> ReaderT (IORef BSB.Builder) m () addResBS str = toLBS str ~> addRes addResLZ :: MonadIO m => LZ.ByteString -> ReaderT (IORef BSB.Builder) m () addResLZ = addRes processBlock :: MonadIO m => ByteString -> [ByteString -> MuType m] -> ByteString -> ByteString -> MuConfig -> ReaderT (IORef BSB.Builder) m () processBlock str contexts otag ctag conf = case findBlock str otag ctag of Just (pre, symb, inTag, afterClose) -> do addResBS pre renderBlock contexts symb inTag afterClose otag ctag conf Nothing -> do addResBS str return () renderBlock:: MonadIO m => [ByteString -> MuType m] -> Word8 -> ByteString -> ByteString -> ByteString -> ByteString -> MuConfig -> ReaderT (IORef BSB.Builder) m () renderBlock contexts symb inTag afterClose otag ctag conf -- comment | symb == ord8 '!' = next afterClose -- unescape variable | symb == ord8 '&' || (symb == ord8 '{' && otag == defOTag) = do readVar contexts (tail inTag ~> trimAll) ~> addResLZ next afterClose -- section, inverted section | symb == ord8 '#' || symb == ord8 '^' = 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' tlInTag = tail inTag readContext = map ($ tlInTag) contexts ~> List.find (not . isMuNothing) processAndNext = do processBlock sectionContent contexts otag ctag conf next afterSection in if symb == ord8 '#' then case readContext 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 ~> toLByteString ~> addResLZ next afterSection Just (MuLambdaM func) -> do res <- lift (func sectionContent) toLByteString res ~> addResLZ next afterSection _ -> next afterSection else case readContext 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 == 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 case getDelimiter of Nothing -> next afterClose Just (newOTag, newCTag) -> processBlock (trim' afterClose) contexts 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 contexts (trimAll inTag) ~> muEscapeFunc conf ~> addResLZ next afterClose where next t = processBlock t contexts otag ctag conf trim' content = dropWhile trimCharsTest content ~> \t -> if length t > 0 && head t == ord8 '\n' then tail t else content processSection = undefined -- | Render Hastache template from ByteString hastacheStr :: (MonadIO m) => MuConfig -- ^ Configuration -> ByteString -- ^ Template -> MuContext m -- ^ Context -> m LZ.ByteString hastacheStr conf str context = hastacheStrBuilder conf str context >>= return . BSB.toLazyByteString -- | Render Hastache template from file hastacheFile :: (MonadIO m) => MuConfig -- ^ Configuration -> FilePath -- ^ Template file name -> MuContext m -- ^ Context -> m LZ.ByteString hastacheFile conf file_name context = hastacheFileBuilder conf file_name context >>= return . BSB.toLazyByteString -- | Render Hastache template from ByteString hastacheStrBuilder :: (MonadIO m) => MuConfig -- ^ Configuration -> ByteString -- ^ Template -> MuContext m -- ^ Context -> m BSB.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 -- ^ Configuration -> FilePath -- ^ Template file name -> MuContext m -- ^ Context -> m BSB.Builder hastacheFileBuilder conf file_name context = do str <- readFile file_name ~> liftIO hastacheStrBuilder conf str context hastache-0.3.3/tests/0000755000175000017500000000000011712751135014020 5ustar sergeysergeyhastache-0.3.3/tests/RunTest.sh0000755000175000017500000000003211712751135015756 0ustar sergeysergeyrunhaskell -i.. test.hs hastache-0.3.3/tests/partFile0000644000175000017500000000001611712751135015506 0ustar sergeysergeyHi, {{name}}! hastache-0.3.3/tests/test.hs0000644000175000017500000003246311712751135015343 0ustar sergeysergey{-# LANGUAGE DeriveDataTypeable #-} module Tests where import Control.Monad import Control.Monad.Writer import Data.Char import Data.Data import Data.Generics 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 resCorrectness = "result correctness" -- Hastache comments commentsTest = do res <- hastacheStr defaultConfig (encodeStr template) undefined assertEqualStr resCorrectness (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 resCorrectness (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 "

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 (decodeStrLBS 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 (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 resCorrectness (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 resCorrectness (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 resCorrectness (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 resCorrectness (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 resCorrectness (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) 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 } deriving (Data, Typeable) -- Make hastache context from Data.Data deriving type genericContextTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkGenericContext context) assertEqualStr resCorrectness (decodeStrLBS 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\ \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\ \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 } testRes = "\ \text 1\n\ \aaa zzz \n\ \100 \n\ \* zzz 100 \n\ \Simple list:\n\ \* 1 \n\ \* 2 \n\ \* 3 \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\ \text 2\n\ \" -- Up-level context from nested block nestedContextTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context) assertEqualStr resCorrectness (decodeStrLBS 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 (decodeStrLBS 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\ \" 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 "Set delimiter test" (TestCase setDelimiterTest) ,TestLabel "Partials test" (TestCase partialsTest) ,TestLabel "Generic context test" (TestCase genericContextTest) ,TestLabel "Nested context test" (TestCase nestedContextTest) ,TestLabel "Nested generic context test" (TestCase nestedGenericContextTest) ] main = do runTestTT tests 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.3.3/Setup.hs0000644000175000017500000000011311712751135014305 0ustar sergeysergey#! /usr/bin/env runhaskell import Distribution.Simple main = defaultMain hastache-0.3.3/LICENSE0000644000175000017500000000266711712751135013676 0ustar sergeysergeyCopyright (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.3.3/hastache.cabal0000644000175000017500000000221711712751135015424 0ustar sergeysergeyname: hastache version: 0.3.3 license: BSD3 license-file: LICENSE category: Text copyright: Sergey S Lymar (c) 2011 author: Sergey S Lymar maintainer: Sergey S Lymar stability: experimental tested-with: GHC == 7.0.2, GHC == 7.0.3 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 library exposed-modules: Text.Hastache Text.Hastache.Context build-depends: base == 4.* ,bytestring ,mtl ,directory ,filepath ,utf8-string ,text ,containers ,syb ,blaze-builder ,ieee754 source-repository head type: git location: http://github.com/lymar/hastache