diff --git a/StrappedTemplates.cabal b/StrappedTemplates.cabal --- a/StrappedTemplates.cabal +++ b/StrappedTemplates.cabal @@ -1,5 +1,5 @@ name: StrappedTemplates -version: 0.1.0.0 +version: 0.1.1.0 synopsis: General purpose templates in haskell homepage: https://github.com/hansonkd/StrappedTemplates license: BSD3 @@ -22,12 +22,13 @@ > makeBucket :: Integer -> InputBucket IO > makeBucket i = bucketFromList > [ ("is", List $ map (LitVal . LitInteger) [1..i]) + > , ("is_truthy", LitVal $ LitInteger i) > , ("ioTime", Func (\_ -> (liftIO $ getCurrentTime) >>= (\c -> return $ LitText $ T.pack $ show c))) > ] > > main :: IO () > main = do - > tmpls <- templateStoreFromDirectory "benchmarks/strapped_templates" ".strp" + > tmpls <- templateStoreFromDirectory "examples/templates" ".strp" > case tmpls of > Left err -> print err > Right store -> do @@ -35,16 +36,36 @@ > either (print) (print . B.toByteString) rendered . @ -  ${ ioTime } +  {$ inherits base.strp $}   +  {$ isblock body $} +   +  An IO function to find the current time: ${ ioTime } +   +  {$ if is_truthy $} +   {$ inherits base.strp $} +   {$ isblock body $} +   Any block level can inherit from another template and override blocks. +   {$ endisblock $} +  {$ else $} +   Don't show me. +  {$ endif $} +   +  Taken from an includes: +  {$ include includes/includes.strp $} +   +  Lets count...  {$ for i in is $}   ${ i }  {$ endfor $} +   +  {$ endisblock $} @ library exposed-modules: Text.Strapped, Text.Strapped.Parser, Text.Strapped.Render, Text.Strapped.Types, Text.Strapped.Utils build-depends: base >= 4.7 && < 4.8, + bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.6, text >= 1.0 && < 1.2, blaze-builder >=0.3 && < 0.4, diff --git a/src/Text/Strapped/Parser.hs b/src/Text/Strapped/Parser.hs --- a/src/Text/Strapped/Parser.hs +++ b/src/Text/Strapped/Parser.hs @@ -30,6 +30,8 @@ peekChar :: Char -> GenParser Char st () peekChar = void . try . lookAhead . char +peekTag = void . try . lookAhead . tag + tryTag :: GenParser Char st a -> GenParser Char st () tryTag = void . try . tag @@ -85,6 +87,14 @@ s <- manyTill anyChar (tryTag (string "endcomment")) return $ ParsedPiece (StaticPiece mempty) pos +parseIf :: GenParser Char st ParsedPiece +parseIf = do + pos <- getPosition + exp <- (tagStart >> spaces >> string "if" >> spaces >> parseExpression (try $ spaces >> tagEnd)) "If tag" + positive <- parseContent ((peekTag $ string "endif") <|> (tryTag $ string "else")) + negative <- parseContent (tryTag $ string "endif") + return $ ParsedPiece (IfPiece exp positive negative) pos + parseFor :: GenParser Char st ParsedPiece parseFor = do pos <- getPosition @@ -141,8 +151,9 @@ exp <- try parseList <|> try (parseString '\"') <|> try (parseString '\'') <|> - try (parseFloat >>= (return . FloatExpression)) <|> - try (parseInt >>= (return . IntegerExpression)) <|> + try (parseFloat >>= (return . LiteralExpression . LitDouble)) <|> + try (parseInt >>= (return . LiteralExpression . LitInteger)) <|> + try (parseBool >>= (return . LiteralExpression . LitBool)) <|> literal return $ ParsedExpression exp pos parens = (string "(" >> spaces) >> parseExpression (try $ spaces >> string ")") @@ -154,7 +165,8 @@ pos <- getPosition pieces <- manyTill (spaces >> parseGroup) end return $ ParsedExpression (Multipart pieces) pos - parseString esc = parseStringContents esc >>= (return . StringExpression) + parseString esc = parseStringContents esc >>= (return . LiteralExpression . LitText . T.pack) + parseBool = (try $ string "True" >> return True) <|> (try $ string "False" >> return False) literal = wordString >>= (return . LookupExpression) parseStringContents :: Char -> GenParser Char st String @@ -176,6 +188,7 @@ parseNonStatic = try parseComment <|> try parseRaw <|> try parseBlock + <|> try parseIf <|> try parseFor <|> try parseInclude <|> parseFunc diff --git a/src/Text/Strapped/Render.hs b/src/Text/Strapped/Render.hs --- a/src/Text/Strapped/Render.hs +++ b/src/Text/Strapped/Render.hs @@ -30,6 +30,7 @@ renderOutput _ (LitSafe s) = fromLazyText s renderOutput rc (LitInteger i) = fromShow i renderOutput rc (LitDouble i) = fromShow i + renderOutput rc (LitBool i) = fromShow i renderOutput _ (LitBuilder b) = b renderOutput rc (LitList l) = (fromChar '[') <> (mconcat $ intersperse (fromChar ',') (map (renderOutput rc) l)) <> @@ -64,9 +65,7 @@ reduceExpression :: Monad m => RenderConfig -> ParsedExpression -> InputBucket m -> ExceptT StrapError m Literal reduceExpression c (ParsedExpression exp pos) getter = convert exp where convertMore exp = reduceExpression c exp getter - convert (IntegerExpression i) = return $ LitInteger i - convert (FloatExpression i) = return $ LitDouble i - convert (StringExpression s) = return $ LitText (T.pack s) + convert (LiteralExpression i) = return $ i convert (Multipart []) = return $ LitEmpty convert (Multipart (f:[])) = convertMore f convert (Multipart ((ParsedExpression (LookupExpression func) ipos):args)) = do @@ -106,6 +105,11 @@ case var of LitList l -> (processFor getter n c accum blks l) >>= (\a -> loop a blks getter ps) _ -> throwError $ StrapError ("`" ++ show exp ++ "` is not a LitList") pos + loop accum blks getter ((ParsedPiece (IfPiece exp p n) pos):ps) = do + var <- reduceExpression renderConfig exp getter + case (toBool var) of + True -> (loop accum blks getter p) >>= (\a -> loop a blks getter ps) + False -> (loop accum blks getter n) >>= (\a -> loop a blks getter ps) loop accum blks getter ((ParsedPiece (Inherits n b) pos):ps) = liftIO (tmplStore n) >>= maybe (throwError (TemplateNotFound n pos)) diff --git a/src/Text/Strapped/Types.hs b/src/Text/Strapped/Types.hs --- a/src/Text/Strapped/Types.hs +++ b/src/Text/Strapped/Types.hs @@ -3,10 +3,11 @@ import Blaze.ByteString.Builder import Control.Monad.Except -import Data.List (intersperse) +import qualified Data.ByteString.Lazy.Char8 as BS +import Data.List as L (intersperse, null) import qualified Data.Map as M import Data.Monoid (mconcat) -import Data.Text.Lazy (Text) +import Data.Text.Lazy as T (Text, null, unpack) import Data.Typeable import Text.Parsec.Pos @@ -17,17 +18,13 @@ data Expression = LookupExpression String | - IntegerExpression Integer | - FloatExpression Double | - StringExpression String | + LiteralExpression Literal | ListExpression [ParsedExpression] | Multipart [ParsedExpression] instance Show Expression where show (LookupExpression s) = s - show (IntegerExpression s) = show s - show (FloatExpression s) = show s - show (StringExpression s) = "\"" ++ s ++ "\"" + show (LiteralExpression s) = show s show (ListExpression l) = "[" ++ (mconcat $ intersperse "," (map show l)) ++ "]" show (Multipart l) = mconcat $ map show l @@ -39,6 +36,7 @@ data Piece = StaticPiece Output | BlockPiece String [ParsedPiece] | ForPiece String ParsedExpression [ParsedPiece] + | IfPiece ParsedExpression [ParsedPiece] [ParsedPiece] | FuncPiece ParsedExpression | Decl String ParsedExpression | Include String @@ -63,7 +61,34 @@ | LitDouble Double | LitBuilder Builder | LitList ![Literal] + | LitBool Bool | LitEmpty + +class Booly a where + toBool :: a -> Bool + +instance Booly Literal where + toBool (LitDyn a) = maybe False id (cast a) + toBool (LitText a) = not $ T.null a + toBool (LitSafe a) = not $ T.null a + toBool (LitInteger a) = (0 /= a) + toBool (LitDouble a) = (0.0 /= a) + toBool (LitBuilder a) = not $ BS.null $ (toLazyByteString a) + toBool (LitList a) = not $ L.null a + toBool (LitBool a) = a + toBool LitEmpty = False + +instance Show Literal where + show (LitDyn a) = "LitDyn" + show (LitText a) = T.unpack a + show (LitSafe a) = T.unpack a + show (LitInteger a) = show a + show (LitDouble a) = show a + show (LitBuilder a) = BS.unpack $ (toLazyByteString a) + show (LitList a) = show a + show (LitBool a) = show a + show LitEmpty = "" + data StrapError = StrapError String SourcePos | InputNotFound String SourcePos diff --git a/tests/StrappedTest.hs b/tests/StrappedTest.hs --- a/tests/StrappedTest.hs +++ b/tests/StrappedTest.hs @@ -61,6 +61,9 @@ it "Checks Function" $ (render ts mainBucket "func") `renderShouldBe` (Right "4") + describe "If" $ + it "Checks if" $ + (render ts mainBucket "if") `renderShouldBe` (Right "show me") main = do let ets = templateStoreFromList @@ -73,5 +76,6 @@ , ("base", "Some base {$ block some_block $}blah blah {$ endblock $}") , ("inherits", "{$ inherits base $}{$ isblock some_block $}override{$ endisblock $}") , ("func", "${ addNumbers [(addNumbers [1, 1]), 2] }") + , ("if", "{$ if True $}show me{$ else $}dont show{$ endif $}{$ if False $}shouldn't see{$ endif $}") ] either (\_ -> exitFailure) (\ts -> hspec $ spec (defaultConfig {templateStore = ts})) ets