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.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 diff --git a/src/Text/Haiji.hs b/src/Text/Haiji.hs --- a/src/Text/Haiji.hs +++ b/src/Text/Haiji.hs @@ -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 }} diff --git a/src/Text/Haiji/Dictionary.hs b/src/Text/Haiji/Dictionary.hs deleted file mode 100644 --- a/src/Text/Haiji/Dictionary.hs +++ /dev/null @@ -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 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 @@ -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) |] diff --git a/test/tests.hs b/test/tests.hs --- a/test/tests.hs +++ b/test/tests.hs @@ -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 + }