diff --git a/ChangeLog b/ChangeLog new file mode 100644 --- /dev/null +++ b/ChangeLog @@ -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`, `()`) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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) diff --git a/Text/Hastache.hs b/Text/Hastache.hs --- a/Text/Hastache.hs +++ b/Text/Hastache.hs @@ -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 "&" 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 +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 diff --git a/Text/Hastache/Context.hs b/Text/Hastache/Context.hs --- a/Text/Hastache/Context.hs +++ b/Text/Hastache/Context.hs @@ -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 '.' diff --git a/hastache.cabal b/hastache.cabal --- a/hastache.cabal +++ b/hastache.cabal @@ -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 -maintainer: Sergey S Lymar +maintainer: Daniil Frumin 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: diff --git a/tests/test.hs b/tests/test.hs --- a/tests/test.hs +++ b/tests/test.hs @@ -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)