hastache 0.5.1 → 0.6.1
raw patch · 7 files changed
Files
- ChangeLog +26/−0
- README.md +135/−10
- Text/Hastache.hs +221/−183
- Text/Hastache/Context.hs +231/−74
- hastache.cabal +22/−6
- mkReadme.hs +50/−0
- tests/test.hs +105/−19
+ ChangeLog view
@@ -0,0 +1,26 @@+# 0.6.1++- Fixing documentation typos+- Implementing basic context merging (see+ <https://github.com/lymar/hastache/issues/31>)+- `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+ <https://github.com/lymar/hastache/issues/38> 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`, `()`)
README.md view
@@ -20,10 +20,10 @@ ```haskell import Text.Hastache import Text.Hastache.Context -import qualified Data.ByteString.Lazy.Char8 as LZ +import qualified Data.Text.Lazy.IO as TL main = hastacheStr defaultConfig (encodeStr template) (mkStrContext context)- >>= LZ.putStrLn+ >>= TL.putStrLn template = "Hello, {{name}}!\n\nYou have {{unread}} unread messages." @@ -43,12 +43,12 @@ {-# LANGUAGE DeriveDataTypeable #-} import Text.Hastache import Text.Hastache.Context -import qualified Data.ByteString.Lazy as LZ +import qualified Data.Text.Lazy.IO as TL import Data.Data import Data.Generics main = hastacheStr defaultConfig (encodeStr template) context- >>= LZ.putStrLn+ >>= TL.putStrLn data Info = Info { name :: String, @@ -114,7 +114,7 @@ ```haskell main = mapM_ (\(template,context) ->- hastacheStr defaultConfig (encodeStr template) context >>= LZ.putStrLn) + hastacheStr defaultConfig (encodeStr template) context >>= TL.putStrLn) [(template1, mkStrContext context1), (template1, context2), (template3, context3)]@@ -185,7 +185,7 @@ ```haskell main = mapM_ (\ctx -> hastacheStr defaultConfig (encodeStr template) (mkStrContext ctx)- >>= LZ.putStrLn) [context1,context2]+ >>= TL.putStrLn) [context1,context2] template = "{{#msg}}{{msg}}{{/msg}}{{^msg}}No{{/msg}} new messages." @@ -197,6 +197,65 @@ 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@@ -214,15 +273,16 @@ ```haskell {-# LANGUAGE FlexibleContexts #-} import Text.Hastache -import Text.Hastache.Context -import qualified Data.ByteString.Lazy.Char8 as LZ +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 >>= LZ.putStrLn+main = run >>= TL.putStrLn run = evalStateT stateFunc "" -stateFunc :: StateT String IO LZ.ByteString+stateFunc :: StateT String IO TL.Text stateFunc = hastacheStr defaultConfig (encodeStr template) (mkStrContext context) @@ -242,6 +302,70 @@ 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@@ -297,3 +421,4 @@ * [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)
Text/Hastache.hs view
@@ -16,14 +16,14 @@ Simplest example: @-import Text.Hastache -import Text.Hastache.Context -import qualified Data.ByteString.Lazy.Char8 as LZ +import Text.Hastache+import Text.Hastache.Context+import qualified Data.Text.Lazy.IO as TL main = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context) - LZ.putStrLn res + TL.putStrLn res where template = \"Hello, {{name}}!\\n\\nYou have {{unread}} unread messages.\" context \"name\" = MuVariable \"Haskell\"@@ -41,22 +41,23 @@ Using Generics: @-import Text.Hastache -import Text.Hastache.Context -import qualified Data.ByteString.Lazy.Char8 as LZ -import Data.Data -import Data.Generics - -data Info = Info { - name :: String, - unread :: Int +{-\# 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 (encodeStr template) - (mkGenericContext inf) - LZ.putStrLn res - where +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 @@@ -71,43 +72,45 @@ , MuType(..) , MuConfig(..) , MuVar(..)+ , composeCtx , htmlEscape , emptyEscape , defaultConfig , encodeStr- , encodeStrLBS+ , encodeStrLT , decodeStr- , decodeStrLBS+ , decodeStrLT ) where -import Control.Monad (guard, when, mplus, mzero, liftM )+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.ByteString hiding (map, foldl1)-import Data.ByteString.Char8 (readInt)-import Data.Char (ord) import Data.Functor ((<$>))-import Data.Int import Data.IORef+import Data.Int import Data.Maybe (isJust)-import Data.Monoid (mappend, mempty)+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 Blaze.ByteString.Builder as BSB-import qualified Codec.Binary.UTF8.String as SU+import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LZ-import qualified Data.Foldable as F import qualified Data.List as List-import qualified Data.Text as Text-import qualified Data.Text.Encoding as TextEncoding-import qualified Data.Text.Lazy as LText-import qualified Data.Text.Lazy.Encoding as LTextEncoding+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@@ -116,72 +119,105 @@ -- | Data for Hastache variable type MuContext m =- ByteString -- ^ Variable name+ 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 ByteString- toLByteString :: a -> LZ.ByteString + -- | Convert to lazy 'Data.Text.Lazy.Text'+ toLText :: a -> TL.Text -- | Is empty variable (empty string, zero number etc.)- isEmpty :: a -> Bool + isEmpty :: a -> Bool isEmpty _ = False- -instance MuVar ByteString where- toLByteString = toLBS- isEmpty a = length a == 0++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- toLByteString = id+ toLText = TL.decodeUtf8 isEmpty a = LZ.length a == 0 -withShowToLBS :: Show a => a -> LZ.ByteString-withShowToLBS a = show a ~> encodeStr ~> toLBS+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 {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 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 Text.Text where - toLByteString t = TextEncoding.encodeUtf8 t ~> toLBS- isEmpty a = Text.length a == 0+instance MuVar Version where {toLText = withShowToText } -instance MuVar LText.Text where - toLByteString t = LTextEncoding.encodeUtf8 t- isEmpty a = LText.length a == 0- instance MuVar Char where- toLByteString a = (a : "") ~> encodeStr ~> toLBS+ toLText = TL.singleton instance MuVar a => MuVar [a] where- toLByteString a = toLByteString '[' <+> cnvLst <+> toLByteString ']'+ toLText a = toLText '[' <+> cnvLst <+> toLText ']' where- cnvLst = map toLByteString a ~> - LZ.intercalate (toLByteString ',')- (<+>) = LZ.append+ 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- toLByteString k = k ~> encodeStr ~> toLBS+ 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 (ByteString -> a) |- forall a. MuVar a => MuLambdaM (ByteString -> m a) |+ forall a. MuVar a => MuLambda (Text -> a) |+ forall a. MuVar a => MuLambdaM (Text -> m a) | MuNothing instance Show (MuType m) where@@ -193,57 +229,52 @@ show MuNothing = "MuNothing" data MuConfig m = MuConfig {- muEscapeFunc :: LZ.ByteString -> LZ.ByteString, + muEscapeFunc :: TL.Text -> TL.Text, -- ^ Escape function ('htmlEscape', 'emptyEscape' etc.) muTemplateFileDir :: Maybe FilePath,- -- ^ Directory for search partial templates ({{> templateName}})+ -- ^ Directory for search partial templates (@{{> templateName}}@) muTemplateFileExt :: Maybe String, -- ^ Partial template files extension- muTemplateRead :: FilePath -> m (Maybe ByteString)+ muTemplateRead :: FilePath -> m (Maybe Text) -- ^ Template retrieval function. 'Nothing' indicates that the -- template could not be found. } --- | 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 'String' to 'Text'+encodeStr :: String -> Text+encodeStr = T.pack --- | Convert UTF-8 Bytestring to String-decodeStr :: ByteString -> String-decodeStr = SU.decode . unpack+-- | Convert 'String' to Lazy 'Data.Text.Lazy.Text'+encodeStrLT :: String -> TL.Text+encodeStrLT = TL.pack --- | Convert UTF-8 Lazy Bytestring to String-decodeStrLBS :: LZ.ByteString -> String-decodeStrLBS = SU.decode . LZ.unpack+-- | Convert 'Text' to 'String'+decodeStr :: Text -> String+decodeStr = T.unpack -ord8 :: Char -> Word8-ord8 = fromIntegral . ord+-- | 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 :: 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+htmlEscape :: TL.Text -> TL.Text+htmlEscape = TL.concatMap proc+ where+ proc '&' = "&"+ proc '\\' = "\"+ proc '"' = """+ proc '\'' = "'"+ proc '<' = "<"+ proc '>' = ">"+ proc h = TL.singleton h -- | No escape-emptyEscape :: LZ.ByteString -> LZ.ByteString+emptyEscape :: TL.Text -> TL.Text emptyEscape = id {- | Default config: HTML escape function, current directory as @@ -256,62 +287,65 @@ muTemplateRead = liftIO . defaultTemplateRead } -defaultTemplateRead :: FilePath -> IO (Maybe ByteString)+defaultTemplateRead :: FilePath -> IO (Maybe Text) defaultTemplateRead fullFileName = do fe <- doesFileExist fullFileName if fe then Just <$> readFile fullFileName else return Nothing -defOTag = "{{" :: ByteString-defCTag = "}}" :: ByteString-unquoteCTag = "}}}" :: ByteString+defOTag = "{{" :: Text+defCTag = "}}" :: Text+unquoteCTag = "}}}" :: Text findBlock :: - ByteString - -> ByteString - -> ByteString- -> Maybe (ByteString, Word8, ByteString, ByteString)+ 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) = breakSubstring otag str+ (pre, fnd) = breakOn otag str symb = index fnd (length otag) (inTag, afterClose) -- test for unescape ( {{{some}}} )- | symb == ord8 '{' && ctag == defCTag = - breakSubstring unquoteCTag fnd ~> \(a,b) -> + | symb == '{' && ctag == defCTag = + breakOn unquoteCTag fnd ~> \(a,b) -> (drop (length otag) a, drop 3 b)- | otherwise = breakSubstring ctag fnd ~> \(a,b) -> + | otherwise = breakOn ctag fnd ~> \(a,b) -> (drop (length otag) a, drop (length ctag) b) -toLBS :: ByteString -> LZ.ByteString-toLBS v = LZ.fromChunks [v]--readVar :: MonadIO m => [MuContext m] -> ByteString -> m LZ.ByteString-readVar [] _ = return LZ.empty+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 $ toLByteString a- MuBool a -> return $ show a ~> encodeStr ~> toLBS+ 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 LZ.empty+ _ -> 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- -> ByteString- -> MaybeT m (MuContext m, ByteString)+ -> 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) == (ord8 '.'))+ guard $ (null nxt) || (head nxt == '.') muType <- lift $ context nm case muType of MuList l -> do@@ -322,87 +356,92 @@ else return (ncxt, tail nxt) -- {{some.0.field}} _ -> mzero where- (nm,idx) = breakSubstring dotStr name+ (nm,idx) = breakOn dotStr name dotStr = "." findCloseSection :: - ByteString - -> ByteString - -> ByteString - -> ByteString- -> Maybe (ByteString, ByteString)+ 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) = breakSubstring close str+ (before, after) = breakOn close str -trimCharsTest :: Word8 -> Bool-trimCharsTest = (`elem` " \t")+trimCharsTest :: Char -> Bool+trimCharsTest = (`Prelude.elem` [' ', '\t']) -trimAll :: ByteString -> ByteString-trimAll str = span trimCharsTest str ~> snd ~> spanEnd trimCharsTest ~> fst+trimAll :: Text -> Text+trimAll = dropAround trimCharsTest -addRes :: MonadIO m => LZ.ByteString -> ReaderT (IORef BSB.Builder) m ()+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 (BSB.fromLazyByteString str)+ let l = mappend b t writeIORef rf l ~> liftIO return ()+ where+ t = either TLB.fromText TLB.fromLazyText str -addResBS :: MonadIO m => ByteString -> ReaderT (IORef BSB.Builder) m ()-addResBS str = toLBS str ~> addRes+addResT :: MonadIO m => T.Text -> ReaderT (IORef TLB.Builder) m ()+addResT = addRes . Left -addResLZ :: MonadIO m => LZ.ByteString -> ReaderT (IORef BSB.Builder) m ()-addResLZ = addRes+addResTL :: MonadIO m => TL.Text -> ReaderT (IORef TLB.Builder) m ()+addResTL = addRes . Right processBlock :: MonadIO m => - ByteString + Text -> [MuContext m] - -> ByteString - -> ByteString + -> Text + -> Text -> MuConfig m- -> ReaderT (IORef BSB.Builder) m ()+ -> ReaderT (IORef TLB.Builder) m () processBlock str contexts otag ctag conf = case findBlock str otag ctag of Just (pre, symb, inTag, afterClose) -> do- addResBS pre+ addResT pre renderBlock contexts symb inTag afterClose otag ctag conf Nothing -> do- addResBS str+ addResT str return () +elem :: Char -> Text -> Bool+elem c = isJust . find (==c)+ renderBlock :: MonadIO m => [MuContext m] - -> Word8 - -> ByteString - -> ByteString - -> ByteString- -> ByteString + -> Char + -> Text + -> Text + -> Text+ -> Text -> MuConfig m- -> ReaderT (IORef BSB.Builder) m ()+ -> ReaderT (IORef TLB.Builder) m () renderBlock contexts symb inTag afterClose otag ctag conf -- comment- | symb == ord8 '!' = next afterClose+ | symb == '!' = next afterClose -- unescape variable- | symb == ord8 '&' || (symb == ord8 '{' && otag == defOTag) = do- addResLZ =<< lift (readVar contexts (tail inTag ~> trimAll))+ | symb == '&' || (symb == '{' && otag == defOTag) = do+ addResTL =<< lift (readVar contexts (tail inTag ~> trimAll)) next afterClose -- section, inverted section- | symb == ord8 '#' || symb == ord8 '^' = + | 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 == ord8 '\n' + if length str > 0 && head str == '\n' then tail str else str sectionContent = dropNL sectionContent' afterSection = - if ord8 '\n' `elem` sectionContent+ if '\n' `elem` sectionContent then dropNL afterSection' else afterSection' tlInTag = tail inTag@@ -418,7 +457,7 @@ next afterSection in do mbCtx <- lift $ runMaybeT readContext- if symb == ord8 '#'+ if symb == '#' then case mbCtx of -- section Just (MuList []) -> next afterSection@@ -431,11 +470,11 @@ else processAndNext Just (MuBool True) -> processAndNext Just (MuLambda func) -> do- func sectionContent ~> toLByteString ~> addResLZ+ func sectionContent ~> toLText ~> addResTL next afterSection Just (MuLambdaM func) -> do res <- lift (func sectionContent)- toLByteString res ~> addResLZ+ res ~> toLText ~> addResTL next afterSection _ -> next afterSection else case mbCtx of -- inverted section@@ -447,14 +486,14 @@ Nothing -> processAndNext _ -> next afterSection -- set delimiter- | symb == ord8 '=' = + | symb == '=' = 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+ guard $ index inTag (lenInTag - 1) == '='+ [newOTag,newCTag] <- Just $ splitOn (singleton ' ') delimitersCommand Just (newOTag, newCTag) in case getDelimiter of Nothing -> next afterClose@@ -462,7 +501,7 @@ processBlock (trim' afterClose) contexts newOTag newCTag conf -- partials- | symb == ord8 '>' =+ | symb == '>' = let fileName' = tail inTag ~> trimAll fileName'' = case muTemplateFileExt conf of@@ -477,41 +516,40 @@ next (trim' afterClose) -- variable | otherwise = do- addResLZ . muEscapeFunc conf =<<+ 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 == ord8 '\n'+ ~> \t -> if length t > 0 && head t == '\n' then tail t else content- processSection = undefined --- | Render Hastache template from ByteString+-- | Render Hastache template from 'Text' hastacheStr :: (MonadIO m) => MuConfig m -- ^ Configuration- -> ByteString -- ^ Template+ -> Text -- ^ Template -> MuContext m -- ^ Context- -> m LZ.ByteString+ -> m TL.Text hastacheStr conf str context = - hastacheStrBuilder conf str context >>= return . BSB.toLazyByteString+ 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 LZ.ByteString+ -> m TL.Text hastacheFile conf file_name context = - hastacheFileBuilder conf file_name context >>= return . BSB.toLazyByteString+ hastacheFileBuilder conf file_name context >>= return . TLB.toLazyText --- | Render Hastache template from ByteString+-- | Render Hastache template from 'Text' hastacheStrBuilder :: (MonadIO m) => MuConfig m -- ^ Configuration- -> ByteString -- ^ Template+ -> Text -- ^ Template -> MuContext m -- ^ Context- -> m BSB.Builder+ -> m TLB.Builder hastacheStrBuilder conf str context = do rf <- newIORef mempty ~> liftIO runReaderT (processBlock str [context] defOTag defCTag conf) rf@@ -522,7 +560,7 @@ MuConfig m -- ^ Configuration -> FilePath -- ^ Template file name -> MuContext m -- ^ Context- -> m BSB.Builder+ -> m TLB.Builder hastacheFileBuilder conf file_name context = do str <- readFile file_name ~> liftIO hastacheStrBuilder conf str context
Text/Hastache/Context.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-} -- Module: Text.Hastache.Context -- Copyright: Sergey S Lymar (c) 2011-2013 -- License: BSD3@@ -14,18 +15,24 @@ 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 Text-import qualified Data.Text.Lazy as LText+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL import Text.Hastache @@ -40,11 +47,19 @@ 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@@ -84,13 +99,31 @@ * 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@@ -101,9 +134,10 @@ @ import Text.Hastache -import Text.Hastache.Context -import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as LZ +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@@ -120,15 +154,15 @@ simpleListField :: [String], dataListField :: [InternalData], stringFunc :: String -> String,- byteStringFunc :: B.ByteString -> B.ByteString,+ textFunc :: T.Text -> T.Text, monadicStringFunc :: String -> IO String,- monadicByteStringFunc :: B.ByteString -> IO B.ByteString+ monadicTextFunc :: T.Text -> IO T.Text } deriving (Data, Typeable) example = hastacheStr defaultConfig (encodeStr template) (mkGenericContext context) where- template = concat $ map (++ \"\\n\") [+ template = unlines [ \"string: {{stringField}}\", \"int: {{intField}}\", \"data: {{dataField.someField}}, {{dataField.anotherField}}\",@@ -139,18 +173,18 @@ \" * {{someField}}, {{anotherField}}. top level var: {{intField}}\", \"{{/dataListField}}\", \"{{#stringFunc}}upper{{/stringFunc}}\",- \"{{#byteStringFunc}}reverse{{/byteStringFunc}}\",+ \"{{#textFunc}}reverse{{/textFunc}}\", \"{{#monadicStringFunc}}upper (monadic){{/monadicStringFunc}}\",- \"{{#monadicByteStringFunc}}reverse (monadic){{/monadicByteStringFunc}}\"]+ \"{{#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,- byteStringFunc = B.reverse,+ textFunc = T.reverse, monadicStringFunc = return . map toUpper,- monadicByteStringFunc = return . B.reverse }+ monadicTextFunc = return . T.reverse } -main = example >>= LZ.putStrLn+main = example >>= TL.putStrLn @ Result:@@ -170,15 +204,94 @@ )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) +#if MIN_VERSION_base(4,7,0) mkGenericContext :: (Monad m, Data a, Typeable m) => a -> MuContext m-#else +#else mkGenericContext :: (Monad m, Data a, Typeable1 m) => a -> MuContext m-#endif -mkGenericContext val = toGenTemp val ~> convertGenTempToContext- +#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)] @@ -186,80 +299,124 @@ | TUnknown deriving (Show) -#if MIN_VERSION_base(4,7,0) -toGenTemp :: (Data a, Monad m, Typeable m) => a -> TD m+#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) => a -> TD m-#endif -toGenTemp a = zip fields (gmapQ procField a) ~> TObj+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+ 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) => a -> TD m+#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) => a -> TD m+procField :: (Data a, Monad m, Typeable1 m) + => (String -> String) -> Ext -> a -> TD m #endif-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+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 [c] -> toGenTemp a+ AlgRep (_:_) -> toGenTemp f g a _ -> TUnknown- list a = map procField a ~> TList+ 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 ~> TSimple+ 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 - muLambdaBSLBS :: (BS.ByteString -> LBS.ByteString) -> TD m- muLambdaBSLBS f = MuLambda f ~> TSimple- -- 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 ~> TSimple+ 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 - muLambdaMBSLBS :: (BS.ByteString -> m LBS.ByteString) -> TD m- muLambdaMBSLBS f = MuLambdaM f ~> TSimple convertGenTempToContext :: Monad m => TD m -> MuContext m convertGenTempToContext v = mkMap "" Map.empty v ~> mkMapContext@@ -279,13 +436,13 @@ mkMapContext m a = return $ case Map.lookup a m of Nothing ->- case a == dotBS of+ case a == dotT of True -> - case Map.lookup BS.empty m of+ case Map.lookup T.empty m of Nothing -> MuNothing Just a -> a _ -> MuNothing Just a -> a -dotBS = encodeStr "."-+dotT :: T.Text+dotT = T.singleton '.'
hastache.cabal view
@@ -1,11 +1,11 @@ name: hastache-version: 0.5.1+version: 0.6.1 license: BSD3 license-file: LICENSE category: Text-copyright: Sergey S Lymar (c) 2011-2013+copyright: Sergey S Lymar (c) 2011-2014 author: Sergey S Lymar <sergey.lymar@gmail.com>-maintainer: Sergey S Lymar <sergey.lymar@gmail.com>+maintainer: Daniil Frumin <dan at covariant.me> stability: experimental synopsis: Haskell implementation of Mustache templates cabal-version: >= 1.8@@ -22,20 +22,36 @@ 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.*+ base >=4 && <4.9 ,bytestring ,mtl ,transformers ,directory ,filepath- ,utf8-string ,text ,containers ,syb@@ -53,7 +69,7 @@ build-depends: hastache- ,base == 4.*+ ,base >=4 && <4.9 ,directory ,mtl ,HUnit
+ mkReadme.hs view
@@ -0,0 +1,50 @@+#!/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
tests/test.hs view
@@ -15,13 +15,14 @@ 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 (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \hello {{! comment #1}} world! \n\@@ -38,7 +39,7 @@ variablesTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context)- assertEqualStr resCorrectness (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \ Char: [ {{Char}} ] \n\@@ -75,7 +76,7 @@ showHideSectionsTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context)- assertEqualStr resCorrectness (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \no context : {{^noCtx}}Should render{{/noCtx}}\n\@@ -129,7 +130,7 @@ listSectionTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context)- assertEqualStr resCorrectness (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \text 1\n\@@ -155,7 +156,7 @@ boolSectionTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context)- assertEqualStr resCorrectness (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \text 1\n\@@ -188,14 +189,14 @@ lambdaSectionTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context)- assertEqualStr resCorrectness (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \text 1\n\ \{{#function}}Hello{{/function}}\n\ \text 2\n\ \"- context "function" = MuLambda BS.reverse+ context "function" = MuLambda T.reverse testRes = "\ \text 1\n\@@ -206,7 +207,7 @@ -- Transform section with monadic function lambdaMSectionTest = do (res, writerState) <- runWriterT monadicFunction- assertEqualStr resCorrectness (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes assertEqualStr "monad state correctness" (decodeStr writerState) testMonad where@@ -218,7 +219,7 @@ \" context "mf" = MuLambdaM $ \i -> do tell i- return $ BS.reverse i+ return $ T.reverse i testRes = "\ \[cba]\n\ \[fed]\n\@@ -231,7 +232,7 @@ (mkStrContextM context) let { res = case r of Left err -> "error: " ++ err- Right res -> decodeStrLBS res }+ Right res -> decodeStrLT res } assertEqualStr resCorrectness res testRes where template = "Hello, {{name}}! You have {{unread}} unread messages. {{some}}"@@ -244,7 +245,7 @@ setDelimiterTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context)- assertEqualStr resCorrectness (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \text 1\n\@@ -269,7 +270,7 @@ partialsTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context)- assertEqualStr resCorrectness (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \text 1\n\@@ -298,7 +299,8 @@ someMuLambdaBS :: BS.ByteString -> BS.ByteString, someMuLambdaS :: String -> String, someMuLambdaMBS :: BS.ByteString -> IO BS.ByteString,- someMuLambdaMS :: String -> IO String+ someMuLambdaMS :: String -> IO String,+ someEitherValue :: Either String Int } deriving (Data, Typeable) @@ -306,7 +308,7 @@ genericContextTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkGenericContext context)- assertEqualStr resCorrectness (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \text 1\n\@@ -328,6 +330,7 @@ \{{#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 {@@ -340,7 +343,8 @@ someMuLambdaBS = BS.reverse, someMuLambdaS = map toUpper, someMuLambdaMBS = return . BS.reverse,- someMuLambdaMS = return . map toUpper+ someMuLambdaMS = return . map toUpper,+ someEitherValue = Right 123 } testRes = "\@@ -361,6 +365,7 @@ \UPPER\n\ \adbmal OI ni esrever\n\ \UPPER IN IO LAMBDA\n\+ \123\n\ \text 2\n\ \" @@ -368,7 +373,7 @@ nestedContextTest = do res <- hastacheStr defaultConfig (encodeStr template) (mkStrContext context)- assertEqualStr resCorrectness (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \{{top}}\n\@@ -403,7 +408,7 @@ nestedGenericContextTest = do res <- hastacheStr defaultConfig (encodeStr template) context- assertEqualStr resCorrectness (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \Top variable : {{topDataTop}}\n\@@ -429,11 +434,42 @@ \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 (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \{{section.0.name}} {{section.1.name}} {{section.2.name}}\n\@@ -464,7 +500,7 @@ arrayItemsTestGeneric = do res <- hastacheStr defaultConfig (encodeStr template) context- assertEqualStr resCorrectness (decodeStrLBS res) testRes+ assertEqualStr resCorrectness (decodeStrLT res) testRes where template = "\ \{{items.0.name}} {{items.2.name}}\n\@@ -480,6 +516,49 @@ \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)@@ -492,12 +571,19 @@ , 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