Fragments passed as args can refer to each other.

This is shown in the new example with the content passed to `post` that
now can refer to `g`.

This also shows (because we had to rename "content" to something else,
in this case "second") that we have problems with the fact that we don't
declare formal fragment parameters. The content was supposed to be given
as an argument to `imports`, but here we have defined `div` as a
fragment that also takes a `content` argument.

examples/docs/aux-imported.slab

@@ -1,4 +1,4 @@
 div
-  default name
+  default first
 div
-  default content
+  default second

examples/docs/mod-import.slab

@@ -1,5 +1,5 @@
 import aux-imported.slab
-  frag name
+  frag first
     h1 A title
-  frag content
+  frag second
     p A paragraph.

examples/fragments.html

@@ -36,9 +36,9 @@ <h1>
         Some content.
     </p>
     <h1>
-        Card.
+        Post.
+    </h1>
+    <h1>
+        Title
     </h1>
-    <p>
-        Some content.
-    </p>
 </body>

examples/fragments.slab

@@ -23,15 +23,17 @@ body
     frag content
       p Some content.
 
-  -- Note that this doesn't pass `content`, but instead pass `default content`
-  -- as an unnamed fragment. This results in twice `default content` in the AST.
-  card
-    default content
-      p Some content.
-
   card
     frag content
       p Some content.
 
   card
     p Some content.
+
+  -- This test ensures that the content passed to post can use a fragment g
+  -- defined within the call.
+  post
+    frag g
+      h1 Title
+
+    g

src/Slab/Error.hs

@@ -35,6 +35,9 @@ unwrap = \case
     -- T.putStrLn . parseErrorPretty $ err
     T.putStrLn . T.pack $ errorBundlePretty err
     exitFailure
+  Left (EvaluateError err) -> do
+    T.putStrLn $ "Error during evaluation: " <> err
+    exitFailure
   Left err -> do
     TL.putStrLn $ pShowNoColor err
     exitFailure

src/Slab/Evaluate.hs

@@ -29,7 +29,7 @@ evaluateFile = runExceptT . evaluateFileE
 
 evaluateFileE :: FilePath -> ExceptT Error.Error IO [Block]
 evaluateFileE path =
-  PreProcess.preprocessFileE path >>= evaluate defaultEnv ["toplevel"]
+  PreProcess.preprocessFileE path >>= evaluate defaultEnv [T.pack path]
 
 --------------------------------------------------------------------------------
 defaultEnv :: Env
@@ -65,7 +65,9 @@ evaluate env stack nodes = do
   mapM (eval env' stack) nodes
 
 eval :: Monad m => Env -> [Text] -> Block -> ExceptT Error.Error m Block
-eval env stack = \case
+eval _ stack _ | length stack > 100 =
+  throwE $ Error.EvaluateError $ "Stack overflow. Is there an infinite loop?"
+eval env stack bl = case bl of
   node@BlockDoctype -> pure node
   BlockElem name mdot attrs nodes -> do
     nodes' <- evaluate env stack nodes
@@ -111,7 +113,7 @@ eval env stack = \case
         nodes' <- evaluate env ("?block" : stack) nodes
         pure $ BlockDefault name nodes'
       Just (Frag _ capturedEnv nodes') -> do
-        nodes'' <- evaluate capturedEnv ("+block" : stack) nodes'
+        nodes'' <- evaluate capturedEnv ("default block " <> name : stack) nodes'
         pure $ BlockDefault name nodes''
       Just _ -> throwE $ Error.EvaluateError $ "Calling something that is not a fragment \"" <> name <> "\" in " <> T.pack (show stack)
   BlockImport path _ args -> do
@@ -147,11 +149,11 @@ call env stack name values args =
       let env'' = augmentVariables capturedEnv env'
           arguments = zip names (map (thunk env) values)
           env''' = augmentVariables env'' arguments
-      body' <- evaluate env''' ("frag" : stack) body
+      body' <- evaluate env''' ("frag " <> name : stack) body
       pure body'
     Just (Block x) -> pure [x]
     Just _ -> throwE $ Error.EvaluateError $ "Calling something that is not a fragment \"" <> name <> "\" in " <> T.pack (show stack)
-    Nothing -> throwE $ Error.EvaluateError $ "Can't find fragment \"" <> name <> "\""
+    Nothing -> throwE $ Error.EvaluateError $ "Can't find fragment \"" <> name <> "\" while evaluating " <> T.pack (show $ reverse stack) <> " with environment " <> displayEnv env
 
 lookupVariable :: Text -> Env -> Maybe Expr
 lookupVariable name Env {..} = lookup name envVariables
@@ -267,17 +269,21 @@ evalInline env = \case
       x -> error $ "evalInline: unhandled value: " <> show x
 
 -- | Same as `extractVariables` plus an implicit @content@ block.
+-- Note that unlike `extractVariables`, this version takes also care of
+-- passing the environment being constructed to each definition.
 extractVariables' :: Monad m => Env -> [Block] -> ExceptT Error.Error m [(Text, Expr)]
 extractVariables' env nodes = do
-  let named = extractVariables env nodes
+  let named = extractVariables env' nodes
       unnamed = concatMap unnamedBlock nodes
-      content = if null unnamed then [] else [("content", Frag [] env unnamed)]
+      content = if null unnamed then [] else [("content", Frag [] env' unnamed)]
+      vars = named <> content
+      env' = augmentVariables env vars
   if isJust (lookup "content" named) && not (null unnamed)
     then
       throwE $
         Error.EvaluateError $
           "A block of content and a content argument are provided"
-    else pure $ named <> content
+    else pure vars
 
 unnamedBlock :: Block -> [Block]
 unnamedBlock (BlockImport path _ args) = [BlockFragmentCall (T.pack path) NoSym [] [] args]

src/Slab/Run.hs

@@ -14,6 +14,7 @@ module Slab.Run
 
 import Control.Monad.Trans.Except (ExceptT, except, runExceptT, withExceptT)
 import Data.Text (Text)
+import Data.Text qualified as T
 import Data.Text.IO qualified as T
 import Data.Text.Lazy.IO qualified as TL
 import Slab.Build qualified as Build
@@ -103,7 +104,7 @@ evaluateWithModeE
   -> ExceptT Error.Error IO [Syntax.Block]
 evaluateWithModeE path pmode = do
   parsed <- parseWithModeE path pmode
-  Evaluate.evaluate Evaluate.defaultEnv ["toplevel"] parsed
+  Evaluate.evaluate Evaluate.defaultEnv [T.pack path] parsed
 
 executeWithModeE
   :: FilePath

src/Slab/Syntax.hs

@@ -14,6 +14,7 @@ module Slab.Syntax
   , Inline (..)
   , Env (..)
   , emptyEnv
+  , displayEnv
   , trailingSym
   , freeVariables
   , thunk
@@ -84,6 +85,7 @@ pasteBlocks a b = BlockList $ peel a <> peel b
   peel x = [x]
 
 -- | Set attrs on a the block, if it is a BlockElem.
+setAttrs :: [Attr] -> [Block] -> [Block]
 setAttrs attrs (BlockElem name mdot attrs' nodes : bs) =
   BlockElem name mdot (attrs' <> attrs) nodes : bs
 setAttrs _ bs = bs
@@ -212,6 +214,9 @@ data Env = Env
 emptyEnv :: Env
 emptyEnv = Env []
 
+displayEnv :: Env -> Text
+displayEnv = T.pack . show . map fst . envVariables
+
 --------------------------------------------------------------------------------
 freeVariables :: Expr -> [Text]
 freeVariables =