Template compiler kinda working!

hie.yaml

@@ -1,13 +1,13 @@
 cradle:
   stack:
-    - path: "src"
+    - path: "./src"
       component: "green:lib"
 
-    - path: "app/author"
+    - path: "./app/author/Main.hs"
       component: "green:exe:author"
 
-    - path: "app/site"
+    - path: "./app/site/Main.hs"
       component: "green:exe:site"
 
-    - path: "test"
+    - path: "./test"
       component: "green:test:test"

site/contact.md

@@ -1,3 +1,3 @@
-I live in a tiramisù and have pudding in my ears. Please contact me via [$authorEmail$](mailto:$authorEmail$) and I shall free my eyes to read and reply heartily; my fingers typing though they have been soaking like biscuits in espresso and cream. I welcome conversations and questions about what I do and I might even ask a few questions of my own, but I do not know how I came to be floating in mascarpone.
+I live in a tiramisù and have pudding in my ears. Please contact me via [{{ authorEmail }}](mailto:{{ authorEmail }}) and I shall free my eyes to read and reply heartily; my fingers typing though they have been soaking like biscuits in espresso and cream. I welcome conversations and questions about what I do and I might even ask a few questions of my own, but I do not know how I came to be floating in mascarpone.
 
-$partial("_partials/employment.html")$
+{{ partial "employment.html" }}

site/resume.md

@@ -1 +1 @@
-Please see my [LinkedIn profile]($linkedInProfile$) for my employment history.
+Please see my [LinkedIn profile]({{ linkedInProfile }}) for my employment history.

src/Green/Template/Ast.hs

@@ -28,9 +28,9 @@ data Block
   | CommentBlock String SourcePos -- {{! this comment }}
   | LayoutBlock Expression SourcePos -- {{@ include "this/file.md" }}
   | TemplateStartBlock Expression SourcePos -- {{# expression }}
-  | TemplateNextBlock Expression SourcePos -- {{# else expression }}
-  | TemplateElseBlock SourcePos -- {{# else }}
-  | TemplateEndBlock SourcePos -- {{# end }}
+  | TemplateNextBlock Expression SourcePos -- {{ else expression }}
+  | TemplateElseBlock SourcePos -- {{ else }}
+  | TemplateEndBlock SourcePos -- {{ end }}
   | LayoutApplyBlock Expression Template SourcePos
   | TemplateBlock (NonEmpty TemplateApplyBlock) (Maybe TemplateDefaultBlock) SourcePos
   deriving stock (Show, Generic)
@@ -151,6 +151,7 @@ data Expression
   | AccessExpression Expression Expression SourcePos -- target.field
   | FilterExpression Expression Expression SourcePos -- arg | fn
   | ContextExpression [(String, Expression)] SourcePos -- { name0: value0, name1: value1 }
+  | ListExpression [Expression] SourcePos -- [a, b, c]
   deriving stock (Show, Generic)
 
 getExpressionPos :: Expression -> SourcePos
@@ -164,6 +165,7 @@ getExpressionPos = \case
   AccessExpression _ _ pos -> pos
   FilterExpression _ _ pos -> pos
   ContextExpression _ pos -> pos
+  ListExpression _ pos -> pos
 
 getExpressionTag :: Expression -> Int
 getExpressionTag = \case
@@ -176,6 +178,7 @@ getExpressionTag = \case
   AccessExpression {} -> 7
   FilterExpression {} -> 8
   ContextExpression {} -> 9
+  ListExpression {} -> 10
 
 instance Binary Expression where
   get = do
@@ -190,6 +193,7 @@ instance Binary Expression where
       7 -> AccessExpression <$> get <*> get
       8 -> FilterExpression <$> get <*> get
       9 -> ContextExpression <$> get
+      10 -> ListExpression <$> get
       _ -> error $ "Unrecognized expression tag " ++ show tag
     binaryPos <- get :: Get BinaryPos
     return $ f (unBinaryPos binaryPos)
@@ -206,4 +210,5 @@ instance Binary Expression where
       AccessExpression target field _ -> put target >> put field
       FilterExpression arg fn _ -> put arg >> put fn
       ContextExpression pairs _ -> put pairs
+      ListExpression values _ -> put values
     put $ BinaryPos (getExpressionPos expression)

src/Green/Template/Compiler.hs

@@ -1,92 +1,168 @@
 module Green.Template.Compiler where
 
-import Control.Monad.Except
+import Data.Foldable (foldlM)
+import Data.List (intercalate)
+import Data.Maybe
+import Data.Traversable
 import Green.Template.Ast
 import Green.Template.Context
 import Green.Template.Parser (parseTemplate)
-import Hakyll
-  ( Compiler,
-    Identifier,
-    Item (..),
-    MonadMetadata (..),
-    cached,
-    debugCompiler,
-    getResourceBody,
-    getUnderlying,
-    makeItem,
-    toFilePath,
-    withItemBody,
-  )
-import Text.Parsec
-import Prelude hiding (exp, filter, lookup)
+import Hakyll hiding (Context, Template, applyTemplate, compileTemplateItem, field)
+import Text.Parsec (SourcePos, sourceName)
+import Prelude hiding (lookup)
+
+isTruthy :: (MonadFail m) => ContextValue -> m Bool
+isTruthy = \case
+  ContextValue _ -> return True
+  ListValue values -> return $ not (null values)
+  ErrorValue {} -> return False
+  UndefinedValue {} -> return False
+  BoolValue value -> return value
+  StringValue value -> return $ not (null value)
+  DoubleValue value -> return $ value /= 0
+  IntValue value -> return $ value /= 0
+  NameValue name -> fail $ "Unevaluated name " ++ show name
+  FunctionValue {} -> return True
+  TemplateValue (Template blocks _) -> return $ not (null blocks)
+  UnitValue {} -> return False
+
+isFalsy :: (MonadFail m) => ContextValue -> m Bool
+isFalsy = fmap not . isTruthy
 
 templateCompiler :: Compiler (Item Template)
-templateCompiler = cached "Green.Template.Compiler.templateCompiler" do
-  id' <- getUnderlying
-  item <- getResourceBody
-  debugCompiler $ "Compiling template from " ++ show id'
-  withItemBody (compileTemplateFile id') item
+templateCompiler =
+  cached "Green.Template.Compiler.templateCompiler" $
+    getResourceBody
+      >>= compileTemplateItem
+      >>= makeItem
 
-applyTemplate :: Template -> Context -> Item String -> Compiler (Item String)
-applyTemplate (Template blocks pos) _context item = do
-  debugCompiler $ "Applying template " ++ show (sourceName pos) ++ " to " ++ show (itemIdentifier item)
-  sequence (goBlock <$> blocks)
-    >>= fmap mconcat . mapM render
-    >>= makeItem
-  where
-    goBlock block =
-      case block of
-        CommentBlock _ _ -> return $ StringValue ""
-        TextBlock value _ -> return $ StringValue value
-        _ -> undefined
+compileTemplateItem :: Item String -> Compiler Template
+compileTemplateItem item = do
+  filePath <- getResourceFilePath
+  debugCompiler $ "Compiling template from " ++ show filePath
+  either (fail . show) return (parseTemplate filePath (itemBody item))
 
 applyAsTemplate :: Context -> Item String -> Compiler (Item String)
 applyAsTemplate context item = do
-  debugCompiler $ "Applying " ++ show (itemIdentifier item) ++ " as template"
-  template <- compileTemplateFile (itemIdentifier item) (itemBody item)
+  template <- compileTemplateItem item
   applyTemplate template context item
 
-compileTemplateFile :: Identifier -> String -> Compiler Template
-compileTemplateFile id' input = do
-  debugCompiler $ "Compiling template file " ++ show id'
-  case parseTemplate (toFilePath id') input of
-    Right template -> do
-      debugCompiler $ "Parsed template from file " ++ show id'
-      return template
-    Left e -> do
-      debugCompiler $ "Failed to parse template file " ++ show id' ++ ": " ++ show e
-      fail (show e)
+applyTemplate :: Template -> Context -> Item String -> Compiler (Item String)
+applyTemplate template context item = do
+  let (Template blocks pos) = template
+  let id' = itemIdentifier item
+  debugCompiler $ "Applying template " ++ show (sourceName pos) ++ " to item " ++ show id'
+  context' <- (context <>) <$> getContext (itemIdentifier item)
+  makeItem =<< applyBlocks context' blocks item
 
-render :: (MonadFail m) => ContextValue -> m String
-render = \case
-  StringValue value -> return value
-  BoolValue value -> return $ show value
-  DoubleValue value -> return $ show value
-  IntValue value -> return $ show value
-  ListValue values -> mconcat <$> sequence (render <$> values)
-  ErrorValue message -> fail message
-  UndefinedValue name -> fail $ "Tried to render undefined value identified by " ++ show name
-  TemplateValue template -> fail $ "Tried to render template value " ++ show (sourceName (getTemplatePos template))
-  NameValue name -> fail $ "Tried to render unresolved name value " ++ show name
-  ContextValue {} -> fail "Tried to render context value"
-  FunctionValue {} -> fail "Tried to render function value"
+applyBlocks :: Context -> [Block] -> Item String -> Compiler String
+applyBlocks context (block : rest) item = do
+  thisResult <- applyBlock context block item
+  restResults <- applyBlocks context rest item
+  return (thisResult ++ restResults)
+applyBlocks _ [] _ = return ""
 
-getContext :: Identifier -> Compiler Context
-getContext = fmap contextFromMetadata . getMetadata
+applyBlock :: Context -> Block -> Item String -> Compiler String
+applyBlock context block item = case block of
+  TextBlock value _ -> return value
+  ExpressionBlock expression _ -> stringify <$> eval context expression item
+  CommentBlock _ _ -> return ""
+  LayoutApplyBlock expression template _ -> snd <$> applyGuard expression template
+  TemplateBlock blocks defaultBlocks _ ->
+    foldlM applyTemplateBlocks (False, "") blocks >>= \case
+      (True, result) -> return result
+      _ -> applyDefaultBlocks
+    where
+      applyTemplateBlocks result@(stop, _) (TemplateApplyBlock expression template _)
+        | stop = return result
+        | otherwise = applyGuard expression template
+      applyDefaultBlocks =
+        case defaultBlocks of
+          Just (TemplateDefaultBlock (Template blocks' _) _) -> applyBlocks context blocks' item
+          Nothing -> return ""
+  _ -> fail $ "Unexpected block in " ++ show (getBlockPos block)
+  where
+    stringify = \case
+      StringValue value -> value
+      IntValue value -> show value
+      DoubleValue value -> show value
+      BoolValue value -> show value
+      ListValue values -> intercalate "" (stringify <$> values)
+      x -> show x
+    applyGuard guardExp template@(Template blocks _) =
+      eval context guardExp item >>= \case
+        FunctionValue f -> do
+          result <- f (TemplateValue template) context item
+          truthy <- isTruthy result
+          return (truthy, stringify result)
+        guard@(ContextValue context') ->
+          isTruthy guard >>= \case
+            True -> (True,) <$> applyBlocks (context' <> context) blocks item
+            False -> return (False, "")
+        guard ->
+          isTruthy guard >>= \case
+            True -> (True,) <$> applyBlocks context blocks item
+            False -> return (False, "")
 
-defaultContext :: Context
-defaultContext = undefined
+eval :: Context -> Expression -> Item String -> Compiler ContextValue
+eval context expression item = case expression of
+  StringExpression value _ -> return $ StringValue value
+  IntExpression value _ -> return $ IntValue value
+  DoubleExpression value _ -> return $ DoubleValue value
+  BoolExpression value _ -> return $ BoolValue value
+  --
+  ApplyExpression f x pos -> apply f x pos context item
+  FilterExpression x f pos -> apply f x pos context item
+  --
+  ListExpression values _ -> do
+    let eval' e = eval context e item
+    ListValue <$> mapM eval' values
+  --
+  ContextExpression expKeyVals _ -> do
+    let evalKV k v = (k,) <$> eval context v item
+    keyVals <- mapM (uncurry evalKV) expKeyVals
+    return $ ContextValue (intoContext keyVals)
+  --
+  NameExpression name pos -> do
+    maybeVal <- lookup name context item
+    maybe (undefinedValue name pos) return maybeVal
+  --
+  AccessExpression targetExp fieldExp pos ->
+    eval context targetExp item >>= \case
+      ContextValue target ->
+        case fieldExp of
+          NameExpression field _ -> do
+            result <- lookup field target item
+            maybe (undefinedValue field pos) return result
+          _ ->
+            eval context fieldExp item >>= \case
+              StringValue field -> do
+                result <- lookup field target item
+                maybe (undefinedValue field pos) return result
+              _ -> fail $ "Can't access field from context in " ++ show pos
+      ListValue list ->
+        eval context fieldExp item >>= \case
+          IntValue index
+            | index < length list -> return $ list !! index
+            | otherwise -> fail $ "Index " ++ show index ++ " out of bounds in " ++ show pos
+          val -> fail $ "Can't index into list with " ++ show val ++ " in " ++ show pos
+      _ -> fail $ "Can't access field from expression in " ++ show pos
 
-contextFn :: (ContextValue -> Context -> Item String -> Compiler ContextValue) -> ContextValue
-contextFn = FunctionValue
+apply :: Expression -> Expression -> SourcePos -> Context -> Item String -> Compiler ContextValue
+apply fExp xExp pos context item =
+  eval context fExp item >>= \case
+    FunctionValue f' -> do
+      x <- eval context xExp item
+      f' x context item
+    x -> fail $ "Can't apply " ++ show x ++ " as function in " ++ show pos
 
-contextFn2 :: (ContextValue -> ContextValue -> Context -> Item String -> Compiler ContextValue) -> ContextValue
-contextFn2 f2 = FunctionValue f1
-  where
-    f1 arg1 _ _ = return $ FunctionValue (f2 arg1)
+asString :: Expression -> Compiler String
+asString = \case
+  StringExpression value _ -> return value
+  IntExpression value _ -> return $ show value
+  DoubleExpression value _ -> return $ show value
+  BoolExpression value _ -> return $ show value
+  e -> fail $ "Unevaluated " ++ show e ++ " in " ++ show (getExpressionPos e)
 
-contextFn3 :: (ContextValue -> ContextValue -> ContextValue -> Context -> Item String -> Compiler ContextValue) -> ContextValue
-contextFn3 f3 = FunctionValue f1
-  where
-    f1 arg1 _ _ = return $ FunctionValue (f2 arg1)
-    f2 arg1 arg2 _ _ = return $ FunctionValue (f3 arg1 arg2)
+undefinedValue :: String -> SourcePos -> Compiler a
+undefinedValue name pos = fail $ "Undefined value " ++ show name ++ " in " ++ show pos

src/Green/Template/Context.hs

@@ -6,13 +6,64 @@ import Data.Either
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe
-import qualified Data.Scientific as Scientific
+import Data.Scientific
 import qualified Data.Text as T
 import qualified Data.Vector as Vector
 import Green.Template.Ast
-import Hakyll (Compiler, Item (..), Metadata)
+import Hakyll (Compiler, Item (..))
+import qualified Hakyll as H
 import Prelude hiding (lookup)
 
+data Context
+  = MapContext MapContext
+  | FunctionContext FunctionContext
+
+type MapContext = HashMap String ContextValue
+
+type FunctionContext = String -> Item String -> Compiler (Maybe ContextValue)
+
+singleton :: String -> ContextValue -> Context
+singleton name value = MapContext (HashMap.singleton name value)
+
+lookup :: String -> Context -> Item String -> Compiler (Maybe ContextValue)
+lookup name (MapContext m) _ = return $ HashMap.lookup name m
+lookup name (FunctionContext f) item = f name item
+
+insert :: String -> ContextValue -> Context -> Context
+insert name value = \case
+  MapContext m -> MapContext (HashMap.insert name value m)
+  f@FunctionContext {} -> singleton name value <> f
+
+getContext :: H.Identifier -> Compiler Context
+getContext id' = intoContext <$> H.getMetadata id'
+
+defaultContext :: Context
+defaultContext = metadataField
+
+metadataField :: Context
+metadataField = FunctionContext f
+  where
+    f name item = do
+      context <- getContext (itemIdentifier item)
+      lookup name context item
+
+functionField :: String -> (Item String -> Compiler (Maybe ContextValue)) -> Context
+functionField name f = FunctionContext f'
+  where
+    f' receivedName item
+      | receivedName == name = f item
+      | otherwise = return Nothing
+
+instance Semigroup Context where
+  f <> g = FunctionContext h
+    where
+      h name item =
+        let lookup' = flip (lookup name) item
+         in (<|>) <$> lookup' f <*> lookup' g
+
+instance Monoid Context where
+  mempty = MapContext HashMap.empty
+
 data ContextValue
   = ContextValue Context
   | ListValue [ContextValue]
@@ -23,99 +74,45 @@ data ContextValue
   | DoubleValue Double
   | IntValue Int
   | NameValue String
-  | FunctionValue (ContextValue -> Context -> Item String -> Compiler ContextValue)
+  | FunctionValue FunctionValue
   | TemplateValue Template
+  | UnitValue
 
-trueValue :: ContextValue
-trueValue = BoolValue True
-
-falseValue :: ContextValue
-falseValue = BoolValue False
+type FunctionValue = ContextValue -> Context -> Item String -> Compiler ContextValue
 
 instance Show ContextValue where
   show = \case
-    ContextValue {} -> "(ContextValue)"
-    ListValue values -> "(ListValue " ++ show values ++ ")"
-    ErrorValue e -> "(ErrorValue " ++ show e ++ ")"
-    UndefinedValue name -> "(UndefinedValue " ++ show name ++ ")"
-    NameValue name -> "(NameValue " ++ show name ++ ")"
-    BoolValue b -> "(BoolValue " ++ show b ++ ")"
-    StringValue t -> "(StringValue " ++ show t ++ ")"
-    DoubleValue d -> "(DoubleValue " ++ show d ++ ")"
-    IntValue i -> "(IntValue " ++ show i ++ ")"
-    FunctionValue {} -> "(FunctionValue)"
-    TemplateValue template -> "(TemplateValue " ++ show template ++ ")"
-
-isTruthy :: ContextValue -> Bool
-isTruthy = \case
-  ContextValue _ -> True
-  NameValue _ -> True
-  FunctionValue _ -> True
-  BoolValue bool -> bool
-  DoubleValue double -> double > 0.0
-  IntValue int -> int > 0
-  StringValue value -> not (null value)
-  ListValue values -> not (null values)
-  TemplateValue (Template blocks _) -> not (null blocks)
-  _ -> False
-
-isFalsy :: ContextValue -> Bool
-isFalsy = not . isTruthy
-
-data LookupResult
-  = LookupFound ContextValue
-  | LookupMissing String
-  deriving stock (Show)
-
-lookupToValue :: LookupResult -> ContextValue
-lookupToValue = \case
-  LookupFound value -> value
-  LookupMissing name -> UndefinedValue name
-
-lookupFound :: (Monad m) => ContextValue -> m LookupResult
-lookupFound = return . LookupFound
-
-lookupMissing :: (Monad m) => String -> m LookupResult
-lookupMissing = return . LookupMissing
-
-data Context
-  = MapContext (HashMap String ContextValue)
-  | FunctionContext (String -> Item String -> Compiler LookupResult)
-
-instance Semigroup Context where
-  f <> g = FunctionContext h
+    ContextValue {} -> "ContextValue"
+    ListValue values -> "ListValue (" ++ show values ++ ")"
+    ErrorValue e -> "ErrorValue " ++ show e
+    UndefinedValue name -> "UndefinedValue " ++ show name
+    NameValue name -> "NameValue " ++ show name
+    BoolValue b -> "BoolValue " ++ show b
+    StringValue t -> "StringValue " ++ show t
+    DoubleValue d -> "DoubleValue " ++ show d
+    IntValue i -> "IntValue " ++ show i
+    FunctionValue {} -> "FunctionValue"
+    TemplateValue template -> "TemplateValue (" ++ show template ++ ")"
+    UnitValue -> "Unit"
+
+class IntoContext a where
+  intoContext :: a -> Context
+
+instance IntoContext [(String, ContextValue)] where
+  intoContext = intoContext . HashMap.fromList
+
+instance IntoContext (HashMap String ContextValue) where
+  intoContext = MapContext
+
+instance IntoContext Object where
+  intoContext = intoContext . HashMap.mapKeys T.unpack . HashMap.map go
     where
-      h name item = (verify =<< lookup f name item) <|> lookup g name item
-      verify = \case
-        x@LookupFound {} -> return x
-        LookupMissing name -> error $ "Did not find " ++ name ++ " in context"
-
-instance Monoid Context where
-  mempty = FunctionContext (const . lookupMissing)
-
-lookup :: Context -> String -> Item String -> Compiler LookupResult
-lookup (MapContext m) name _ = maybe (lookupMissing name) lookupFound (HashMap.lookup name m)
-lookup (FunctionContext f) name item = f name item
-
-contextFromList :: [(String, ContextValue)] -> Context
-contextFromList keyVals = contextFromMap (HashMap.fromList keyVals)
-
-contextFromMap :: HashMap String ContextValue -> Context
-contextFromMap = MapContext
-
-contextFromMetadata :: Metadata -> Context
-contextFromMetadata = contextFromObject
-{-# INLINE contextFromMetadata #-}
-
-contextFromObject :: Object -> Context
-contextFromObject o = contextFromMap $ HashMap.mapKeys T.unpack (HashMap.map go o)
-  where
-    go = \case
-      Object o' -> ContextValue $ contextFromObject o'
-      Array a -> ListValue $ Vector.toList $ Vector.map go a
-      String t -> StringValue $ T.unpack t
-      Number n
-        | Scientific.isInteger n -> IntValue $ fromJust $ Scientific.toBoundedInteger n
-        | otherwise -> DoubleValue $ fromRight 0.0 $ Scientific.toBoundedRealFloat n
-      Bool b -> BoolValue b
-      Null -> UndefinedValue "null"
+      go = \case
+        Object o -> ContextValue $ intoContext o
+        Array a -> ListValue $ Vector.toList $ Vector.map go a
+        String t -> StringValue $ T.unpack t
+        Number n
+          | isInteger n -> IntValue $ fromJust $ toBoundedInteger n
+          | otherwise -> DoubleValue $ fromRight 0.0 $ toBoundedRealFloat n
+        Bool b -> BoolValue b
+        Null -> UndefinedValue "null"

src/Green/Template/Parser.hs

@@ -7,7 +7,7 @@ import Data.List.NonEmpty as NEL
 import Data.Maybe
 import Data.Scientific
 import Green.Template.Ast
-import Text.Parsec hiding (runParser, runParserT, token, tokens, (<?>))
+import Text.Parsec hiding (runParser, token, (<?>))
 import qualified Text.Parsec as P
 import Text.Parsec.Pos
 
@@ -88,34 +88,26 @@ type TokenParser a = Parsec [Token] ParserState a
 
 type Lexer a = Parsec String ParserState a
 
+runParser :: (Stream s Identity t) => Parsec s ParserState a -> SourceName -> s -> Either ParseError a
+runParser = runParserWith state
+  where
+    state = def
+
 debugRunParser :: (Stream s Identity t) => Parsec s ParserState a -> SourceName -> s -> Either ParseError a
-debugRunParser p = P.runParser p state
+debugRunParser = runParserWith state
   where
     state = def {parserStateIsDebugging = True}
 
-runParser :: (Stream s Identity t) => Parsec s ParserState a -> SourceName -> s -> Either ParseError a
-runParser p = P.runParser p state
-  where
-    state = def
+runParserWith :: (Stream s Identity t) => ParserState -> Parsec s ParserState a -> SourceName -> s -> Either ParseError a
+runParserWith state p = P.runParser p state
 
 parseTemplate :: SourceName -> String -> Either ParseError Template
 parseTemplate origin =
-  runParser tokens origin
-    >=> runParser blocks origin
-    >=> fmap intoTemplate . runParser (structures <* eof) origin
+  runParser (many token <* eof) origin
+    >=> runParser (many block <* eof) origin
+    >=> fmap intoTemplate . runParser (many structure <* eof) origin
   where
-    intoTemplate blocks' = Template blocks' (initialPos origin)
-
-debugParseTemplate :: SourceName -> String -> Either ParseError Template
-debugParseTemplate origin =
-  runParser tokens origin
-    >=> runParser blocks origin
-    >=> fmap intoTemplate . debugRunParser (structures <* eof) origin
-  where
-    intoTemplate blocks' = Template blocks' (initialPos origin)
-
-structures :: BlockParser [Block]
-structures = many structure
+    intoTemplate blocks = Template blocks (initialPos origin)
 
 structure :: BlockParser Block
 structure =
@@ -139,7 +131,7 @@ appliedLayout = p <?> "AppliedLayoutStructure"
       expression' <- withBlock \case
         LayoutBlock e _ -> Just e
         _ -> Nothing
-      structure' <- Template <$> structures
+      structure' <- Template <$> many structure
       return \pos -> LayoutApplyBlock expression' (structure' pos) pos
 
 appliedTemplate :: BlockParser Block
@@ -204,9 +196,6 @@ withBlock = P.token showToken tokenPos
     showToken = show
     tokenPos = getBlockPos
 
-blocks :: TokenParser [Block]
-blocks = many block <* eof
-
 block :: TokenParser Block
 block = tryOne [templateBlock, textBlock]
 
@@ -361,7 +350,8 @@ simpleExpression =
       boolExpression,
       nameExpression,
       parensExpression,
-      contextExpression
+      contextExpression,
+      listExpression
     ]
 
 stringExpression :: TokenParser Expression
@@ -400,34 +390,28 @@ nameExpression = p <?> "Name"
       _ -> Nothing
 
 parensExpression :: TokenParser Expression
-parensExpression = p <?> "ParensExpression"
-  where
-    p = do
-      withToken \case
-        OpenParenToken {} -> Just ()
-        _ -> Nothing
-      expression' <- expression
-      withToken \case
-        CloseParenToken {} -> Just ()
-        _ -> Nothing
-      return expression'
+parensExpression = do
+  withToken \case
+    OpenParenToken {} -> Just ()
+    _ -> Nothing
+  expression' <- expression
+  withToken \case
+    CloseParenToken {} -> Just ()
+    _ -> Nothing
+  return expression'
 
 contextExpression :: TokenParser Expression
 contextExpression = p <?> "ContextLiteral"
   where
-    p = do
-      pos <- withToken \case
-        OpenBraceToken pos -> Just pos
+    p = withPosition do
+      withToken \case
+        OpenBraceToken {} -> Just ()
         _ -> Nothing
       pairs <- contextKeyValue `sepBy` comma
       withToken \case
         CloseBraceToken {} -> Just ()
         _ -> Nothing
-      return $ ContextExpression pairs pos
-      where
-        comma = withToken \case
-          CommaToken {} -> Just ()
-          _ -> Nothing
+      return $ ContextExpression pairs
 
 contextKeyValue :: TokenParser (String, Expression)
 contextKeyValue = p <?> "Pair"
@@ -442,6 +426,25 @@ contextKeyValue = p <?> "Pair"
       value <- expression
       return (key, value)
 
+listExpression :: TokenParser Expression
+listExpression = p <?> "ListLiteral"
+  where
+    p = withPosition do
+      withToken \case
+        OpenBracketToken {} -> Just ()
+        _ -> Nothing
+      values <- expression `sepEndBy` comma
+      withToken \case
+        CloseBracketToken {} -> Just ()
+        _ -> Nothing
+      return $ ListExpression values
+
+comma :: TokenParser ()
+comma =
+  () <$ withToken \case
+    CommaToken {} -> Just ()
+    _ -> Nothing
+
 requireText :: TokenParser (String, SourcePos)
 requireText = withToken f <?> "Text"
   where
@@ -452,9 +455,6 @@ requireText = withToken f <?> "Text"
 withToken :: (Token -> Maybe a) -> Parsec [Token] u a
 withToken = P.token show getTokenPos
 
-tokens :: Parsec String ParserState [Token]
-tokens = many token <* eof <?> "Tokens"
-
 token :: Lexer Token
 token =
   getLexerMode >>= \case
@@ -554,21 +554,26 @@ text = p <?> "TextBody"
 
 symbolToken :: Lexer Token
 symbolToken =
-  withPosition $
-    tryOne
-      [ ws (OpenBraceToken <$ openBraceChar <?> "OpenBraceToken '{'"),
-        ws (CloseBraceToken <$ closeBraceChar <?> "CloseBraceToken '}'"),
-        ws (OpenParenToken <$ char '(' <?> "OpenParenToken '('"),
-        ws (CloseParenToken <$ char ')' <?> "CloseParenToken ')'"),
-        ws (OpenBlockToken <$ string "{{" <?> "OpenBlockToken '{{'"),
-        CloseBlockToken <$ string "}}" <?> "CloseBlockToken '}}'",
-        ws (OpenTemplateToken <$ char '#' <?> "TemplateBlockToken '#'"),
-        ws (OpenLayoutToken <$ char '@' <?> "LayoutBlockToken '@'"),
-        OpenCommentToken <$ char '!' <?> "CommentBlockToken '!'",
-        ws (PipeToken <$ char '|' <?> "PipeToken '|'"),
-        ws (ColonToken <$ char ':' <?> "ColonToken ':'"),
-        ws (DotToken <$ char '.' <?> "DotToken '.'"),
-        ws (CommaToken <$ char ',' <?> "CommaToken ','")
+  withPosition $ tryOne (fmap ws trimmed ++ untrimmed)
+  where
+    untrimmed =
+      [ CloseBlockToken <$ string "}}" <?> "CloseBlockToken '}}'",
+        OpenCommentToken <$ char '!' <?> "CommentBlockToken '!'"
+      ]
+    trimmed =
+      [ OpenParenToken <$ char '(' <?> "OpenParenToken '('",
+        CloseParenToken <$ char ')' <?> "CloseParenToken ')'",
+        OpenBraceToken <$ openBraceChar <?> "OpenBraceToken '{'",
+        CloseBraceToken <$ closeBraceChar <?> "CloseBraceToken '}'",
+        OpenBracketToken <$ char '[' <?> "OpenBracketToken '['",
+        CloseBracketToken <$ char ']' <?> "OpenBracketToken ']'",
+        OpenBlockToken <$ string "{{" <?> "OpenBlockToken '{{'",
+        OpenTemplateToken <$ char '#' <?> "TemplateBlockToken '#'",
+        OpenLayoutToken <$ char '@' <?> "LayoutBlockToken '@'",
+        PipeToken <$ char '|' <?> "PipeToken '|'",
+        ColonToken <$ char ':' <?> "ColonToken ':'",
+        DotToken <$ char '.' <?> "DotToken '.'",
+        CommaToken <$ char ',' <?> "CommaToken ','"
       ]
 
 expectBlockOpen :: Lexer ()
@@ -704,10 +709,12 @@ data Token
   | OpenLayoutToken SourcePos -- "@"
   | OpenTemplateToken SourcePos -- "#"
   | OpenCommentToken SourcePos -- "!"
+  | OpenParenToken SourcePos -- "("
+  | CloseParenToken SourcePos -- ")"
+  | OpenBracketToken SourcePos -- "["
+  | CloseBracketToken SourcePos -- "]"
   | OpenBraceToken SourcePos -- "{"
   | CloseBraceToken SourcePos -- "}"
-  | OpenParenToken SourcePos -- '('
-  | CloseParenToken SourcePos -- ')'
   | PipeToken SourcePos -- "|"
   | CommaToken SourcePos -- ","
   | DotToken SourcePos -- "."
@@ -729,10 +736,12 @@ getTokenPos = \case
   OpenLayoutToken pos -> pos
   OpenTemplateToken pos -> pos
   OpenCommentToken pos -> pos
-  OpenBraceToken pos -> pos
-  CloseBraceToken pos -> pos
   OpenParenToken pos -> pos
   CloseParenToken pos -> pos
+  OpenBracketToken pos -> pos
+  CloseBracketToken pos -> pos
+  OpenBraceToken pos -> pos
+  CloseBraceToken pos -> pos
   PipeToken pos -> pos
   CommaToken pos -> pos
   DotToken pos -> pos

test/Green/Template/ParserSpec.hs

@@ -4,7 +4,7 @@ import Data.List.NonEmpty as NEL
 import Green.Template
 import Green.Template.Structural
 import Green.TestSupport
-import Text.Parsec hiding (runParser, runParserT, tokens)
+import Text.Parsec hiding (runParser, runParserT, token, tokens)
 
 spec :: Spec
 spec = do
@@ -178,6 +178,17 @@ spec = do
                            )
                        )
                    ]
+      "{{ [1, 2, 3] }}"
+        `produces` [ ExpressionBlock'
+                       ( ListExpression'
+                           [ IntExpression' 1,
+                             IntExpression' 2,
+                             IntExpression' 3
+                           ]
+                       )
+                   ]
+      "{{ [] }}"
+        `produces` [ExpressionBlock' (ListExpression' [])]
 
     context "comment blocks" do
       "{{! this is a comment }}"
@@ -370,6 +381,15 @@ spec = do
                      TextBlock' "\n"
                    ]
 
+tokens :: Lexer [Token]
+tokens = many token <* eof
+
+blocks :: TokenParser [Block]
+blocks = many block <* eof
+
+structures :: BlockParser [Block]
+structures = many structure <* eof
+
 type TestParser s a = s -> Either ParseError a
 
 withParser :: String -> (String -> TestParser s a) -> SpecWith (TestParser s a) -> Spec
@@ -386,6 +406,11 @@ readingFromTokens p source =
   runParser tokens source
     >=> runParser p source
 
+debugReadingFromTokens :: TokenParser a -> String -> TestParser String a
+debugReadingFromTokens p source =
+  runParser tokens source
+    >=> debugRunParser p source
+
 readingFromBlocks :: BlockParser a -> String -> TestParser String a
 readingFromBlocks p source =
   runParser tokens source

test/Green/Template/Structural.hs

@@ -70,6 +70,7 @@ data Expression'
   | AccessExpression' Expression' Expression'
   | FilterExpression' Expression' Expression'
   | ContextExpression' [(String, Expression')]
+  | ListExpression' [Expression']
   deriving stock (Eq, Show)
 
 instance Structural Expression Expression' where
@@ -83,6 +84,7 @@ instance Structural Expression Expression' where
     AccessExpression t f _ -> AccessExpression' (toStructure t) (toStructure f)
     FilterExpression x f _ -> FilterExpression' (toStructure x) (toStructure f)
     ContextExpression xs _ -> ContextExpression' (second toStructure <$> xs)
+    ListExpression xs _ -> ListExpression' (toStructure <$> xs)
 
 data Token'
   = OpenBlockToken'
@@ -92,6 +94,8 @@ data Token'
   | OpenCommentToken'
   | OpenBraceToken'
   | CloseBraceToken'
+  | OpenBracketToken'
+  | CloseBracketToken'
   | OpenParenToken'
   | CloseParenToken'
   | PipeToken'
@@ -117,6 +121,8 @@ instance Structural Token Token' where
     OpenCommentToken _ -> OpenCommentToken'
     OpenBraceToken _ -> OpenBraceToken'
     CloseBraceToken _ -> CloseBraceToken'
+    OpenBracketToken _ -> OpenBracketToken'
+    CloseBracketToken _ -> CloseBracketToken'
     OpenParenToken _ -> OpenParenToken'
     CloseParenToken _ -> CloseParenToken'
     PipeToken _ -> PipeToken'