haiji 0.3.4.0 → 0.4.0.0
raw patch · 5 files changed
+485/−238 lines, 5 filesdep +bytestringdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: bytestring
Dependency ranges changed: base
API changes (from Hackage documentation)
- Text.Haiji: data (k :: Symbol) :-> (v :: Type)
- Text.Haiji: data Dict (kv :: [Type])
- Text.Haiji: empty :: Dict '[]
- Text.Haiji: infixl 2 :->
- Text.Haiji: key :: QuasiQuoter
- Text.Haiji: merge :: Dict xs -> Dict ys -> Dict (Merge xs ys)
- Text.Haiji: toDict :: (KnownSymbol k, Typeable x) => x -> Dict '[k :-> x]
Files
- haiji.cabal +5/−6
- src/Text/Haiji.hs +0/−9
- src/Text/Haiji/Dictionary.hs +0/−95
- src/Text/Haiji/TH.hs +53/−33
- test/tests.hs +427/−95
haiji.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: haiji-version: 0.3.4.0+version: 0.4.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@@ -57,7 +57,6 @@ other-modules: Text.Haiji.Parse Text.Haiji.TH Text.Haiji.Types- Text.Haiji.Dictionary Text.Haiji.Syntax Text.Haiji.Syntax.AST Text.Haiji.Syntax.Identifier@@ -66,7 +65,7 @@ Text.Haiji.Syntax.Literal Text.Haiji.Syntax.Literal.String Text.Haiji.Utils- build-depends: base >=4.7 && <5+ build-depends: base >=4.16 && <5 , text , attoparsec >=0.10 , template-haskell >=2.8@@ -78,7 +77,6 @@ , unordered-containers , scientific , data-default- , unordered-containers hs-source-dirs: src ghc-options: -Wall default-language: Haskell2010@@ -86,7 +84,7 @@ test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs- build-depends: base+ build-depends: base >=4.16 && <5 , doctest , filepath hs-source-dirs: test@@ -99,7 +97,7 @@ test-suite tests type: exitcode-stdio-1.0 main-is: tests.hs- build-depends: base+ build-depends: base >=4.16 && <5 , aeson , haiji , tasty@@ -108,6 +106,7 @@ , text , process-extras , data-default+ , bytestring hs-source-dirs: test ghc-options: -Wall -threaded default-language: Haskell2010
src/Text/Haiji.hs view
@@ -52,19 +52,10 @@ -- * Rendering Environment , Environment , autoEscape- -- * Dictionary- , Dict- , toDict- , (:->)- , empty- -- ** Builder- , key- , merge ) where import Text.Haiji.TH import Text.Haiji.Types-import Text.Haiji.Dictionary -- $template -- >{{ foo }}
− src/Text/Haiji/Dictionary.hs
@@ -1,95 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE CPP #-}-module Text.Haiji.Dictionary- ( Dict(..)- , toDict- , (:->)- , empty- , singleton- , merge- , Key(..)- , retrieve- ) where--import Data.Aeson (ToJSON(..), Value(..), encode, object, (.=))-import Data.Dynamic-import qualified Data.HashMap.Strict as M-import Data.Maybe-#if MIN_VERSION_base(4,11,0)-#else-import Data.Monoid-#endif-import qualified Data.Text.Lazy as LT-import qualified Data.Text.Lazy.Encoding as LT-import Data.Type.Bool-import Data.Type.Equality-#if MIN_VERSION_base(4,9,0)-import Data.Kind-#define STAR Type-#else-#define STAR *-#endif-import GHC.TypeLits-import Text.Haiji.Utils (toKey)--data Key (k :: Symbol) where- Key :: KnownSymbol k => Key k--infixl 2 :->-data (k :: Symbol) :-> (v :: STAR)---- | Empty dictionary-empty :: Dict '[]-empty = Dict M.empty--singleton :: Typeable x => x -> Key k -> Dict '[ k :-> x ]-singleton x k = Dict $ M.singleton (keyVal k) (toDyn x)---- | Create single element dictionary (with TypeApplications extention)-toDict :: (KnownSymbol k, Typeable x) => x -> Dict '[ k :-> x ]-toDict = flip singleton Key--keyVal :: Key k -> String-keyVal k = case k of Key -> symbolVal k--retrieve :: Typeable (Retrieve xs k) => Dict xs -> Key k -> Retrieve xs k-retrieve (Dict d) k = fromJust $ fromDynamic $ d M.! keyVal k--type family Retrieve (a :: [STAR]) (b :: Symbol) where- Retrieve ((kx :-> vx) ': xs) key = If (CmpSymbol kx key == 'EQ) vx (Retrieve xs key)---- | Type level Dictionary-data Dict (kv :: [STAR]) = Dict (M.HashMap String Dynamic)--instance ToJSON (Dict '[]) where- toJSON _ = object []--instance (ToJSON (Dict d), ToJSON v, KnownSymbol k, Typeable v) => ToJSON (Dict ((k :-> v) ': d)) where- toJSON dict = Object (a <> b) where- (x, v, xs) = headKV dict- Object a = object [ toKey (keyVal x) .= v ]- Object b = toJSON xs- headKV :: (KnownSymbol k, Typeable v) => Dict ((k :-> v) ': d) -> (Key k, v, Dict d)- headKV (Dict d) = (k, fromJust $ fromDynamic $ d M.! keyVal k, Dict $ M.delete (keyVal k) d) where- k = Key--instance ToJSON (Dict s) => Show (Dict s) where- show = LT.unpack . LT.decodeUtf8 . encode--merge :: Dict xs -> Dict ys -> Dict (Merge xs ys)-merge (Dict x) (Dict y) = Dict (y `M.union` x)--type family Merge a b :: [STAR] where- Merge xs '[] = xs- Merge '[] ys = ys- Merge (x ': xs) (y ': ys) = If (Cmp x y == 'EQ) (y ': Merge xs ys) (If (Cmp x y == 'LT) (x ': Merge xs (y ': ys)) (y ': Merge (x ': xs) ys))--type family Cmp (a :: k) (b :: k) :: Ordering where- Cmp (k1 :-> v1) (k2 :-> v2) = CmpSymbol k1 k2
src/Text/Haiji/TH.hs view
@@ -3,10 +3,14 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeFamilies #-} module Text.Haiji.TH ( haiji , haijiFile- , key ) where #if MIN_VERSION_base(4,8,0)@@ -14,8 +18,6 @@ import Control.Applicative #endif import Control.Monad.Trans.Reader-import Data.Dynamic-import qualified Data.HashMap.Strict as M import Data.Maybe import Language.Haskell.TH import Language.Haskell.TH.Quote@@ -24,9 +26,15 @@ import qualified Data.Text.Lazy as LT import Text.Haiji.Parse import Text.Haiji.Syntax-import Text.Haiji.Dictionary import Text.Haiji.Types+import GHC.TypeLits+import GHC.Records+import GHC.Exts (Constraint) ++++ -- | QuasiQuoter to generate a Haiji template haiji :: Environment -> QuasiQuoter haiji env = QuasiQuoter { quoteExp = haijiExp env@@ -42,14 +50,6 @@ haijiExp :: Quasi q => Environment -> String -> q Exp haijiExp env str = runQ (runIO $ parseString str) >>= haijiTemplate env --- | Generate a dictionary with single item-key :: QuasiQuoter-key = QuasiQuoter { quoteExp = \k -> [e| \v -> singleton v (Key :: Key $(litT . strTyLit $ k)) |]- , quotePat = undefined- , quoteType = undefined- , quoteDec = undefined- }- haijiTemplate :: Quasi q => Environment -> Jinja2 -> q Exp haijiTemplate env tmpl = runQ [e| Template $(haijiASTs env Nothing (jinja2Child tmpl) (jinja2Base tmpl)) |] @@ -72,14 +72,12 @@ haijiAST env parentBlock children (Foreach k xs loopBody elseBody) = runQ [e| do dicts <- $(eval xs) p <- ask- let len = toInteger $ length dicts+ let len = toInteger $ Prelude.length dicts if 0 < len then return $ LT.concat [ runReader $(haijiASTs env parentBlock children loopBody)- (p `merge`- singleton x (Key :: Key $(litT . strTyLit $ show k)) `merge`- singleton (loopVariables len ix) (Key :: Key "loop")- )+ (SetDict @"loop" (loopVariables len ix) $+ SetDict @($(litT . strTyLit $ show k)) x p) | (ix, x) <- zip [0..] dicts ] else $(maybe [e| return "" |] (haijiASTs env parentBlock children) elseBody)@@ -94,21 +92,43 @@ haijiAST _env _parentBlock _children (Comment _) = runQ [e| return "" |] haijiAST env parentBlock children (Set lhs rhs scopes) = runQ [e| do val <- $(eval rhs)- p <- ask- return $ runReader $(haijiASTs env parentBlock children scopes)- (p `merge` singleton val (Key :: Key $(litT . strTyLit $ show lhs)))+ d <- ask+ let newDict = SetDict @($(litT $ strTyLit $ show lhs)) val d+ return $ runReader $(haijiASTs env parentBlock children scopes) newDict |] -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)- , ("last", toDyn (ix == len - 1))- , ("length", toDyn len)- , ("revindex", toDyn (len - ix))- , ("revindex0", toDyn (len - ix - 1))- ]+type family NotEqual (a :: Symbol) (b :: Symbol) :: Constraint where+ NotEqual a a = TypeError ('Text "Duplicate keys: " ':<>: 'ShowType a)+ NotEqual a b = () +data SetDict (sym :: Symbol) val base = SetDict val base++instance {-# OVERLAPPING #-} HasField sym (SetDict sym val base) val where+ getField (SetDict val _)= val++instance {-# OVERLAPPABLE #-} (NotEqual sym sym', HasField sym base val) => HasField sym (SetDict sym' val' base) val where+ getField (SetDict _ base)= getField @sym base++data LoopVars = LoopVars Bool Integer Integer Bool Integer Integer Integer+instance HasField "first" LoopVars Bool where+ getField (LoopVars x _ _ _ _ _ _) = x+instance HasField "index" LoopVars Integer where+ getField (LoopVars _ x _ _ _ _ _) = x+instance HasField "index0" LoopVars Integer where+ getField (LoopVars _ _ x _ _ _ _) = x+instance HasField "last" LoopVars Bool where+ getField (LoopVars _ _ _ x _ _ _) = x+instance HasField "length" LoopVars Integer where+ getField (LoopVars _ _ _ _ x _ _) = x+instance HasField "revindex" LoopVars Integer where+ getField (LoopVars _ _ _ _ _ x _) = x+instance HasField "revindex0" LoopVars Integer where+ getField (LoopVars _ _ _ _ _ _ x) = x+++loopVariables :: Integer -> Integer -> LoopVars+loopVariables len ix = LoopVars (ix == 0) (ix + 1) ix (ix == len - 1) len (len - ix) (len - ix - 1)+ eval :: Quasi q => Expression -> q Exp eval (Expression expression) = go expression where go :: Quasi q => Expr External level -> q Exp@@ -116,18 +136,18 @@ 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 (ExprVariable v) = runQ [e| getField @($(litT . strTyLit $ show v)) <$> ask |] go (ExprParen e) = go e 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 (ExprAttributed e attrs) = runQ [e| getField @($(litT $ strTyLit $ show $ Prelude.last attrs)) <$> $(go $ ExprAttributed e $ init attrs) |] go (ExprFiltered e []) = go e- go (ExprFiltered e filters) = runQ [e| $(applyFilter (last filters) $ ExprFiltered e $ init filters) |] where+ go (ExprFiltered e filters) = runQ [e| $(applyFilter (Prelude.last filters) $ ExprFiltered e $ init filters) |] where applyFilter FilterAbs e' = runQ [e| abs <$> $(go e') |]- applyFilter FilterLength e' = runQ [e| toInteger . length <$> $(go e') |]+ applyFilter FilterLength e' = runQ [e| toInteger . Prelude.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) |]
test/tests.hs view
@@ -21,6 +21,7 @@ #else import Data.Monoid #endif+import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.IO as LT@@ -29,12 +30,14 @@ import Test.Tasty.TH import Test.Tasty.HUnit +import GHC.Records+ main :: IO () main = $(defaultMainGenerator) -jinja2 :: Show a => FilePath -> a -> IO LT.Text+jinja2 :: ToJSON a => FilePath -> a -> IO LT.Text jinja2 template dict = do- (code, out, err) <- readProcessWithExitCode "python3" [] script+ (code, out, err) <- readProcessWithExitCode "uv" ["run", "python3"] script unless (code == ExitSuccess) $ LT.putStrLn err return out where script = LT.unlines@@ -42,11 +45,48 @@ , "from jinja2 import Environment, PackageLoader" , "env = Environment(loader=PackageLoader('example', '.'),autoescape=True)" , "template = env.get_template('" <> LT.pack template <> "')"- , "object = json.loads(" <> LT.pack (show $ show dict) <> ")"+ , "object = json.loads(" <> (LT.pack $ show $ BL.unpack $ encode dict) <> ")" , "print(template.render(object),end='')" , "exit()" ] +data CaseExampleNavigationDict = CaseExampleNavigationDict {+ _caseExampleNavigationDict_caption :: T.Text,+ _caseExampleNavigationDict_href :: T.Text+} deriving (Show, Eq)+instance HasField "caption" CaseExampleNavigationDict T.Text where+ getField = _caseExampleNavigationDict_caption+instance HasField "href" CaseExampleNavigationDict T.Text where+ getField = _caseExampleNavigationDict_href+instance ToJSON CaseExampleNavigationDict where+ toJSON x =+ object [ "caption" .= _caseExampleNavigationDict_caption x+ , "href" .= _caseExampleNavigationDict_href x+ ]++data CaseExampleDict = CaseExampleDict {+ _caseExampleDict_a_variable :: T.Text,+ _caseExampleDict_navigation :: [CaseExampleNavigationDict],+ _caseExampleDict_foo :: Integer,+ _caseExampleDict_bar :: T.Text+} deriving (Show, Eq)++instance HasField "a_variable" CaseExampleDict T.Text where+ getField = _caseExampleDict_a_variable+instance HasField "navigation" CaseExampleDict [CaseExampleNavigationDict] where+ getField = _caseExampleDict_navigation+instance HasField "foo" CaseExampleDict Integer where+ getField = _caseExampleDict_foo+instance HasField "bar" CaseExampleDict T.Text where+ getField = _caseExampleDict_bar+instance ToJSON CaseExampleDict where+ toJSON x =+ object [ "a_variable" .= _caseExampleDict_a_variable x+ , "navigation" .= _caseExampleDict_navigation x+ , "foo" .= _caseExampleDict_foo x+ , "bar" .= _caseExampleDict_bar x+ ]+ case_example :: Assertion case_example = do expected <- jinja2 "example.tmpl" dict@@ -54,61 +94,84 @@ tmpl <- readTemplateFile def "example.tmpl" expected @=? render tmpl (toJSON dict) where-#if MIN_VERSION_base(4,9,0)- dict = toDict @"a_variable" ("Hello,World!" :: T.Text) `merge`- 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 :: Integer) `merge`- toDict @"bar" ("" :: T.Text)-#else- dict = [key|a_variable|] ("Hello,World!" :: T.Text) `merge`- [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 :: Integer) `merge`- [key|bar|] ("" :: T.Text)-#endif+ dict = CaseExampleDict {+ _caseExampleDict_a_variable = "Hello,World!",+ _caseExampleDict_navigation = [+ CaseExampleNavigationDict {+ _caseExampleNavigationDict_caption = "A",+ _caseExampleNavigationDict_href = "content/a.html"+ }+ , CaseExampleNavigationDict {+ _caseExampleNavigationDict_caption = "B",+ _caseExampleNavigationDict_href = "content/b.html"+ }+ ],+ _caseExampleDict_foo = 1,+ _caseExampleDict_bar = ""+ } + case_empty :: Assertion case_empty = do- expected <- jinja2 "test/empty.tmpl" empty+ expected <- jinja2 "test/empty.tmpl" () tmpl <- readTemplateFile def "test/empty.tmpl"- expected @=? render tmpl (toJSON empty)- expected @=? render $(haijiFile def "test/empty.tmpl") empty+ expected @=? render tmpl (toJSON ())+ expected @=? render $(haijiFile def "test/empty.tmpl") () case_lf1 :: Assertion case_lf1 = do- expected <- jinja2 "test/lf1.tmpl" empty+ expected <- jinja2 "test/lf1.tmpl" () tmpl <- readTemplateFile def "test/lf1.tmpl"- expected @=? render tmpl (toJSON empty)- expected @=? render $(haijiFile def "test/lf1.tmpl") empty+ expected @=? render tmpl (toJSON ())+ expected @=? render $(haijiFile def "test/lf1.tmpl") () case_lf2 :: Assertion case_lf2 = do- expected <- jinja2 "test/lf2.tmpl" empty+ expected <- jinja2 "test/lf2.tmpl" () tmpl <- readTemplateFile def "test/lf2.tmpl"- expected @=? render tmpl (toJSON empty)- expected @=? render $(haijiFile def "test/lf2.tmpl") empty+ expected @=? render tmpl (toJSON ())+ expected @=? render $(haijiFile def "test/lf2.tmpl") () case_line_without_newline :: Assertion case_line_without_newline = do- expected <- jinja2 "test/line_without_newline.tmpl" empty+ expected <- jinja2 "test/line_without_newline.tmpl" () tmpl <- readTemplateFile def "test/line_without_newline.tmpl"- expected @=? render tmpl (toJSON empty)- expected @=? render $(haijiFile def "test/line_without_newline.tmpl") empty+ expected @=? render tmpl (toJSON ())+ expected @=? render $(haijiFile def "test/line_without_newline.tmpl") () case_line_with_newline :: Assertion case_line_with_newline = do- expected <- jinja2 "test/line_with_newline.tmpl" empty+ expected <- jinja2 "test/line_with_newline.tmpl" () tmpl <- readTemplateFile def "test/line_with_newline.tmpl"- expected @=? render tmpl (toJSON empty)- expected @=? render $(haijiFile def "test/line_with_newline.tmpl") empty+ expected @=? render tmpl (toJSON ())+ expected @=? render $(haijiFile def "test/line_with_newline.tmpl") () +data CaseVariablesDict = CaseVariablesDict {+ _caseVariablesDict_foo :: T.Text,+ _caseVariablesDict__foo :: T.Text,+ _caseVariablesDict_Foo :: T.Text,+ _caseVariablesDict_F__o_o__ :: T.Text,+ _caseVariablesDict_F1a2b3c :: T.Text+} deriving (Show, Eq)+instance HasField "foo" CaseVariablesDict T.Text where+ getField = _caseVariablesDict_foo+instance HasField "_foo" CaseVariablesDict T.Text where+ getField = _caseVariablesDict__foo+instance HasField "Foo" CaseVariablesDict T.Text where+ getField = _caseVariablesDict_Foo+instance HasField "F__o_o__" CaseVariablesDict T.Text where+ getField = _caseVariablesDict_F__o_o__+instance HasField "F1a2b3c" CaseVariablesDict T.Text where+ getField = _caseVariablesDict_F1a2b3c+instance ToJSON CaseVariablesDict where+ toJSON x =+ object [ "foo" .= _caseVariablesDict_foo x+ , "_foo" .= _caseVariablesDict__foo x+ , "Foo" .= _caseVariablesDict_Foo x+ , "F__o_o__" .= _caseVariablesDict_F__o_o__ x+ , "F1a2b3c" .= _caseVariablesDict_F1a2b3c x+ ]+ case_variables :: Assertion case_variables = do expected <- jinja2 "test/variables.tmpl" dict@@ -116,12 +179,24 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/variables.tmpl") dict where- dict = [key|foo|] ("normal" :: T.Text) `merge`- [key|_foo|] ("start '_'" :: T.Text) `merge`- [key|Foo|] ("start upper case" :: T.Text) `merge`- [key|F__o_o__|] ("include '_'" :: T.Text) `merge`- [key|F1a2b3c|] ("include num" :: T.Text)+ dict = CaseVariablesDict {+ _caseVariablesDict_foo = "normal",+ _caseVariablesDict__foo = "start '_'",+ _caseVariablesDict_Foo = "start upper case",+ _caseVariablesDict_F__o_o__ = "include '_'",+ _caseVariablesDict_F1a2b3c = "include num"+ } +data CaseStringDict = CaseStringDict {+ _caseStringDict_test :: T.Text+} deriving (Show, Eq)+instance HasField "tet" CaseStringDict T.Text where+ getField = _caseStringDict_test+instance ToJSON CaseStringDict where+ toJSON x =+ object [ "test" .= _caseStringDict_test x+ ]+ case_string :: Assertion case_string = do expected <- jinja2 "test/string.tmpl" dict@@ -129,18 +204,25 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/string.tmpl") dict where- dict = [key|test|] ("test" :: T.Text)+ dict = CaseStringDict {+ _caseStringDict_test = "test"+ } -case_range :: Assertion-case_range = do- expected <- jinja2 "test/range.tmpl" dict- tmpl <- readTemplateFile def "test/range.tmpl"- expected @=? render tmpl (toJSON dict)- expected @=? render $(haijiFile def "test/range.tmpl") dict- where- dict = [key|value|] (5 :: Integer) `merge`- [key|array|] ([1,2,3] :: [Integer]) +data CaseArithDict = CaseArithDict {+ _caseArithDict_value :: Integer,+ _caseArithDict_array :: [Integer]+} deriving (Show, Eq)+instance HasField "value" CaseArithDict Integer where+ getField = _caseArithDict_value+instance HasField "array" CaseArithDict [Integer] where+ getField = _caseArithDict_array+instance ToJSON CaseArithDict where+ toJSON x =+ object [ "value" .= _caseArithDict_value x+ , "array" .= _caseArithDict_array x+ ]+ case_arith :: Assertion case_arith = do expected <- jinja2 "test/arith.tmpl" dict@@ -148,9 +230,29 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/arith.tmpl") dict where- dict = [key|value|] ((-1) :: Integer) `merge`- [key|array|] ([1,2,3] :: [Integer])+ dict = CaseArithDict {+ _caseArithDict_value = -1,+ _caseArithDict_array = [1,2,3]+ } +data CaseComparisonDict = CaseComparisonDict {+ _caseComparisonDict_value :: Integer,+ _caseComparisonDict_array :: [Integer],+ _caseComparisonDict_text :: T.Text+} deriving (Show, Eq)+instance HasField "value" CaseComparisonDict Integer where+ getField = _caseComparisonDict_value+instance HasField "array" CaseComparisonDict [Integer] where+ getField = _caseComparisonDict_array+instance HasField "text" CaseComparisonDict T.Text where+ getField = _caseComparisonDict_text+instance ToJSON CaseComparisonDict where+ toJSON x =+ object [ "value" .= _caseComparisonDict_value x+ , "array" .= _caseComparisonDict_array x+ , "text" .= _caseComparisonDict_text x+ ]+ case_comparison :: Assertion case_comparison = do expected <- jinja2 "test/comparison.tmpl" dict@@ -158,11 +260,26 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/comparison.tmpl") dict where- 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)+ dict = CaseComparisonDict {+ _caseComparisonDict_value = (1 :: Integer),+ _caseComparisonDict_array = [1,2,3],+ _caseComparisonDict_text = "text"+ } +data CaseLogicDict = CaseLogicDict {+ _caseLogicDict_value :: Integer,+ _caseLogicDict_array :: [Integer]+} deriving (Show, Eq)+instance HasField "value" CaseLogicDict Integer where+ getField = _caseLogicDict_value+instance HasField "array" CaseLogicDict [Integer] where+ getField = _caseLogicDict_array+instance ToJSON CaseLogicDict where+ toJSON x =+ object [ "value" .= _caseLogicDict_value x+ , "array" .= _caseLogicDict_array x+ ] case_logic :: Assertion case_logic = do@@ -171,9 +288,22 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/logic.tmpl") dict where- dict = [key|value|] ((1) :: Integer) `merge`- [key|array|] ([1,2,3] :: [Integer])+ dict = CaseLogicDict {+ _caseLogicDict_value = 1,+ _caseLogicDict_array = [1,2,3]+ } ++data CaseHTMLEscapeDict = CaseHTMLEscapeDict {+ _caseHTMLEscapeDict_foo :: T.Text+} deriving (Show, Eq)+instance HasField "foo" CaseHTMLEscapeDict T.Text where+ getField = _caseHTMLEscapeDict_foo+instance ToJSON CaseHTMLEscapeDict where+ toJSON x =+ object [ "foo" .= _caseHTMLEscapeDict_foo x+ ]+ case_HTML_escape :: Assertion case_HTML_escape = do expected <- jinja2 "test/HTML_escape.tmpl" dict@@ -181,18 +311,53 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/HTML_escape.tmpl") dict where- dict = [key|foo|] (T.pack [' '..'\126'])+ dict = CaseHTMLEscapeDict $ T.pack [' '..'\126'] ++data CaseConditionDict = CaseConditionDict {+ _caseConditionDict_foo :: Bool,+ _caseConditionDict_bar :: Bool,+ _caseConditionDict_baz :: Bool+} deriving (Show, Eq)+instance HasField "foo" CaseConditionDict Bool where+ getField = _caseConditionDict_foo+instance HasField "bar" CaseConditionDict Bool where+ getField = _caseConditionDict_bar+instance HasField "baz" CaseConditionDict Bool where+ getField = _caseConditionDict_baz+instance ToJSON CaseConditionDict where+ toJSON x =+ object [ "foo" .= _caseConditionDict_foo x+ , "bar" .= _caseConditionDict_bar x+ , "baz" .= _caseConditionDict_baz x+ ]+ case_condition :: Assertion case_condition = forM_ (replicateM 3 [True, False]) $ \[foo, bar, baz] -> do- let dict = [key|foo|] foo `merge`- [key|bar|] bar `merge`- [key|baz|] baz+ let dict = CaseConditionDict {+ _caseConditionDict_foo = foo,+ _caseConditionDict_bar = bar,+ _caseConditionDict_baz = baz+ } expected <- jinja2 "test/condition.tmpl" dict tmpl <- readTemplateFile def "test/condition.tmpl" expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/condition.tmpl") dict +data CaseForeachDict = CaseForeachDict {+ _caseForeachDict_foo :: [Integer],+ _caseForeachDict_bar :: T.Text+} deriving (Show, Eq)+instance HasField "foo" CaseForeachDict [Integer] where+ getField = _caseForeachDict_foo+instance HasField "bar" CaseForeachDict T.Text where+ getField = _caseForeachDict_bar+instance ToJSON CaseForeachDict where+ toJSON x =+ object [ "foo" .= _caseForeachDict_foo x+ , "bar" .= _caseForeachDict_bar x+ ]+ case_foreach :: Assertion case_foreach = do expected <- jinja2 "test/foreach.tmpl" dict@@ -200,7 +365,10 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/foreach.tmpl") dict where- dict = [key|foo|] ([0,2..10] :: [Integer])+ dict = CaseForeachDict {+ _caseForeachDict_foo = [0,2..10],+ _caseForeachDict_bar = "bar"+ } case_foreach_shadowing :: Assertion case_foreach_shadowing = do@@ -210,8 +378,10 @@ expected @=? render $(haijiFile def "test/foreach.tmpl") dict False @=? ("bar" `LT.isInfixOf` expected) where- dict = [key|foo|] ([0,2..10] :: [Integer]) `merge`- [key|bar|] ("bar" :: T.Text)+ dict = CaseForeachDict {+ _caseForeachDict_foo = [2,4..10],+ _caseForeachDict_bar = "bar"+ } case_foreach_else_block :: Assertion case_foreach_else_block = do@@ -220,8 +390,21 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/foreach_else_block.tmpl") dict where- dict = [key|foo|] ([] :: [Integer])+ dict = CaseForeachDict {+ _caseForeachDict_foo = [],+ _caseForeachDict_bar = "bar"+ } +data CaseIncludeDict a = CaseIncludeDict {+ _caseIncludeDict_foo :: [a]+} deriving (Show, Eq)+instance HasField "foo" (CaseIncludeDict a) [a] where+ getField = _caseIncludeDict_foo+instance ToJSON a => ToJSON (CaseIncludeDict a) where+ toJSON x =+ object [ "foo" .= _caseIncludeDict_foo x+ ]+ case_include :: Assertion case_include = do testInclude ([0..10] :: [Integer])@@ -232,8 +415,24 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/include.tmpl") dict where- dict = [key|foo|] xs+ dict = CaseIncludeDict {+ _caseIncludeDict_foo = xs+ } +data CaseRawDict = CaseRawDict {+ _caseRawDict_foo :: [Integer],+ _caseRawDict_bar :: T.Text+} deriving (Show, Eq)+instance HasField "foo" CaseRawDict [Integer] where+ getField = _caseRawDict_foo+instance HasField "bar" CaseRawDict T.Text where+ getField = _caseRawDict_bar+instance ToJSON CaseRawDict where+ toJSON x =+ object [ "foo" .= _caseRawDict_foo x+ , "bar" .= _caseRawDict_bar x+ ]+ case_raw :: Assertion case_raw = do expected <- jinja2 "test/raw.tmpl" dict@@ -241,9 +440,22 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/raw.tmpl") dict where- dict = [key|foo|] ([0,2..10] :: [Integer]) `merge`- [key|bar|] ("bar" :: T.Text)+ dict = CaseRawDict {+ _caseRawDict_foo = [0,2..10],+ _caseRawDict_bar = "bar"+ } ++data CaseLoopVariablesDict = CaseLoopVariablesDict {+ _caseLoopVariablesDict_foo :: [Integer]+} deriving (Show, Eq)+instance HasField "foo" CaseLoopVariablesDict [Integer] where+ getField = _caseLoopVariablesDict_foo+instance ToJSON CaseLoopVariablesDict where+ toJSON x =+ object [ "foo" .= _caseLoopVariablesDict_foo x+ ]+ case_loop_variables :: Assertion case_loop_variables = do expected <- jinja2 "test/loop_variables.tmpl" dict@@ -251,8 +463,19 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/loop_variables.tmpl") dict where- dict = [key|foo|] ([0,2..10] :: [Integer])+ dict = CaseLoopVariablesDict [0,2..10] ++data CaseWhitespaceControlDict = CaseWhitespaceControlDict {+ _caseWhitespaceControlDict_seq :: [Integer]+} deriving (Show, Eq)+instance HasField "seq" CaseWhitespaceControlDict [Integer] where+ getField = _caseWhitespaceControlDict_seq+instance ToJSON CaseWhitespaceControlDict where+ toJSON x =+ object [ "seq" .= _caseWhitespaceControlDict_seq x+ ]+ case_whitespace_control :: Assertion case_whitespace_control = do expected <- jinja2 "test/whitespace_control.tmpl" dict@@ -260,8 +483,19 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/whitespace_control.tmpl") dict where- dict = [key|seq|] ([0,2..10] :: [Integer])+ dict = CaseWhitespaceControlDict [0,2..10] ++data CaseCommentDict = CaseCommentDict {+ _caseCommentDict_seq :: [Integer]+} deriving (Show, Eq)+instance HasField "seq" CaseCommentDict [Integer] where+ getField = _caseCommentDict_seq+instance ToJSON CaseCommentDict where+ toJSON x =+ object [ "seq" .= _caseCommentDict_seq x+ ]+ case_comment :: Assertion case_comment = do expected <- jinja2 "test/comment.tmpl" dict@@ -269,8 +503,23 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/comment.tmpl") dict where- dict = [key|seq|] ([0,2..10] :: [Integer])+ dict = CaseCommentDict [0,2..10] ++data CaseSetDict = CaseSetDict {+ _caseSetDict_ys :: [Integer],+ _caseSetDict_xs :: [Integer]+} deriving (Show, Eq)+instance HasField "ys" CaseSetDict [Integer] where+ getField = _caseSetDict_ys+instance HasField "xs" CaseSetDict [Integer] where+ getField = _caseSetDict_xs+instance ToJSON CaseSetDict where+ toJSON x =+ object [ "ys" .= _caseSetDict_ys x+ , "xs" .= _caseSetDict_xs x+ ]+ case_set :: Assertion case_set = do expected <- jinja2 "test/set.tmpl" dict@@ -278,9 +527,30 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/set.tmpl") dict where- dict = [key|ys|] ([0..2] :: [Integer]) `merge`- [key|xs|] ([0..3] :: [Integer])+ dict = CaseSetDict {+ _caseSetDict_ys = [0..2] :: [Integer],+ _caseSetDict_xs = [0..3] :: [Integer]+ } ++data CaseExtendsDict = CaseExtendsDict {+ _caseExtendsDict_foo :: T.Text,+ _caseExtendsDict_bar :: T.Text,+ _caseExtendsDict_baz :: T.Text+} deriving (Show, Eq)+instance HasField "foo" CaseExtendsDict T.Text where+ getField = _caseExtendsDict_foo+instance HasField "bar" CaseExtendsDict T.Text where+ getField = _caseExtendsDict_bar+instance HasField "baz" CaseExtendsDict T.Text where+ getField = _caseExtendsDict_baz+instance ToJSON CaseExtendsDict where+ toJSON x =+ object [ "foo" .= _caseExtendsDict_foo x+ , "bar" .= _caseExtendsDict_bar x+ , "baz" .= _caseExtendsDict_baz x+ ]+ case_extends :: Assertion case_extends = do expected <- jinja2 "test/child.tmpl" dict@@ -288,10 +558,70 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/child.tmpl") dict where- dict = [key|foo|] ("foo" :: T.Text) `merge`- [key|bar|] ("bar" :: T.Text) `merge`- [key|baz|] ("baz" :: T.Text)+ dict = CaseExtendsDict {+ _caseExtendsDict_foo = "foo",+ _caseExtendsDict_bar = "bar",+ _caseExtendsDict_baz = "baz"+ } ++data CaseManyVariables = CaseManyVariables+ { _caseManyVariables_a :: T.Text+ , _caseManyVariables_b :: T.Text+ , _caseManyVariables_c :: T.Text+ , _caseManyVariables_d :: T.Text+ , _caseManyVariables_e :: T.Text+ , _caseManyVariables_f :: T.Text+ , _caseManyVariables_g :: T.Text+ , _caseManyVariables_h :: T.Text+ , _caseManyVariables_i :: T.Text+ , _caseManyVariables_j :: T.Text+ , _caseManyVariables_k :: T.Text+ , _caseManyVariables_l :: T.Text+ , _caseManyVariables_m :: T.Text+ , _caseManyVariables_n :: T.Text+ , _caseManyVariables_o :: T.Text+ , _caseManyVariables_p :: T.Text+ , _caseManyVariables_q :: T.Text+ } deriving (Show, Eq)+instance HasField "a" CaseManyVariables T.Text where getField = _caseManyVariables_a+instance HasField "b" CaseManyVariables T.Text where getField = _caseManyVariables_b+instance HasField "c" CaseManyVariables T.Text where getField = _caseManyVariables_c+instance HasField "d" CaseManyVariables T.Text where getField = _caseManyVariables_d+instance HasField "e" CaseManyVariables T.Text where getField = _caseManyVariables_e+instance HasField "f" CaseManyVariables T.Text where getField = _caseManyVariables_f+instance HasField "g" CaseManyVariables T.Text where getField = _caseManyVariables_g+instance HasField "h" CaseManyVariables T.Text where getField = _caseManyVariables_h+instance HasField "i" CaseManyVariables T.Text where getField = _caseManyVariables_i+instance HasField "j" CaseManyVariables T.Text where getField = _caseManyVariables_j+instance HasField "k" CaseManyVariables T.Text where getField = _caseManyVariables_k+instance HasField "l" CaseManyVariables T.Text where getField = _caseManyVariables_l+instance HasField "m" CaseManyVariables T.Text where getField = _caseManyVariables_m+instance HasField "n" CaseManyVariables T.Text where getField = _caseManyVariables_n+instance HasField "o" CaseManyVariables T.Text where getField = _caseManyVariables_o+instance HasField "p" CaseManyVariables T.Text where getField = _caseManyVariables_p+instance HasField "q" CaseManyVariables T.Text where getField = _caseManyVariables_q+instance ToJSON CaseManyVariables where+ toJSON x = object+ [ "a" .= _caseManyVariables_a x+ , "b" .= _caseManyVariables_b x+ , "c" .= _caseManyVariables_c x+ , "d" .= _caseManyVariables_d x+ , "e" .= _caseManyVariables_e x+ , "f" .= _caseManyVariables_f x+ , "g" .= _caseManyVariables_g x+ , "h" .= _caseManyVariables_h x+ , "i" .= _caseManyVariables_i x+ , "j" .= _caseManyVariables_j x+ , "k" .= _caseManyVariables_k x+ , "l" .= _caseManyVariables_l x+ , "m" .= _caseManyVariables_m x+ , "n" .= _caseManyVariables_n x+ , "o" .= _caseManyVariables_o x+ , "p" .= _caseManyVariables_p x+ , "q" .= _caseManyVariables_q x+ ]+ case_many_variables :: Assertion case_many_variables = do expected <- jinja2 "test/many_variables.tmpl" dict --@@ -299,20 +629,22 @@ expected @=? render tmpl (toJSON dict) expected @=? render $(haijiFile def "test/many_variables.tmpl") dict where- dict = [key|a|] ("b" :: T.Text) `merge`- [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)+ dict = CaseManyVariables+ { _caseManyVariables_a = "b" :: T.Text+ , _caseManyVariables_b = "b" :: T.Text+ , _caseManyVariables_c = "b" :: T.Text+ , _caseManyVariables_d = "b" :: T.Text+ , _caseManyVariables_e = "b" :: T.Text+ , _caseManyVariables_f = "b" :: T.Text+ , _caseManyVariables_g = "b" :: T.Text+ , _caseManyVariables_h = "b" :: T.Text+ , _caseManyVariables_i = "b" :: T.Text+ , _caseManyVariables_j = "b" :: T.Text+ , _caseManyVariables_k = "b" :: T.Text+ , _caseManyVariables_l = "b" :: T.Text+ , _caseManyVariables_m = "b" :: T.Text+ , _caseManyVariables_n = "b" :: T.Text+ , _caseManyVariables_o = "b" :: T.Text+ , _caseManyVariables_p = "b" :: T.Text+ , _caseManyVariables_q = "b" :: T.Text+ }