StrappedTemplates 0.1.0.0 → 0.1.1.0
raw patch · 5 files changed
+84/−17 lines, 5 files
Files
- StrappedTemplates.cabal +24/−3
- src/Text/Strapped/Parser.hs +16/−3
- src/Text/Strapped/Render.hs +7/−3
- src/Text/Strapped/Types.hs +33/−8
- tests/StrappedTest.hs +4/−0
StrappedTemplates.cabal view
@@ -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,
src/Text/Strapped/Parser.hs view
@@ -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
src/Text/Strapped/Render.hs view
@@ -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))
src/Text/Strapped/Types.hs view
@@ -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
tests/StrappedTest.hs view
@@ -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