Support elements in string interpolation.

- The code to evaluate a fragment is moved to a function so it can be
  re-used.
- evalInline and evalTemplate now return Inlines instead of rendering
  them to Text.
- A bit of code to convert those Inlines to Text is now added to
  Render.hs.

The above points are just a bit of refactoring.

- We add the Frag and Block case to evalExpr and evalInline.

The above point makes our language more consistent as it now allows to
use fragments in string interpolation expressions.

examples/interpolation.html

@@ -12,3 +12,6 @@
 <p>
     Hello, 42.
 </p>
+<p>
+    Hello, <a></a>.
+</p>

examples/interpolation.slab

@@ -7,3 +7,4 @@ body
 
 p Hello, #('Charlie').
 p Hello, #(42).
+p Hello, #(a).

src/Slab/Evaluate.hs

@@ -83,9 +83,8 @@ defaultEnv =
     , mkElem "svg" Svg
     , mkElem "textarea" Textarea
     , mkElem "canvas" Canvas
-
-    -- Elements with no content.
-    , ("br", Block (BlockElem Br NoSym [] []))
+    , -- Elements with no content.
+      ("br", Block (BlockElem Br NoSym [] []))
     , ("hr", Block (BlockElem Hr NoSym [] []))
     , ("meta", Block (BlockElem Meta NoSym [] []))
     , ("link", Block (BlockElem Link NoSym [] []))
@@ -110,9 +109,15 @@ evaluate env stack nodes = do
   mapM (eval env' stack) nodes
 
 eval :: Monad m => Env -> [Text] -> Block -> ExceptT Error.Error m Block
-eval env stack b | length stack > 100 =
-  throwE $ Error.EvaluateError $ "Stack overflow. Is there an infinite loop?"
-    <> " " <> T.pack (show $ reverse stack) <> " " <> displayEnv env
+eval env stack b
+  | length stack > 100 =
+      throwE $
+        Error.EvaluateError $
+          "Stack overflow. Is there an infinite loop?"
+            <> " "
+            <> T.pack (show $ reverse stack)
+            <> " "
+            <> displayEnv env
 eval env stack bl = case bl of
   node@BlockDoctype -> pure node
   BlockElem name mdot attrs nodes -> do
@@ -190,13 +195,7 @@ eval env stack bl = case bl of
 call :: Monad m => Env -> [Text] -> Text -> [Expr] -> [Block] -> ExceptT Error.Error m [Block]
 call env stack name values args =
   case lookupVariable name env of
-    Just (Frag names capturedEnv body) -> do
-      env' <- extractVariables' env args
-      let env'' = augmentVariables capturedEnv env'
-          arguments = zip names (map (thunk env) values)
-          env''' = augmentVariables env'' arguments
-      body' <- evaluate env''' ("frag " <> name : stack) body
-      pure body'
+    Just frag@(Frag _ _ _) -> evalFrag env stack name values args frag
     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 <> "\" while evaluating " <> T.pack (show $ reverse stack) <> " with environment " <> displayEnv env
@@ -207,6 +206,15 @@ lookupVariable name Env {..} = lookup name envVariables
 augmentVariables :: Env -> [(Text, Expr)] -> Env
 augmentVariables Env {..} xs = Env {envVariables = xs <> envVariables}
 
+evalFrag :: Monad m => Env -> [Text] -> Text -> [Expr] -> [Block] -> Expr -> ExceptT Error.Error m [Block]
+evalFrag env stack name values args (Frag names capturedEnv body) = do
+  env' <- extractVariables' env args
+  let env'' = augmentVariables capturedEnv env'
+      arguments = zip names (map (thunk env) values)
+      env''' = augmentVariables env'' arguments
+  body' <- evaluate env''' ("frag " <> name : stack) body
+  pure body'
+
 evalExpr :: Monad m => Env -> Expr -> ExceptT Error.Error m Expr
 evalExpr env = \case
   Variable name ->
@@ -276,6 +284,9 @@ evalExpr env = \case
     evalApplication env a' b'
   Thunk capturedEnv code ->
     evalExpr capturedEnv code
+  frag@(Frag _ _ _) -> do
+    blocks <- evalFrag env ["frag"] "-" [] [] frag
+    pure . Block $ BlockList blocks
   code -> pure code
 
 evalApplication :: Monad m => Env -> Expr -> Expr -> ExceptT Error.Error m Expr
@@ -297,20 +308,19 @@ evalApplication env a b =
       _ -> throwE $ Error.EvaluateError $ "Cannot apply null to: " <> T.pack (show b)
     _ -> throwE $ Error.EvaluateError $ "Cannot apply: " <> T.pack (show a)
 
--- After evaluation, the template should be either empty or contain a single literal.
 evalTemplate :: Monad m => Env -> [Inline] -> ExceptT Error.Error m [Inline]
-evalTemplate env inlines = do
-  t <- T.concat <$> traverse (evalInline env) inlines
-  pure [Lit t]
+evalTemplate env inlines =
+  traverse (evalInline env) inlines
 
-evalInline :: Monad m => Env -> Inline -> ExceptT Error.Error m Text
+evalInline :: Monad m => Env -> Inline -> ExceptT Error.Error m Inline
 evalInline env = \case
-  Lit s -> pure s
+  Lit s -> pure $ Lit s
   Place code -> do
     code' <- evalExpr env code
     case code' of
-      SingleQuoteString s -> pure s
-      Int x -> pure . T.pack $ show x
+      SingleQuoteString _ -> pure $ Place code'
+      Int _ -> pure $ Place code'
+      Block _ -> pure $ Place code'
       -- Variable x -> context x -- Should not happen after evalExpr
       x -> error $ "evalInline: unhandled value: " <> show x
 

src/Slab/Render.hs

@@ -63,10 +63,11 @@ renderBlock (Syntax.BlockElem name mdot attrs children) =
   attrs' = Syntax.namesFromAttrs attrs
 renderBlock (Syntax.BlockText _ []) =
   H.preEscapedText "\n" -- This allows to force some whitespace.
-renderBlock (Syntax.BlockText _ [Syntax.Lit s])
-  | s == T.empty = H.preEscapedText "\n" -- This allows to force some whitespace.
-  | otherwise = H.preEscapedText s -- TODO
-renderBlock (Syntax.BlockText _ _) = error "Template is not rendered."
+renderBlock (Syntax.BlockText _ t) =
+  let s = renderTemplate t
+   in if s == T.empty
+        then H.preEscapedText "\n" -- This allows to force some whitespace.
+        else H.preEscapedText s -- TODO
 renderBlock (Syntax.BlockInclude (Just "escape-html") _ (Just nodes)) =
   escapeTexts nodes
 renderBlock (Syntax.BlockInclude _ _ (Just nodes)) = mapM_ renderBlock nodes
@@ -143,6 +144,22 @@ extractText = f
   f (Syntax.BlockList _) = error "extractTexts called on a BlockList"
   f (Syntax.BlockCode _) = error "extractTexts called on a BlockCode"
 
+-- After evaluation, we should have only reduced values (e.g. no variables).
+renderTemplate :: [Syntax.Inline] -> Text
+renderTemplate inlines =
+  let t = map renderInline inlines
+   in T.concat t
+
+renderInline :: Syntax.Inline -> Text
+renderInline = \case
+  Syntax.Lit s -> s
+  Syntax.Place code -> do
+    case code of
+      Syntax.SingleQuoteString s -> s
+      Syntax.Int x -> T.pack $ show x
+      Syntax.Block b -> TL.toStrict . renderHtml $ renderBlock b
+      x -> error $ "renderInline: unhandled value: " <> show x
+
 renderElem :: Syntax.Elem -> Html -> Html
 renderElem = \case
   Syntax.Html -> H.html