packages feed

hastache 0.5.1 → 0.6.0

raw patch · 6 files changed

+335/−231 lines, 6 filesdep ~basenew-uploader

Dependency ranges changed: base

Files

+ ChangeLog view
@@ -0,0 +1,5 @@+# 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." @@ -214,15 +214,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)
Text/Hastache.hs view
@@ -18,12 +18,12 @@ @ import Text.Hastache  import Text.Hastache.Context -import qualified Data.ByteString.Lazy.Char8 as LZ +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\"@@ -43,7 +43,7 @@ @ import Text.Hastache  import Text.Hastache.Context -import qualified Data.ByteString.Lazy.Char8 as LZ +import qualified Data.Text.Lazy.IO as TL import Data.Data  import Data.Generics   @@ -55,7 +55,7 @@ main = do      res <- hastacheStr defaultConfig (encodeStr template)          (mkGenericContext inf) -    LZ.putStrLn res +    TL.putStrLn res    where      template = \"Hello, {{name}}!\\n\\nYou have {{unread}} unread messages.\"     inf = Info \"Haskell\" 100@@ -75,39 +75,39 @@     , 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.Maybe (isJust) import Data.Monoid (mappend, mempty)+import Data.Text hiding (map, foldl1)+import Data.Text.IO 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 +116,88 @@  -- | Data for Hastache variable type MuContext m =-    ByteString      -- ^ Variable name+    Text            -- ^ Variable name     -> m (MuType m) -- ^ Value  class Show a => MuVar a where     -- | Convert to Lazy ByteString-    toLByteString   :: a -> LZ.ByteString +    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 Text.Text where -    toLByteString t = TextEncoding.encodeUtf8 t ~> toLBS-    isEmpty a = Text.length 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 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 +209,51 @@     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}})     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 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 Text to String+decodeStrLT :: TL.Text -> String+decodeStrLT = TL.unpack +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 "&amp;" t-        | h == ord8 '\\'= stp "&#92;" t-        | h == ord8 '"' = stp "&quot;" t-        | h == ord8 '\''= stp "&#39;" t-        | h == ord8 '<' = stp "&lt;" t-        | h == ord8 '>' = stp "&gt;" t-        | otherwise     = h : proc t-    proc [] = []-    stp a t = map ord8 a ++ proc t+htmlEscape :: TL.Text -> TL.Text+htmlEscape = TL.concatMap proc+  where+    proc '&'  = "&amp;"+    proc '\\' = "&#92;"+    proc '"'  = "&quot;"+    proc '\'' = "&#39;"+    proc '<'  = "&lt;"+    proc '>'  = "&gt;"+    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 +266,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 +335,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 +436,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 +449,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 +465,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 +480,7 @@                     processBlock (trim' afterClose) contexts                         newOTag newCTag conf     -- partials-    | symb == ord8 '>' =+    | symb == '>' =         let              fileName' = tail inTag ~> trimAll             fileName'' = case muTemplateFileExt conf of@@ -477,41 +495,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 +539,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
@@ -24,8 +24,9 @@ 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 @@ -84,13 +85,25 @@  * Data.Text.Lazy.Text    * Bool++ * 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 +114,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,9 +134,9 @@     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) @@ -139,18 +153,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,13 +184,27 @@ )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                    +#endif mkGenericContext val = toGenTemp val ~> convertGenTempToContext      data TD m = @@ -186,16 +214,17 @@     | TUnknown     deriving (Show) -#if MIN_VERSION_base(4,7,0)                                 +#if MIN_VERSION_base(4,7,0) toGenTemp :: (Data a, Monad m, Typeable m) => a -> TD m #else toGenTemp :: (Data a, Monad m, Typeable1 m) => a -> TD m-#endif             -toGenTemp a = zip fields (gmapQ procField a) ~> TObj+#endif+toGenTemp a = TObj $ conName : zip fields (gmapQ procField a)     where     fields = toConstr a ~> constrFields+    conName = (toConstr a ~> showConstr, MuBool True ~> TSimple) -#if MIN_VERSION_base(4,7,0) +#if MIN_VERSION_base(4,7,0) procField :: (Data a, Monad m, Typeable m) => a -> TD m #else procField :: (Data a, Monad m, Typeable1 m) => a -> TD m@@ -220,46 +249,71 @@     `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` (\(i::T.Text)            -> MuVariable i ~> TSimple)+    `extQ` (\(i::TL.Text)           -> MuVariable i ~> TSimple)+    `extQ` (\(i::Bool)              -> MuBool 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     where     obj a = case dataTypeRep (dataTypeOf a) of-        AlgRep [c] -> toGenTemp a+        AlgRep (_:_) -> toGenTemp a         _ -> TUnknown     list a = map procField a ~> TList +    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 +333,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.0 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,6 +22,7 @@     tests/RunTest.sh     tests/test.hs     README.md+    ChangeLog  library   exposed-modules:
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\@@ -306,7 +307,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\@@ -368,7 +369,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 +404,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\@@ -433,7 +434,7 @@ 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 +465,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 +481,29 @@         \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"++ tests = TestList [       TestLabel "Comments test" (TestCase commentsTest)     , TestLabel "Variables test" (TestCase variablesTest)@@ -492,6 +516,8 @@     , 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)