haiji 0.2.1.2 → 0.2.2.0
raw patch · 7 files changed
+64/−6 lines, 7 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Text.Haiji: data Dict (kv :: [*])
+ Text.Haiji: data Dict (kv :: [Type])
Files
- haiji.cabal +1/−1
- src/Text/Haiji/Dictionary.hs +10/−4
- src/Text/Haiji/Parse.hs +1/−0
- src/Text/Haiji/Runtime.hs +5/−0
- src/Text/Haiji/Syntax/AST.hs +31/−1
- src/Text/Haiji/TH.hs +6/−0
- test/tests.hs +10/−0
haiji.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: haiji-version: 0.2.1.2+version: 0.2.2.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
src/Text/Haiji/Dictionary.hs view
@@ -31,13 +31,19 @@ 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 data Key (k :: Symbol) where Key :: KnownSymbol k => Key k infixl 2 :->-data (k :: Symbol) :-> (v :: *)+data (k :: Symbol) :-> (v :: STAR) -- | Empty dictionary empty :: Dict '[]@@ -56,11 +62,11 @@ 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 :: [*]) (b :: Symbol) where+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 :: [*]) = Dict (M.HashMap String Dynamic)+data Dict (kv :: [STAR]) = Dict (M.HashMap String Dynamic) instance ToJSON (Dict '[]) where toJSON _ = object []@@ -80,7 +86,7 @@ merge :: Dict xs -> Dict ys -> Dict (Merge xs ys) merge (Dict x) (Dict y) = Dict (y `M.union` x) -type family Merge a b :: [*] where+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))
src/Text/Haiji/Parse.hs view
@@ -70,6 +70,7 @@ (:[]) . Block base name scoped <$> readAllFile body parseFileRecursively Super = return [ Super ] parseFileRecursively (Comment c) = return [ Comment c ]+parseFileRecursively (Set lhs rhs scopes) = (:[]) . Set lhs rhs <$> readAllFile scopes parseFile :: QuasiWithFile q => FilePath -> q Jinja2 parseFile = parseFileWith deleteLastOneLF where
src/Text/Haiji/Runtime.hs view
@@ -84,6 +84,11 @@ Just child -> haijiASTs env (Just body) children child haijiAST env parentBlock children Super = maybe (error "invalid super()") (haijiASTs env Nothing children) parentBlock haijiAST _env _parentBlock _children (Comment _) = return ""+haijiAST env parentBlock children (Set lhs rhs scopes) =+ do val <- eval rhs+ p <- ask+ 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 len ix = JSON.object [ "first" JSON..= (ix == 0)
src/Text/Haiji/Syntax/AST.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} module Text.Haiji.Syntax.AST ( AST(..) , Loaded(..)@@ -17,6 +18,12 @@ import Data.Char import Data.Maybe import qualified Data.Text as T+#if MIN_VERSION_base(4,9,0)+import Data.Kind+#define STAR Type+#else+#define STAR *+#endif import Text.Haiji.Syntax.Identifier import Text.Haiji.Syntax.Expression@@ -33,7 +40,7 @@ data Loaded = Fully | Partially -data AST :: Loaded -> * where+data AST :: Loaded -> STAR where Literal :: T.Text -> AST a Eval :: Expression -> AST a Condition :: Expression -> [AST a] -> Maybe [AST a] -> AST a@@ -45,6 +52,7 @@ Block :: Base -> Identifier -> Scoped -> [AST a] -> AST a Super :: AST a Comment :: String -> AST a+ Set :: Identifier -> Expression -> [AST a] -> AST a deriving instance Eq (AST a) @@ -71,6 +79,7 @@ "{% endblock %}" show Super = "{{ super() }}" show (Comment c) = "{#" ++ c ++ "#}"+ show (Set lhs rhs scopes) = "{% set " ++ show lhs ++ " = " ++ show rhs ++ " %}" ++ concatMap show scopes data ParserState = ParserState@@ -138,6 +147,7 @@ , block , super , comment+ , set ] toList p = do b <- p@@ -441,3 +451,23 @@ -- comment :: HaijiParser (AST 'Partially) comment = saveLeadingSpaces *> liftParser (string "{#" >> Comment <$> manyTill anyChar (string "#}"))++-- |+--+-- >>> let eval = left (const "parse error") . parseOnly (evalHaijiParser set)+-- >>> let exec = left (const "parse error") . parseOnly (execHaijiParser set)+-- >>> eval "{% set lhs = rhs %}"+-- Right {% set lhs = rhs %}+-- >>> exec "{% set lhs = rhs %}"+-- Right (ParserState {parserStateLeadingSpaces = Nothing, parserStateInBaseTemplate = True})+-- >>> eval " {% set lhs = rhs %}"+-- Right {% set lhs = rhs %}+-- >>> exec " {% set lhs = rhs %}"+-- Right (ParserState {parserStateLeadingSpaces = Just , parserStateInBaseTemplate = True})+--+set :: HaijiParser (AST 'Partially)+set = withLeadingSpacesOf start rest where+ start = statement $ Set+ <$> (string "set" >> skipMany1 space >> identifier)+ <*> (skipMany1 space >> string "=" >> skipMany1 space >> expression)+ rest f = f <$> haijiParser
src/Text/Haiji/TH.hs view
@@ -92,6 +92,12 @@ Just child -> haijiASTs env (Just body) children child haijiAST env parentBlock children Super = maybe (error "invalid super()") (haijiASTs env Nothing children) parentBlock 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)))+ |] loopVariables :: Int -> Int -> Dict '["first" :-> Bool, "index" :-> Int, "index0" :-> Int, "last" :-> Bool, "length" :-> Int, "revindex" :-> Int, "revindex0" :-> Int] loopVariables len ix = Dict $ M.fromList [ ("first", toDyn (ix == 0))
test/tests.hs view
@@ -219,6 +219,16 @@ where dict = [key|seq|] ([0,2..10] :: [Integer]) +case_set :: Assertion+case_set = do+ expected <- jinja2 "test/set.tmpl" dict+ tmpl <- readTemplateFile def "test/set.tmpl"+ 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])+ case_extends :: Assertion case_extends = do expected <- jinja2 "test/child.tmpl" dict