diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/Text/Hastache.hs b/Text/Hastache.hs --- a/Text/Hastache.hs +++ b/Text/Hastache.hs @@ -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 -- 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 diff --git a/Text/Hastache/Context.hs b/Text/Hastache/Context.hs --- a/Text/Hastache/Context.hs +++ b/Text/Hastache/Context.hs @@ -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 -- 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 diff --git a/hastache.cabal b/hastache.cabal --- a/hastache.cabal +++ b/hastache.cabal @@ -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 maintainer: Sergey S Lymar 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 diff --git a/tests/test.hs b/tests/test.hs --- a/tests/test.hs +++ b/tests/test.hs @@ -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) ]