diff --git a/examples/interpolation.html b/examples/interpolation.html index c0db06f..d893703 100644 --- a/examples/interpolation.html +++ b/examples/interpolation.html @@ -15,6 +15,9 @@
++ Hello, world. +
diff --git a/examples/interpolation.slab b/examples/interpolation.slab index ee75f9b..1d9f68d 100644 --- a/examples/interpolation.slab +++ b/examples/interpolation.slab @@ -8,6 +8,7 @@ body p Hello, #('Charlie'). p Hello, #(42). p Hello, #(a). +p Hello, #(span | a | 'world'). p Hello, #{a}. p Hello, #{a number #(1)}. p Hello, #{el x}. diff --git a/src/Slab/Evaluate.hs b/src/Slab/Evaluate.hs index 068ee8e..5be3811 100644 --- a/src/Slab/Evaluate.hs +++ b/src/Slab/Evaluate.hs @@ -278,6 +278,15 @@ evalExpr env = \case (Int i, Int j) -> pure . Bool $ i == j (SingleQuoteString s, SingleQuoteString t) -> pure . Bool $ s == t _ -> throwE $ Error.EvaluateError $ "Unimplemented (equal): " <> T.pack (show (Equal a' b')) + Cons a b -> do + a' <- evalExpr env a + b' <- evalExpr env b + case (a', b') of + (Block bl, Block c) -> + pure . Block $ setContent [c] bl + (Block bl, SingleQuoteString s) -> + pure . Block $ setContent [BlockText Normal [Lit s]] bl + _ -> throwE $ Error.EvaluateError $ "Unimplemented (cons): " <> T.pack (show (Cons a' b')) Application a b -> do a' <- evalExpr env a b' <- evalExpr env b @@ -286,7 +295,9 @@ evalExpr env = \case evalExpr capturedEnv code frag@(Frag _ _ _) -> do blocks <- evalFrag env ["frag"] "-" [] [] frag - pure . Block $ BlockList blocks + case blocks of + [bl] -> pure $ Block bl + _ -> pure . Block $ BlockList blocks Block b -> do b' <- eval env ["block"] b pure $ Block b' @@ -322,6 +333,7 @@ evalInline env = \case code' <- evalExpr env code case code' of SingleQuoteString _ -> pure $ Place code' + Bool _ -> pure $ Place code' Int _ -> pure $ Place code' Block _ -> pure $ Place code' -- Variable x -> context x -- Should not happen after evalExpr diff --git a/src/Slab/Parse.hs b/src/Slab/Parse.hs index 44456c2..977af2c 100644 --- a/src/Slab/Parse.hs +++ b/src/Slab/Parse.hs @@ -235,6 +235,8 @@ operatorTable = , [InfixL (symbol "+" $> Add), InfixL (symbol "-" $> Sub)] , [InfixL (symbol ">" $> GreaterThan), InfixL (symbol "<" $> LesserThan)] , [InfixL (symbol "==" $> Equal)] + , -- I'd like to use : instead, but it is already used for objects... + [InfixR (symbol "|" $> Cons)] ] parserVariable' :: Parser Expr @@ -682,7 +684,7 @@ parseLit :: InlineContext -> Parser Inline parseLit ctx = do s <- case ctx of NormalBlock -> M.takeWhile1P (Just "literal") (\c -> c /= '#' && c /= '\n') - InlineBlock -> M.takeWhile1P (Just "literal") (\c -> c /= '#' && c /= '\n' && c/= '}') + InlineBlock -> M.takeWhile1P (Just "literal") (\c -> c /= '#' && c /= '\n' && c /= '}') pure $ Lit s parsePlaceExpr :: Parser Inline @@ -702,13 +704,13 @@ parsePlaceBlock = do -- | Equivalent to `parserBlock` but in an inline context. parseInlineBlock :: Parser Block parseInlineBlock = do - header <- parserDiv <|> parserCall - template <- parseInlines' InlineBlock - -- Don't return anything of the template is empty. to avoid a newline when - -- rendering. - if null template - then pure $ header [] - else pure $ header [BlockText Dot template] + header <- parserDiv <|> parserCall + template <- parseInlines' InlineBlock + -- Don't return anything of the template is empty. to avoid a newline when + -- rendering. + if null template + then pure $ header [] + else pure $ header [BlockText Dot template] parseEscape :: Parser Inline parseEscape = do diff --git a/src/Slab/Render.hs b/src/Slab/Render.hs index 83a650e..17ac823 100644 --- a/src/Slab/Render.hs +++ b/src/Slab/Render.hs @@ -156,6 +156,7 @@ renderInline = \case Syntax.Place code -> do case code of Syntax.SingleQuoteString s -> s + Syntax.Bool x -> T.pack $ show x Syntax.Int x -> T.pack $ show x Syntax.Block b -> TL.toStrict . renderHtml $ renderBlock b x -> error $ "renderInline: unhandled value: " <> show x diff --git a/src/Slab/Syntax.hs b/src/Slab/Syntax.hs index 1c94c55..6101f05 100644 --- a/src/Slab/Syntax.hs +++ b/src/Slab/Syntax.hs @@ -5,6 +5,7 @@ module Slab.Syntax , isDoctype , pasteBlocks , setAttrs + , setContent , CommentType (..) , Elem (..) , TrailingSym (..) @@ -84,12 +85,18 @@ pasteBlocks a b = BlockList $ peel a <> peel b peel (BlockList xs) = xs peel x = [x] --- | Set attrs on a the block, if it is a BlockElem. +-- | Set attrs on a the first 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 +-- | Set the content on a block, if it is a BlockElem. +setContent :: [Block] -> Block -> Block +setContent nodes (BlockElem name mdot attrs _) = + BlockElem name mdot attrs nodes +setContent _ b = b + -- | A "passthrough" comment will be included in the generated HTML. data CommentType = NormalComment | PassthroughComment deriving (Show, Eq) @@ -190,6 +197,9 @@ data Expr | GreaterThan Expr Expr | LesserThan Expr Expr | Equal Expr Expr + | -- Not really a cons for lists, but instead to add content to an element. + -- E.g. p : "Hello." + Cons Expr Expr | Block Block | -- Expr can be a fragment, so we can manipulate them with code later. -- We also capture the current environment.