haiji 0.2.3.0 → 0.3.0.0
raw patch · 9 files changed
+162/−64 lines, 9 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- haiji.cabal +4/−2
- src/Text/Haiji/Runtime.hs +5/−4
- src/Text/Haiji/Syntax.hs +2/−0
- src/Text/Haiji/Syntax/Expression.hs +16/−1
- src/Text/Haiji/Syntax/Literal.hs +5/−0
- src/Text/Haiji/Syntax/Literal/String.hs +63/−0
- src/Text/Haiji/TH.hs +9/−8
- src/Text/Haiji/Types.hs +2/−5
- test/tests.hs +56/−44
haiji.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: haiji-version: 0.2.3.0+version: 0.3.0.0 synopsis: A typed template engine, subset of jinja2 description: Haiji is a template engine which is subset of jinja2. This is designed to free from the unintended rendering result@@ -11,7 +11,7 @@ license-file: LICENSE author: Noriyuki OHKAWA <n.ohkawa@gmail.com> maintainer: Noriyuki OHKAWA <n.ohkawa@gmail.com>-copyright: Copyright (c) 2014, Noriyuki OHKAWA+copyright: Copyright (c) 2014-2019, Noriyuki OHKAWA category: Text build-type: Simple -- extra-source-files:@@ -33,6 +33,8 @@ Text.Haiji.Syntax.Identifier Text.Haiji.Syntax.Filter Text.Haiji.Syntax.Expression+ Text.Haiji.Syntax.Literal+ Text.Haiji.Syntax.Literal.String build-depends: base >=4.7 && <5 , text , attoparsec >=0.10
src/Text/Haiji/Runtime.hs view
@@ -65,7 +65,7 @@ case arr of JSON.Array dicts -> do p <- ask- let len = V.length dicts+ let len = toInteger $ V.length dicts if 0 < len then return $ LT.concat [ runReader (haijiASTs env parentBlock children loopBody)@@ -91,7 +91,7 @@ return $ runReader (haijiASTs env parentBlock children scopes) (let JSON.Object obj = p in JSON.Object $ HM.insert (T.pack $ show lhs) val obj) -loopVariables :: Int -> Int -> JSON.Value+loopVariables :: Integer -> Integer -> JSON.Value loopVariables len ix = JSON.object [ "first" JSON..= (ix == 0) , "index" JSON..= (ix + 1) , "index0" JSON..= ix@@ -105,7 +105,8 @@ eval (Expression expression) = go expression where go :: Expr External level -> Reader JSON.Value JSON.Value go (ExprLift e) = go e- go (ExprIntegerLiteral n) = return $ JSON.Number $ scientific (toEnum n) 0+ go (ExprIntegerLiteral n) = return $ JSON.Number $ scientific n 0+ go (ExprStringLiteral s) = return $ JSON.String $ T.pack $ unwrap s go (ExprBooleanLiteral b) = return $ JSON.Bool b go (ExprVariable v) = either error id . JSON.parseEither (JSON.withObject (show v) (JSON..: (T.pack $ show v))) <$> ask go (ExprParen e) = go e@@ -133,7 +134,7 @@ go (ExprFiltered e []) = go e go (ExprFiltered e filters) = applyFilter (last filters) $ ExprFiltered e $ init filters where applyFilter FilterAbs e' = either error id . JSON.parseEither (JSON.withScientific "abs" (return . JSON.Number . abs)) <$> go e'- applyFilter FilterLength e' = either error id . JSON.parseEither (JSON.withArray "length" (return . JSON.Number . flip scientific 0 . toEnum . V.length)) <$> go e'+ applyFilter FilterLength e' = either error id . JSON.parseEither (JSON.withArray "length" (return . JSON.Number . flip scientific 0 . toInteger . V.length)) <$> go e' go (ExprPow e1 e2) = do v1 <- either error id . JSON.parseEither (JSON.withScientific "lhs of (**)" return) <$> go e1
src/Text/Haiji/Syntax.hs view
@@ -7,9 +7,11 @@ , AST(..) , Loaded(..) , parser+ , module L ) where import Text.Haiji.Syntax.AST import Text.Haiji.Syntax.Identifier import Text.Haiji.Syntax.Filter import Text.Haiji.Syntax.Expression+import Text.Haiji.Syntax.Literal as L
src/Text/Haiji/Syntax/Expression.hs view
@@ -20,6 +20,7 @@ import Data.Scientific import Text.Haiji.Syntax.Identifier import Text.Haiji.Syntax.Filter+import Text.Haiji.Syntax.Literal -- $setup -- >>> import Control.Arrow (left)@@ -58,7 +59,8 @@ data Expr visibility level where ExprLift :: Expr visibility lv -> Expr visibility (S lv)- ExprIntegerLiteral :: Int -> Expr visibility Level0+ ExprIntegerLiteral :: Integer -> Expr visibility Level0+ ExprStringLiteral :: StringLiteral -> Expr visibility Level0 ExprBooleanLiteral :: Bool -> Expr visibility Level0 ExprVariable :: Identifier -> Expr visibility Level0 ExprParen :: Expr visibility LevelMax -> Expr visibility Level0@@ -89,6 +91,7 @@ toExternal :: Expr Internal level -> Expr External level toExternal (ExprLift e) = ExprLift $ toExternal e toExternal (ExprIntegerLiteral n) = ExprIntegerLiteral n+toExternal (ExprStringLiteral n) = ExprStringLiteral n toExternal (ExprBooleanLiteral b) = ExprBooleanLiteral b toExternal (ExprVariable i) = ExprVariable i toExternal (ExprParen e) = ExprParen $ toExternal e@@ -123,6 +126,7 @@ instance Show (Expr visibility phase) where show (ExprLift e) = show e show (ExprIntegerLiteral n) = show n+ show (ExprStringLiteral n) = show n show (ExprBooleanLiteral b) = if b then "true" else "false" show (ExprVariable v) = show v show (ExprParen e) = '(' : shows e ")"@@ -162,6 +166,16 @@ -- | --+-- >>> let eval = left (const "parse error") . parseOnly exprStringLiteral+-- >>> eval "'test'"+-- Right 'test'+-- >>> eval "\"test\""+-- Right "test"+exprStringLiteral :: Parser (Expr Internal Level0)+exprStringLiteral = ExprStringLiteral <$> stringLiteral++-- |+-- -- >>> let eval = left (const "parse error") . parseOnly exprBooleanLiteral -- >>> eval "true" -- Right true@@ -210,6 +224,7 @@ exprLevel0 :: Parser (Expr Internal Level0) exprLevel0 = choice [ exprIntegerLiteral+ , exprStringLiteral , exprBooleanLiteral , exprRange , exprVariable
+ src/Text/Haiji/Syntax/Literal.hs view
@@ -0,0 +1,5 @@+module Text.Haiji.Syntax.Literal+ ( module L+ ) where++import Text.Haiji.Syntax.Literal.String as L
+ src/Text/Haiji/Syntax/Literal/String.hs view
@@ -0,0 +1,63 @@+module Text.Haiji.Syntax.Literal.String+ ( StringLiteral+ , stringLiteral+ , unwrap+ ) where++import Data.Attoparsec.Text hiding (string)++-- $setup+-- >>> import Control.Arrow (left)++data StringLiteral = SingleQuotedStringLiteral String+ | DoubleQuotedStringLiteral String+ deriving Eq++unwrap :: StringLiteral -> String+unwrap (SingleQuotedStringLiteral s) = s+unwrap (DoubleQuotedStringLiteral s) = s++instance Show StringLiteral where+ show (SingleQuotedStringLiteral str) = '\'' : (str >>= escape) ++ "'" where+ escape c = maybe [c] id $ lookup c $ ('\'', "\\'") : requireEscape+ show (DoubleQuotedStringLiteral str) = '"' : (str >>= escape) ++ "\"" where+ escape c = maybe [c] id $ lookup c $ ('"', "\\\"") : requireEscape++-- |+--+-- >>> let eval = left (const "parse error") . parseOnly stringLiteral+-- >>> eval "'test'"+-- Right 'test'+-- >>> eval "\"test\""+-- Right "test"+-- >>> eval "'\\\'\"'"+-- Right '\'"'+-- >>> eval "\"\'\\\"\""+-- Right "'\""+stringLiteral :: Parser StringLiteral+stringLiteral = choice [ char '\'' *> (SingleQuotedStringLiteral <$> quotedBy '\'')+ , char '"' *> (DoubleQuotedStringLiteral <$> quotedBy '"')+ ]++requireUnescape :: [(Char, Char)]+requireUnescape = [ ('n', '\n')+ , ('r', '\r')+ , ('b', '\b')+ , ('v', '\v')+ , ('0', '\0')+ , ('t', '\t')+ ]++requireEscape :: [(Char, String)]+requireEscape = [ (b, ['\\', a]) | (a, b) <- requireUnescape ]++quotedBy :: Char -> Parser String+quotedBy = manyTill contents . char where+ contents :: Parser Char+ contents = do+ c <- anyChar+ case c of+ '\\' -> do+ escaped <- anyChar+ return $ maybe escaped id $ lookup escaped requireUnescape+ _ -> return c
src/Text/Haiji/TH.hs view
@@ -72,7 +72,7 @@ haijiAST env parentBlock children (Foreach k xs loopBody elseBody) = runQ [e| do dicts <- $(eval xs) p <- ask- let len = length dicts+ let len = toInteger $ length dicts if 0 < len then return $ LT.concat [ runReader $(haijiASTs env parentBlock children loopBody)@@ -99,7 +99,7 @@ (p `merge` singleton val (Key :: Key $(litT . strTyLit $ show lhs))) |] -loopVariables :: Int -> Int -> Dict '["first" :-> Bool, "index" :-> Int, "index0" :-> Int, "last" :-> Bool, "length" :-> Int, "revindex" :-> Int, "revindex0" :-> Int]+loopVariables :: Integer -> Integer -> Dict '["first" :-> Bool, "index" :-> Integer, "index0" :-> Integer, "last" :-> Bool, "length" :-> Integer, "revindex" :-> Integer, "revindex0" :-> Integer] loopVariables len ix = Dict $ M.fromList [ ("first", toDyn (ix == 0)) , ("index", toDyn (ix + 1)) , ("index0", toDyn ix)@@ -113,20 +113,21 @@ eval (Expression expression) = go expression where go :: Quasi q => Expr External level -> q Exp go (ExprLift e) = go e- go (ExprIntegerLiteral n) = runQ [e| return (n :: Int) |]- go (ExprBooleanLiteral b) = runQ [e| return b|]+ go (ExprIntegerLiteral n) = runQ [e| return (n :: Integer) |]+ go (ExprStringLiteral s) = let x = unwrap s in runQ [e| return (x :: T.Text) |]+ go (ExprBooleanLiteral b) = runQ [e| return b |] go (ExprVariable v) = runQ [e| retrieve <$> ask <*> return (Key :: Key $(litT . strTyLit $ show v)) |] go (ExprParen e) = go e- go (ExprRange [stop]) = runQ [e| enumFromTo 0 <$> (pred <$> $(go stop)) |]- go (ExprRange [start, stop]) = runQ [e| enumFromTo <$> $(go start) <*> (pred <$> $(go stop)) |]- go (ExprRange [start, stop, step]) = runQ [e| (\a b c -> [a,a+c..b]) <$> $(go start) <*> (pred <$> $(go stop)) <*> $(go step) |]+ go (ExprRange [stop]) = runQ [e| (\b -> [0..b-1]) <$> $(go stop) |]+ go (ExprRange [start, stop]) = runQ [e| (\a b -> [a..b-1]) <$> $(go start) <*> $(go stop) |]+ go (ExprRange [start, stop, step]) = runQ [e| (\a b c -> [a,a+c..b-1]) <$> $(go start) <*> $(go stop) <*> $(go step) |] go (ExprRange _) = error "unreachable" go (ExprAttributed e []) = go e go (ExprAttributed e attrs) = runQ [e| retrieve <$> $(go $ ExprAttributed e $ init attrs) <*> return (Key :: Key $(litT . strTyLit $ show $ last attrs)) |] go (ExprFiltered e []) = go e go (ExprFiltered e filters) = runQ [e| $(applyFilter (last filters) $ ExprFiltered e $ init filters) |] where applyFilter FilterAbs e' = runQ [e| abs <$> $(go e') |]- applyFilter FilterLength e' = runQ [e| length <$> $(go e') |]+ applyFilter FilterLength e' = runQ [e| toInteger . length <$> $(go e') |] go (ExprPow e1 e2) = runQ [e| (^) <$> $(go e1) <*> $(go e2) |] go (ExprMul e1 e2) = runQ [e| (*) <$> $(go e1) <*> $(go e2) |] go (ExprDivF e1 e2) = runQ [e| (/) <$> $(go e1) <*> $(go e2) |]
src/Text/Haiji/Types.hs view
@@ -53,9 +53,6 @@ render = runReader . unTmpl class ToLT a where toLT :: a -> LT.Text-instance ToLT String where toLT = LT.pack instance ToLT T.Text where toLT = LT.fromStrict-instance ToLT LT.Text where toLT = id-instance ToLT Int where toLT = toLT . show-instance ToLT Integer where toLT = toLT . show-instance ToLT Bool where toLT = toLT . show+instance ToLT Integer where toLT = LT.pack . show+instance ToLT Bool where toLT = LT.pack . show
test/tests.hs view
@@ -56,22 +56,22 @@ where #if MIN_VERSION_base(4,9,0) dict = toDict @"a_variable" ("Hello,World!" :: T.Text) `merge`- toDict @"navigation" [ toDict @"caption" ("A" :: LT.Text) `merge`- toDict @"href" ("content/a.html" :: String)+ toDict @"navigation" [ toDict @"caption" ("A" :: T.Text) `merge`+ toDict @"href" ("content/a.html" :: T.Text) , toDict @"caption" "B" `merge` toDict @"href" "content/b.html" ] `merge`- toDict @"foo" (1 :: Int) `merge`- toDict @"bar" ("" :: String)+ toDict @"foo" (1 :: Integer) `merge`+ toDict @"bar" ("" :: T.Text) #else dict = [key|a_variable|] ("Hello,World!" :: T.Text) `merge`- [key|navigation|] [ [key|caption|] ("A" :: LT.Text) `merge`- [key|href|] ("content/a.html" :: String)+ [key|navigation|] [ [key|caption|] ("A" :: T.Text) `merge`+ [key|href|] ("content/a.html" :: T.Text) , [key|caption|] "B" `merge` [key|href|] "content/b.html" ] `merge`- [key|foo|] (1 :: Int) `merge`- [key|bar|] ("" :: String)+ [key|foo|] (1 :: Integer) `merge`+ [key|bar|] ("" :: T.Text) #endif case_empty :: Assertion@@ -117,11 +117,20 @@ expected @=? render $(haijiFile def "test/variables.tmpl") dict where dict = [key|foo|] ("normal" :: T.Text) `merge`- [key|_foo|] ("start '_'" :: LT.Text) `merge`+ [key|_foo|] ("start '_'" :: T.Text) `merge` [key|Foo|] ("start upper case" :: T.Text) `merge`- [key|F__o_o__|] ("include '_'" :: String) `merge`- [key|F1a2b3c|] ("include num" :: String)+ [key|F__o_o__|] ("include '_'" :: T.Text) `merge`+ [key|F1a2b3c|] ("include num" :: T.Text) +case_string :: Assertion+case_string = do+ expected <- jinja2 "test/string.tmpl" dict+ tmpl <- readTemplateFile def "test/string.tmpl"+ expected @=? render tmpl (toJSON dict)+ expected @=? render $(haijiFile def "test/string.tmpl") dict+ where+ dict = [key|test|] ("test" :: T.Text)+ case_range :: Assertion case_range = do expected <- jinja2 "test/range.tmpl" dict@@ -129,8 +138,8 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/range.tmpl") dict where- dict = [key|value|] (5 :: Int) `merge`- [key|array|] ([1,2,3] :: [Int])+ dict = [key|value|] (5 :: Integer) `merge`+ [key|array|] ([1,2,3] :: [Integer]) case_arith :: Assertion case_arith = do@@ -139,8 +148,8 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/arith.tmpl") dict where- dict = [key|value|] ((-1) :: Int) `merge`- [key|array|] ([1,2,3] :: [Int])+ dict = [key|value|] ((-1) :: Integer) `merge`+ [key|array|] ([1,2,3] :: [Integer]) case_comparison :: Assertion case_comparison = do@@ -149,9 +158,12 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/comparison.tmpl") dict where- dict = [key|value|] ((1) :: Int) `merge` -- There exists jinja2 bug (https://github.com/pallets/jinja/issues/755)- [key|array|] ([1,2,3] :: [Int])+ dict = [key|value|] ((1) :: Integer) `merge` -- There exists jinja2 bug (https://github.com/pallets/jinja/issues/755)+ [key|array|] ([1,2,3] :: [Integer]) `merge`+ [key|text|] ("text" :: T.Text) ++ case_logic :: Assertion case_logic = do expected <- jinja2 "test/logic.tmpl" dict@@ -159,8 +171,8 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/logic.tmpl") dict where- dict = [key|value|] ((1) :: Int) `merge`- [key|array|] ([1,2,3] :: [Int])+ dict = [key|value|] ((1) :: Integer) `merge`+ [key|array|] ([1,2,3] :: [Integer]) case_HTML_escape :: Assertion case_HTML_escape = do@@ -169,7 +181,7 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/HTML_escape.tmpl") dict where- dict = [key|foo|] ([' '..'\126'] :: String)+ dict = [key|foo|] (T.pack [' '..'\126']) case_condition :: Assertion case_condition = forM_ (replicateM 3 [True, False]) $ \[foo, bar, baz] -> do@@ -188,7 +200,7 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/foreach.tmpl") dict where- dict = [key|foo|] ([0,2..10] :: [Int])+ dict = [key|foo|] ([0,2..10] :: [Integer]) case_foreach_shadowing :: Assertion case_foreach_shadowing = do@@ -198,8 +210,8 @@ expected @=? render $(haijiFile def "test/foreach.tmpl") dict False @=? ("bar" `LT.isInfixOf` expected) where- dict = [key|foo|] ([0,2..10] :: [Int]) `merge`- [key|bar|] ("bar" :: String)+ dict = [key|foo|] ([0,2..10] :: [Integer]) `merge`+ [key|bar|] ("bar" :: T.Text) case_foreach_else_block :: Assertion case_foreach_else_block = do@@ -208,12 +220,12 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/foreach_else_block.tmpl") dict where- dict = [key|foo|] ([] :: [Int])+ dict = [key|foo|] ([] :: [Integer]) case_include :: Assertion case_include = do- testInclude ([0..10] :: [Int])- testInclude (["","\n","\n\n"] :: [String]) where+ testInclude ([0..10] :: [Integer])+ testInclude (["","\n","\n\n"] :: [T.Text]) where testInclude xs = do expected <- jinja2 "test/include.tmpl" dict tmpl <- readTemplateFile def "test/include.tmpl"@@ -229,8 +241,8 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/raw.tmpl") dict where- dict = [key|foo|] ([0,2..10] :: [Int]) `merge`- [key|bar|] ("bar" :: String)+ dict = [key|foo|] ([0,2..10] :: [Integer]) `merge`+ [key|bar|] ("bar" :: T.Text) case_loop_variables :: Assertion case_loop_variables = do@@ -288,19 +300,19 @@ expected @=? render $(haijiFile def "test/many_variables.tmpl") dict where dict = [key|a|] ("b" :: T.Text) `merge`- [key|b|] ("b" :: LT.Text) `merge`- [key|c|] ("b" :: LT.Text) `merge`- [key|d|] ("b" :: LT.Text) `merge`- [key|e|] ("b" :: LT.Text) `merge`- [key|f|] ("b" :: LT.Text) `merge`- [key|g|] ("b" :: LT.Text) `merge`- [key|h|] ("b" :: LT.Text) `merge`- [key|i|] ("b" :: LT.Text) `merge`- [key|j|] ("b" :: LT.Text) `merge`- [key|k|] ("b" :: LT.Text) `merge`- [key|l|] ("b" :: LT.Text) `merge`- [key|m|] ("b" :: LT.Text) `merge`- [key|n|] ("b" :: LT.Text) `merge`- [key|o|] ("b" :: LT.Text) `merge`- [key|p|] ("b" :: LT.Text) `merge`- [key|q|] ("b" :: LT.Text)+ [key|b|] ("b" :: T.Text) `merge`+ [key|c|] ("b" :: T.Text) `merge`+ [key|d|] ("b" :: T.Text) `merge`+ [key|e|] ("b" :: T.Text) `merge`+ [key|f|] ("b" :: T.Text) `merge`+ [key|g|] ("b" :: T.Text) `merge`+ [key|h|] ("b" :: T.Text) `merge`+ [key|i|] ("b" :: T.Text) `merge`+ [key|j|] ("b" :: T.Text) `merge`+ [key|k|] ("b" :: T.Text) `merge`+ [key|l|] ("b" :: T.Text) `merge`+ [key|m|] ("b" :: T.Text) `merge`+ [key|n|] ("b" :: T.Text) `merge`+ [key|o|] ("b" :: T.Text) `merge`+ [key|p|] ("b" :: T.Text) `merge`+ [key|q|] ("b" :: T.Text)