+-- > Welcome to my awesome homepage. +-- >
+-- > {% endblock %} +-- +-- The @{% extends %}@ tag is the key here. It tells the template engine that this template "extends" another template. +-- When the template system evaluates this template, it first locates the parent. The extends tag should be the first tag in the template. +-- +-- As you can see it's also possible to render the contents of the parent block by calling super(). You can’t define multiple {% block %} +-- tags with the same name in the same template. This limitation exists because a block tag works in “both” directions. That is, a block +-- tag doesn’t just provide a placeholder to fill - it also defines the content that fills the placeholder in the parent. If there were two +-- similarly-named {% block %} tags in a template, that template's parent wouldn’t know which one of the blocks’ content to use. \ No newline at end of file diff --git a/lib/Text/EDE/Internal/AST.hs b/lib/Text/EDE/Internal/AST.hs index 9532199..e61fdf0 100644 --- a/lib/Text/EDE/Internal/AST.hs +++ b/lib/Text/EDE/Internal/AST.hs @@ -57,6 +57,21 @@ elet :: Maybe (Id, Exp a) -> Exp a -> Exp a elet m e = maybe e (\(i, b) -> Comonad.extract b :< ELet i b e) m {-# INLINEABLE elet #-} +eset :: Id -> Exp a -> Exp a -> Exp a +eset i e k = + elet (Just (i, e)) k +{-# INLINEABLE eset #-} + +eblock :: Id -> Exp a -> Exp a +eblock i e = + Comonad.extract e :< EBlock i e +{-# INLINEABLE eblock #-} + +eOverrideBlock :: Id -> Exp a -> Exp a -> Exp a +eOverrideBlock i b e = + Comonad.extract b :< EOverrideBlock i b e +{-# INLINEABLE eOverrideBlock #-} + ecase :: Exp a -> [Alt (Exp a)] -> diff --git a/lib/Text/EDE/Internal/Eval.hs b/lib/Text/EDE/Internal/Eval.hs index d6553bc..9502454 100644 --- a/lib/Text/EDE/Internal/Eval.hs +++ b/lib/Text/EDE/Internal/Eval.hs @@ -49,9 +49,11 @@ import Text.Trifecta.Delta (Delta) import qualified Text.Trifecta.Delta as Trifecta.Delta data Env = Env - { _templates :: HashMap Id (Exp Delta), + { _extends :: Bool, + _templates :: HashMap Id (Exp Delta), _quoted :: HashMap Id Term, - _values :: HashMap Id Value + _values :: HashMap Id Value, + _blocks :: HashMap Id (Exp Delta) } type Context = ReaderT Env Result @@ -63,7 +65,7 @@ render :: HashMap Id Value -> Result Builder render ts fs e o = - Reader.runReaderT (eval e >>= nf) (Env ts (stdlib <> fs) o) + Reader.runReaderT (eval e >>= nf) (Env False ts (stdlib <> fs) o mempty) where nf (TVal v) = build (Trifecta.Delta.delta e) v nf _ = @@ -85,6 +87,26 @@ eval (d :< EApp a b) = do x <- eval a y <- eval b binding d x y +eval (d :< EOverrideBlock i b e) = + setExtended True $ do + q <- HashMap.lookup i <$> Reader.asks _blocks + case q of + Nothing -> + bindBlock (HashMap.insert i b) (eval e) + Just eb -> + bindBlock (HashMap.insert i (d :< ELet "super" b eb)) (eval e) +eval (_ :< EBlock i b) = do + extends <- Reader.asks _extends + q <- HashMap.lookup i <$> Reader.asks _blocks + if extends then + pure (qprim (String mempty)) + else do + x <- eval b + v <- lift (unquote i 0 x) + maybe + (pure x) + (bind (HashMap.insert "super" v) . eval) + q eval (_ :< ELet k rhs bdy) = do q <- eval rhs v <- lift (unquote k 0 q) @@ -164,7 +186,21 @@ eval (_ :< ELoop i v bdy) = eval v >>= lift . unquote i 0 >>= loop eval (d :< EIncl i) = do ts <- Reader.asks _templates case HashMap.lookup i ts of - Just e -> eval e + Just e -> + -- Don't inherit any blocks declared so far. + setExtended False $ + bindBlock (\_ -> mempty) (eval e) + Nothing -> + throwError d $ + "template" + <+> bold (pp i) + <+> "is not in scope:" + <+> PP.brackets (pp (Text.intercalate "," $ HashMap.keys ts)) +eval (d :< EExt i) = do + ts <- Reader.asks _templates + case HashMap.lookup i ts of + Just e -> + setExtended False (eval e) Nothing -> throwError d $ "template" @@ -177,6 +213,15 @@ bind :: (HashMap Text Value -> HashMap Text Value) -> Context a -> Context a bind f = Reader.withReaderT (\x -> x {_values = f (_values x)}) {-# INLINEABLE bind #-} +bindBlock :: (HashMap Id (Exp Delta) -> HashMap Id (Exp Delta)) -> Context a -> Context a +bindBlock f = Reader.withReaderT (\x -> x {_blocks = f (_blocks x)}) +{-# INLINEABLE bindBlock #-} + +setExtended :: Bool -> Context a -> Context a +setExtended extends = + Reader.withReaderT (\x -> x { _extends = extends }) +{-# INLINEABLE setExtended #-} + variable :: Delta -> Var -> Context Value variable d (Var is) = Reader.asks _values >>= go (NonEmpty.toList is) [] . Object . fromHashMapText diff --git a/lib/Text/EDE/Internal/Parser.hs b/lib/Text/EDE/Internal/Parser.hs index 406350f..d9c5c7c 100644 --- a/lib/Text/EDE/Internal/Parser.hs +++ b/lib/Text/EDE/Internal/Parser.hs @@ -35,7 +35,6 @@ import Control.Monad.State.Strict (MonadState, StateT) import qualified Control.Monad.State.Strict as State import Control.Monad.Trans (lift) import Data.Aeson.Types (Value (..)) -import qualified Data.Bifunctor as Bifunctor import Data.ByteString (ByteString) import qualified Data.Char as Char import Data.HashMap.Strict (HashMap) @@ -64,7 +63,9 @@ import qualified Text.Trifecta.Delta as Trifecta.Delta data Env = Env { _settings :: !Syntax, - _includes :: HashMap Text (NonEmpty Delta) + _includes :: HashMap Text (NonEmpty Delta), + _extends :: HashMap Text (NonEmpty Delta), + _blocks :: HashMap Text (Exp Delta) } $(Lens.makeLenses ''Env) @@ -120,15 +121,25 @@ runParser :: Syntax -> Text -> ByteString -> - Result (Exp Delta, HashMap Text (NonEmpty Delta)) + Result (Exp Delta, HashMap Text (NonEmpty Delta), HashMap Text (NonEmpty Delta), HashMap Text (Exp Delta)) runParser o n = res . Trifecta.parseByteString (runEDE run) pos where - run = State.runStateT (pragma *> document <* Trifecta.eof) (Env o mempty) + run = State.runStateT (pragma *> document <* Trifecta.eof) (Env o mempty mempty mempty) pos = Trifecta.Delta.Directed (Text.Encoding.encodeUtf8 n) 0 0 0 0 res = \case - Trifecta.Success x -> Success (Bifunctor.second _includes x) + Trifecta.Success (x, env) -> + if null (_extends env) then + Success (x, _includes env, _extends env, _blocks env) + else + -- In case the template extends another template we arrange the contained + -- blocks in a way that make it easy to evaluate the "inheritance" mechanism. + let + x' = + HashMap.foldrWithKey eOverrideBlock x (_blocks env) + in + Success (x', _includes env, _extends env, _blocks env) Trifecta.Failure e -> Failure (Trifecta._errDoc e) pragma :: Parser m => m () @@ -184,6 +195,9 @@ statement = cases, loop, include, + set, + block', + extends', binding, raw, comment @@ -257,6 +271,13 @@ include = block "include" $ do (,) <$> (keyword "with" *> identifier) <*> (Trifecta.symbol "=" *> term) +extends' :: Parser m => m (Exp Delta) +extends' = block "extends" $ do + d <- Trifecta.position + k <- Trifecta.stringLiteral + extends %= HashMap.insertWith (<>) k (d :| []) + pure (d :< EExt k) + binding :: Parser m => m (Exp Delta) binding = elet . Just @@ -268,6 +289,22 @@ binding = <*> document <* exit "endlet" +set :: Parser m => m (Exp Delta) +set = + eset + <$> block "set" identifier + <*> document + <* exit "endset" + <*> document + +block' :: Parser m => m (Exp Delta) +block' = do + k <- block "block" identifier + e <- document + _ <- exit "endblock" + blocks %= HashMap.insert k e + pure (eblock k e) + raw :: Parser m => m (Exp Delta) raw = ann (ELit <$> body) where diff --git a/lib/Text/EDE/Internal/Syntax.hs b/lib/Text/EDE/Internal/Syntax.hs index aaa8ed8..24efba3 100644 --- a/lib/Text/EDE/Internal/Syntax.hs +++ b/lib/Text/EDE/Internal/Syntax.hs @@ -104,7 +104,11 @@ keywordSet = "_", ".", "true", - "false" + "false", + "set", + "endset", + "block", + "endblock" ] pragmaStyle :: TokenParsing m => IdentifierStyle m diff --git a/lib/Text/EDE/Internal/Types.hs b/lib/Text/EDE/Internal/Types.hs index 609dfcf..2107a01 100644 --- a/lib/Text/EDE/Internal/Types.hs +++ b/lib/Text/EDE/Internal/Types.hs @@ -166,7 +166,9 @@ type Resolver m = Syntax -> Id -> Delta -> m (Result Template) data Template = Template { _tmplName :: !Text, _tmplExp :: !(Exp Delta), - _tmplIncl :: HashMap Id (Exp Delta) + _tmplIncl :: HashMap Id (Exp Delta), + _tmplExtends :: HashMap Id (Exp Delta), + _tmplBlocks :: HashMap Id (Exp Delta) } deriving (Eq) @@ -203,9 +205,12 @@ data ExpF a | EFun !Id | EApp !a !a | ELet !Id !a !a + | EBlock !Id !a + | EOverrideBlock !Id !a !a | ECase !a [Alt a] | ELoop !Id !a !a | EIncl !Text + | EExt !Text deriving (Eq, Show, Functor) instance Functor.Classes.Eq1 ExpF where @@ -214,11 +219,14 @@ instance Functor.Classes.Eq1 ExpF where liftEq _ (EFun a) (EFun b) = a == b liftEq c (EApp a1 a2) (EApp b1 b2) = a1 `c` b1 && a2 `c` b2 liftEq c (ELet a0 a1 a2) (ELet b0 b1 b2) = a0 == b0 && a1 `c` b1 && a2 `c` b2 + liftEq c (EBlock a0 a1) (EBlock b0 b1) = a0 == b0 && a1 `c` b1 + liftEq c (EOverrideBlock a0 a1 a2) (EOverrideBlock b0 b1 b2) = a0 == b0 && a1 `c` b1 && a2 `c` b2 liftEq c (ECase a as) (ECase b bs) = a `c` b && (List.all (uncurry altEq) $ zip as bs) where altEq (pA, a') (pB, b') = pA == pB && a' `c` b' liftEq c (ELoop a0 a1 a2) (ELoop b0 b1 b2) = a0 == b0 && a1 `c` b1 && a2 `c` b2 liftEq _ (EIncl a) (EIncl b) = a == b + liftEq _ (EExt a) (EExt b) = a == b liftEq _ _ _ = False type Exp = Cofree ExpF diff --git a/test/resources/ext-base.ede b/test/resources/ext-base.ede new file mode 100644 index 0000000..0a4f97f --- /dev/null +++ b/test/resources/ext-base.ede @@ -0,0 +1,7 @@ +{} +--- + +{% block head %} ++ Welcome to my awesome homepage. +
+{% endblock %} \ No newline at end of file diff --git a/test/resources/ext-child.golden b/test/resources/ext-child.golden new file mode 100644 index 0000000..ae0f608 --- /dev/null +++ b/test/resources/ext-child.golden @@ -0,0 +1,13 @@ +{} +--- + ++ Welcome to my awesome homepage. +
+ diff --git a/test/resources/polymorphic-show.golden b/test/resources/polymorphic-show.golden index 7fae752..fb3f6cf 100644 --- a/test/resources/polymorphic-show.golden +++ b/test/resources/polymorphic-show.golden @@ -4,4 +4,4 @@ true 1.0 ["a","b","c","d","e"] [1,2,3,4,5] -{"foo":"x","bar":"y"} +{"bar":"y","foo":"x"} diff --git a/test/resources/set.ede b/test/resources/set.ede new file mode 100644 index 0000000..4db6e37 --- /dev/null +++ b/test/resources/set.ede @@ -0,0 +1,17 @@ +{ + "var": true +} +--- +{% set x %} + + {% set y %} + This is a nested block {{var}} + {% endset %} + + This is a big expression! {{var}} + + {{ y }} + +{% endset %} + +{{x}} \ No newline at end of file diff --git a/test/resources/set.golden b/test/resources/set.golden new file mode 100644 index 0000000..5fc0a13 --- /dev/null +++ b/test/resources/set.golden @@ -0,0 +1,8 @@ + + + + This is a big expression! true + + This is a nested block true + + diff --git a/test/resources/whitespace.golden b/test/resources/whitespace.golden index 1d67e49..76e2a66 100644 --- a/test/resources/whitespace.golden +++ b/test/resources/whitespace.golden @@ -6,6 +6,8 @@ + test +