packages feed

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 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