hastache 0.4.2 → 0.5.0

raw patch · 5 files changed

+146/−96 lines, 5 filesdep +HUnitdep +hastachedep +transformersdep ~basedep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, hastache, transformers

Dependency ranges changed: base, mtl

API changes (from Hackage documentation)

Files

• README.md +2/−2
• Text/Hastache.hs +71/−57
• Text/Hastache/Context.hs +11/−6
• hastache.cabal +17/−2
• tests/test.hs +45/−29

@@ -20,7 +20,7 @@ ```haskell import Text.Hastache  import Text.Hastache.Context -import qualified Data.ByteString.Lazy as LZ +import qualified Data.ByteString.Lazy.Char8 as LZ   main = hastacheStr defaultConfig (encodeStr template) (mkStrContext context)     >>= LZ.putStrLn@@ -215,7 +215,7 @@ {-# LANGUAGE FlexibleContexts #-} import Text.Hastache  import Text.Hastache.Context -import qualified Data.ByteString.Lazy as LZ +import qualified Data.ByteString.Lazy.Char8 as LZ  import Control.Monad.State   main = run >>= LZ.putStrLn

@@ -1,7 +1,7 @@ {-# LANGUAGE ExistentialQuantification, FlexibleInstances, IncoherentInstances,              OverloadedStrings #-} -- Module:      Text.Hastache--- Copyright:   Sergey S Lymar (c) 2011 +-- Copyright:   Sergey S Lymar (c) 2011-2013  -- License:     BSD3 -- Maintainer:  Sergey S Lymar <sergey.lymar@gmail.com> -- Stability:   experimental@@ -18,13 +18,13 @@ @ import Text.Hastache  import Text.Hastache.Context -import qualified Data.ByteString.Lazy as LZ +import qualified Data.ByteString.Lazy.Char8 as LZ   main = do      res <- hastacheStr defaultConfig (encodeStr template)           (mkStrContext context)      LZ.putStrLn res -    where +  where      template = \"Hello, {{name}}!\\n\\nYou have {{unread}} unread messages.\"      context \"name\" = MuVariable \"Haskell\"     context \"unread\" = MuVariable (100 :: Int)@@ -43,7 +43,7 @@ @ import Text.Hastache  import Text.Hastache.Context -import qualified Data.ByteString.Lazy as LZ +import qualified Data.ByteString.Lazy.Char8 as LZ  import Data.Data  import Data.Generics   @@ -56,7 +56,7 @@     res <- hastacheStr defaultConfig (encodeStr template)          (mkGenericContext inf)      LZ.putStrLn res -    where +  where      template = \"Hello, {{name}}!\\n\\nYou have {{unread}} unread messages.\"     inf = Info \"Haskell\" 100 @@@ -80,13 +80,15 @@     , decodeStrLBS     ) where  -import Control.Monad (guard, when)+import Control.Monad (guard, when, 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)@@ -100,6 +102,7 @@ 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.Foldable as F import qualified Data.List as List import qualified Data.Text as Text import qualified Data.Text.Encoding as TextEncoding@@ -112,9 +115,9 @@ infixl 9 ~>  -- | Data for Hastache variable-type MuContext m = -    ByteString  -- ^ Variable name-    -> MuType m -- ^ Value+type MuContext m =+    ByteString      -- ^ Variable name+    -> m (MuType m) -- ^ Value  class Show a => MuVar a where     -- | Convert to Lazy ByteString@@ -189,13 +192,16 @@     show (MuLambdaM _) = "MuLambdaM <..>"     show MuNothing = "MuNothing" -data MuConfig = MuConfig {+data MuConfig m = MuConfig {     muEscapeFunc        :: LZ.ByteString -> LZ.ByteString,          -- ^ Escape function ('htmlEscape', 'emptyEscape' etc.)     muTemplateFileDir   :: Maybe FilePath,         -- ^ Directory for search partial templates ({{> templateName}})-    muTemplateFileExt   :: Maybe String+    muTemplateFileExt   :: Maybe String,         -- ^ Partial template files extension+    muTemplateRead      :: FilePath -> m (Maybe ByteString)+        -- ^ Template retrieval function. 'Nothing' indicates that the+        --   template could not be found.     }  -- | Convert String to UTF-8 Bytestring@@ -242,13 +248,21 @@  {- | Default config: HTML escape function, current directory as       template directory, template file extension not specified -}-defaultConfig :: MuConfig -defaultConfig = MuConfig { +defaultConfig :: MonadIO m => MuConfig m+defaultConfig = MuConfig {     muEscapeFunc = htmlEscape,     muTemplateFileDir = Nothing,-    muTemplateFileExt = Nothing-    } +    muTemplateFileExt = Nothing,+    muTemplateRead = liftIO . defaultTemplateRead+    } +defaultTemplateRead :: FilePath -> IO (Maybe ByteString)+defaultTemplateRead fullFileName = do+    fe <- doesFileExist fullFileName+    if fe+        then Just <$> readFile fullFileName+        else return Nothing+ defOTag = "{{" :: ByteString defCTag = "}}" :: ByteString unquoteCTag = "}}}" :: ByteString@@ -275,35 +289,38 @@ toLBS :: ByteString -> LZ.ByteString toLBS v = LZ.fromChunks [v] --readVar :: MonadIO m => [MuContext m] -> ByteString -> LZ.ByteString-readVar [] _ = LZ.empty-readVar (context:parentCtx) name =-    case context name of-        MuVariable a -> toLByteString a-        MuBool a -> show a ~> encodeStr ~> toLBS-        MuNothing -> case tryFindArrayItem context name of+readVar :: MonadIO m => [MuContext m] -> ByteString -> m LZ.ByteString+readVar [] _ = return LZ.empty+readVar (context:parentCtx) name = do+    muType <- context name+    case muType of+        MuVariable a -> return $ toLByteString a+        MuBool a -> return $ show a ~> encodeStr ~> toLBS+        MuNothing -> do+          mb <- runMaybeT $ tryFindArrayItem context name+          case mb of             Just (nctx,nn) -> readVar [nctx] nn             _ -> readVar parentCtx name-        _ -> LZ.empty+        _ -> return LZ.empty  tryFindArrayItem :: MonadIO m =>         MuContext m-    -> ByteString -    -> Maybe (MuContext m, ByteString)+    -> ByteString+    -> MaybeT m (MuContext m, ByteString) tryFindArrayItem context name = do     guard $ length idx > 1-    (idx,nxt) <- readInt $ tail idx+    (idx,nxt) <- MaybeT $ return $ readInt $ tail idx     guard $ idx >= 0     guard $ (null nxt) || ((head nxt) == (ord8 '.'))-    case context nm of+    muType <- lift $ context nm+    case muType of         MuList l -> do             guard $ idx < (List.length l)             let ncxt = l !! idx-            if null nxt -                then Just (ncxt, dotStr) -- {{some.0}}-                else Just (ncxt, tail nxt) -- {{some.0.field}}-        _ -> Nothing+            if null nxt+                then return (ncxt, dotStr) -- {{some.0}}+                else return (ncxt, tail nxt) -- {{some.0.field}}+        _ -> mzero     where     (nm,idx) = breakSubstring dotStr name     dotStr = "."@@ -346,7 +363,7 @@     -> [MuContext m]      -> ByteString      -> ByteString -    -> MuConfig +    -> MuConfig m     -> ReaderT (IORef BSB.Builder) m () processBlock str contexts otag ctag conf =      case findBlock str otag ctag of@@ -364,14 +381,14 @@     -> ByteString      -> ByteString     -> ByteString -    -> MuConfig +    -> MuConfig m     -> 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+        addResLZ =<< lift (readVar contexts (tail inTag ~> trimAll))         next afterClose     -- section, inverted section     | symb == ord8 '#' || symb == ord8 '^' = @@ -389,22 +406,21 @@                             then dropNL afterSection'                             else afterSection'                     tlInTag = tail inTag-                    readContext' = map ($ tlInTag) contexts -                        ~> List.find (not . isMuNothing)+                    readContext' = MaybeT $ liftM (List.find (not . isMuNothing)) $+                                     mapM ($ tlInTag) contexts                     readContextWithIdx = do-                        Just (ctx,name) <- map (-                            \c -> tryFindArrayItem c tlInTag) -                            contexts ~> List.find isJust-                        Just $ ctx name-                    readContext = case readContext' of-                        Just a -> Just a-                        Nothing -> readContextWithIdx-                    processAndNext = do +                      (ctx,name) <- Prelude.foldr mplus mzero $+                                    map (\c -> tryFindArrayItem c tlInTag) contexts+                      lift $ ctx name+                    readContext = readContext' `mplus` readContextWithIdx+                    processAndNext = do                         processBlock sectionContent contexts otag ctag conf                         next afterSection-                in +                in do+                mbCtx <- lift $ runMaybeT readContext                 if symb == ord8 '#'-                    then case readContext of -- section+                    then+                      case mbCtx of -- section                         Just (MuList []) -> next afterSection                         Just (MuList b) -> do                             mapM_ (\c -> processBlock sectionContent@@ -422,7 +438,7 @@                             toLByteString res ~> addResLZ                             next afterSection                         _ -> next afterSection-                    else case readContext of -- inverted section+                    else case mbCtx of -- inverted section                         Just (MuList []) -> processAndNext                         Just (MuBool False) -> processAndNext                         Just (MuVariable a) -> if isEmpty a @@ -457,14 +473,12 @@                 Nothing -> fileName                 Just path -> combine path fileName         in do-            fe <- liftIO $ doesFileExist fullFileName-            when fe $ do-                cnt <- liftIO $ readFile fullFileName-                next cnt+            F.mapM_ next =<< lift (muTemplateRead conf fullFileName)             next (trim' afterClose)     -- variable     | otherwise = do-        readVar contexts (trimAll inTag) ~> muEscapeFunc conf ~> addResLZ+        addResLZ . muEscapeFunc conf =<<+          lift (readVar contexts $ trimAll inTag)         next afterClose     where     next t = processBlock t contexts otag ctag conf@@ -476,7 +490,7 @@  -- | Render Hastache template from ByteString hastacheStr :: (MonadIO m) => -       MuConfig         -- ^ Configuration+       MuConfig m       -- ^ Configuration     -> ByteString       -- ^ Template     -> MuContext m      -- ^ Context     -> m LZ.ByteString@@ -485,7 +499,7 @@  -- | Render Hastache template from file hastacheFile :: (MonadIO m) => -       MuConfig         -- ^ Configuration+       MuConfig m       -- ^ Configuration     -> FilePath         -- ^ Template file name     -> MuContext m      -- ^ Context     -> m LZ.ByteString@@ -494,7 +508,7 @@  -- | Render Hastache template from ByteString hastacheStrBuilder :: (MonadIO m) => -       MuConfig         -- ^ Configuration+       MuConfig m       -- ^ Configuration     -> ByteString       -- ^ Template     -> MuContext m      -- ^ Context     -> m BSB.Builder@@ -505,7 +519,7 @@  -- | Render Hastache template from file hastacheFileBuilder :: (MonadIO m) => -       MuConfig         -- ^ Configuration+       MuConfig m       -- ^ Configuration     -> FilePath         -- ^ Template file name     -> MuContext m      -- ^ Context     -> m BSB.Builder

@@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} -- Module:      Text.Hastache.Context--- Copyright:   Sergey S Lymar (c) 2011 +-- Copyright:   Sergey S Lymar (c) 2011-2013  -- License:     BSD3 -- Maintainer:  Sergey S Lymar <sergey.lymar@gmail.com> -- Stability:   experimental@@ -11,6 +11,7 @@ -} module Text.Hastache.Context (       mkStrContext+    , mkStrContextM     , mkGenericContext     ) where  @@ -32,8 +33,12 @@  -- | Make Hastache context from String -> MuType function mkStrContext :: Monad m => (String -> MuType m) -> MuContext m-mkStrContext f a = decodeStr a ~> f+mkStrContext f a = decodeStr a ~> f ~> return +-- | Make Hastache context from monadic String -> MuType function+mkStrContextM :: Monad m => (String -> m (MuType m)) -> MuContext m+mkStrContextM f a = decodeStr a ~> f+ {- |  Make Hastache context from Data.Data deriving type @@ -242,7 +247,7 @@     muLambdaMBSLBS :: (BS.ByteString -> m LBS.ByteString) -> TD m     muLambdaMBSLBS f = MuLambdaM f ~> TSimple -convertGenTempToContext :: TD t -> MuContext t+convertGenTempToContext :: Monad m => TD m -> MuContext m convertGenTempToContext v = mkMap "" Map.empty v ~> mkMapContext     where     mkMap name m (TSimple t) = Map.insert (encodeStr name) t m@@ -257,9 +262,9 @@         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 -> ++    mkMapContext m a = return $ case Map.lookup a m of+        Nothing ->             case a == dotBS of                 True ->                      case Map.lookup BS.empty m of

@@ -1,9 +1,9 @@ name:            hastache-version:         0.4.2+version:         0.5.0 license:         BSD3 license-file:    LICENSE category:        Text-copyright:       Sergey S Lymar (c) 2011-2012+copyright:       Sergey S Lymar (c) 2011-2013 author:          Sergey S Lymar <sergey.lymar@gmail.com> maintainer:      Sergey S Lymar <sergey.lymar@gmail.com> stability:       experimental@@ -35,6 +35,7 @@     base == 4.*     ,bytestring     ,mtl+    ,transformers     ,directory     ,filepath     ,utf8-string@@ -47,3 +48,17 @@ source-repository head   type:     git   location: http://github.com/lymar/hastache++test-suite test-hastache+  type:           exitcode-stdio-1.0+  main-is:        test.hs+  hs-source-dirs: tests++  build-depends:+    hastache+   ,base == 4.*+   ,mtl+   ,HUnit+   ,text+   ,bytestring+   ,syb

@@ -1,7 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-}-module Tests where+module Main where  import Control.Monad+import Control.Monad.Error import Control.Monad.Writer import Data.Char import Data.Data@@ -33,7 +34,7 @@  -- Variables variablesTest = do-    res <- hastacheStr defaultConfig (encodeStr template) +    res <- hastacheStr defaultConfig (encodeStr template)         (mkStrContext context)     assertEqualStr resCorrectness (decodeStrLBS res) testRes     where@@ -70,7 +71,7 @@  -- Show/hide sections showHideSectionsTest = do-    res <- hastacheStr defaultConfig (encodeStr template) +    res <- hastacheStr defaultConfig (encodeStr template)         (mkStrContext context)     assertEqualStr resCorrectness (decodeStrLBS res) testRes     where@@ -124,7 +125,7 @@  -- Render list listSectionTest = do-    res <- hastacheStr defaultConfig (encodeStr template) +    res <- hastacheStr defaultConfig (encodeStr template)         (mkStrContext context)     assertEqualStr resCorrectness (decodeStrLBS res) testRes     where@@ -138,7 +139,7 @@         \"     context "section" = MuList $ map nameCtx ["Neo", "Morpheus", "Trinity"]     nameCtx name = mkStrContext (\"name" -> MuVariable name)-    +     testRes = "\         \text 1\n\         \ * Neo \n\@@ -150,7 +151,7 @@  -- Show/hide block according to boolean variable boolSectionTest = do-    res <- hastacheStr defaultConfig (encodeStr template) +    res <- hastacheStr defaultConfig (encodeStr template)         (mkStrContext context)     assertEqualStr resCorrectness (decodeStrLBS res) testRes     where@@ -183,7 +184,7 @@  -- Transorm section lambdaSectionTest = do-    res <- hastacheStr defaultConfig (encodeStr template) +    res <- hastacheStr defaultConfig (encodeStr template)         (mkStrContext context)     assertEqualStr resCorrectness (decodeStrLBS res) testRes     where@@ -207,10 +208,8 @@     assertEqualStr "monad state correctness" (decodeStr writerState)         testMonad     where-    monadicFunction = do-        res <- hastacheStr defaultConfig (encodeStr template) +    monadicFunction = hastacheStr defaultConfig (encodeStr template)             (mkStrContext context)-        return res     template = "\         \[{{#mf}}abc{{/mf}}]\n\         \[{{#mf}}def{{/mf}}]\n\@@ -224,9 +223,24 @@         \"     testMonad = "abcdef" +-- Monadic context function+monadicContextTest = do+    r <- runErrorT $ hastacheStr defaultConfig (encodeStr template)+        (mkStrContextM context)+    let { res = case r of+        Left err  -> "error: " ++ err+        Right res -> decodeStrLBS res }+    assertEqualStr resCorrectness res testRes+    where+    template = "Hello, {{name}}! You have {{unread}} unread messages. {{some}}"+    context "name"   = return $ MuVariable "Haskell"+    context "unread" = return $ MuVariable (100 :: Int)+    context var      = throwError $ "{{" ++ var  ++ "}} not found!"+    testRes = "error: {{some}} not found!"+ -- Change delimiters setDelimiterTest = do-    res <- hastacheStr defaultConfig (encodeStr template) +    res <- hastacheStr defaultConfig (encodeStr template)         (mkStrContext context)     assertEqualStr resCorrectness (decodeStrLBS res) testRes     where@@ -251,7 +265,7 @@  -- Render external (partial) template file partialsTest = do-    res <- hastacheStr defaultConfig (encodeStr template) +    res <- hastacheStr defaultConfig (encodeStr template)         (mkStrContext context)     assertEqualStr resCorrectness (decodeStrLBS res) testRes     where@@ -350,7 +364,7 @@  -- Up-level context from nested block nestedContextTest = do-    res <- hastacheStr defaultConfig (encodeStr template) +    res <- hastacheStr defaultConfig (encodeStr template)         (mkStrContext context)     assertEqualStr resCorrectness (decodeStrLBS res) testRes     where@@ -362,7 +376,7 @@         \"     context "section" = MuList $ map elemCtx ["elem 1", "elem 2"]     context "top" = MuVariable "top"-    elemCtx vl = mkStrContext (\v -> case v of +    elemCtx vl = mkStrContext (\v -> case v of         "val" -> MuVariable vl         _ -> MuNothing         )@@ -415,7 +429,7 @@  -- Accessing array item by index arrayItemsTest = do-    res <- hastacheStr defaultConfig (encodeStr template) +    res <- hastacheStr defaultConfig (encodeStr template)         (mkStrContext context)     assertEqualStr resCorrectness (decodeStrLBS res) testRes     where@@ -465,20 +479,22 @@         \"  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)-    ,TestLabel "Accessing array item by index" (TestCase arrayItemsTest)-    ,TestLabel "Accessing array item by index (generic version)" +      TestLabel "Comments test" (TestCase commentsTest)+    , TestLabel "Variables test" (TestCase variablesTest)+    , TestLabel "Show/hide sections test" (TestCase showHideSectionsTest)+    , TestLabel "List test" (TestCase listSectionTest)+    , TestLabel "Bool test" (TestCase boolSectionTest)+    , TestLabel "Lambda test" (TestCase lambdaSectionTest)+    , TestLabel "LambdaM test" (TestCase lambdaMSectionTest)+    , TestLabel "Monadic context test" (TestCase monadicContextTest)+    , TestLabel "Set delimiter test" (TestCase setDelimiterTest)+    , TestLabel "Partials test" (TestCase partialsTest)+    , TestLabel "Generic context test" (TestCase genericContextTest)+    , TestLabel "Nested context test" (TestCase nestedContextTest)+    , TestLabel "Nested generic context test" +                                        (TestCase nestedGenericContextTest)+    , TestLabel "Accessing array item by index" (TestCase arrayItemsTest)+    , TestLabel "Accessing array item by index (generic version)"          (TestCase arrayItemsTestGeneric)     ]