diff --git a/haiji.cabal b/haiji.cabal --- a/haiji.cabal +++ b/haiji.cabal @@ -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 maintainer: Noriyuki OHKAWA -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 diff --git a/src/Text/Haiji/Runtime.hs b/src/Text/Haiji/Runtime.hs --- a/src/Text/Haiji/Runtime.hs +++ b/src/Text/Haiji/Runtime.hs @@ -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 diff --git a/src/Text/Haiji/Syntax.hs b/src/Text/Haiji/Syntax.hs --- a/src/Text/Haiji/Syntax.hs +++ b/src/Text/Haiji/Syntax.hs @@ -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 diff --git a/src/Text/Haiji/Syntax/Expression.hs b/src/Text/Haiji/Syntax/Expression.hs --- a/src/Text/Haiji/Syntax/Expression.hs +++ b/src/Text/Haiji/Syntax/Expression.hs @@ -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 diff --git a/src/Text/Haiji/Syntax/Literal.hs b/src/Text/Haiji/Syntax/Literal.hs new file mode 100644 --- /dev/null +++ b/src/Text/Haiji/Syntax/Literal.hs @@ -0,0 +1,5 @@ +module Text.Haiji.Syntax.Literal + ( module L + ) where + +import Text.Haiji.Syntax.Literal.String as L diff --git a/src/Text/Haiji/Syntax/Literal/String.hs b/src/Text/Haiji/Syntax/Literal/String.hs new file mode 100644 --- /dev/null +++ b/src/Text/Haiji/Syntax/Literal/String.hs @@ -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 diff --git a/src/Text/Haiji/TH.hs b/src/Text/Haiji/TH.hs --- a/src/Text/Haiji/TH.hs +++ b/src/Text/Haiji/TH.hs @@ -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) |] diff --git a/src/Text/Haiji/Types.hs b/src/Text/Haiji/Types.hs --- a/src/Text/Haiji/Types.hs +++ b/src/Text/Haiji/Types.hs @@ -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 diff --git a/test/tests.hs b/test/tests.hs --- a/test/tests.hs +++ b/test/tests.hs @@ -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)