Remove special BlockReadJson case.

This is now handled as a normal variable declaration. This also means
that a JSON path can appear anywhere in an expression, although it is
not tested yet.

src/Slab/Evaluate.hs

@@ -24,13 +24,9 @@ module Slab.Evaluate
 
 import Control.Monad (forM)
 import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
-import Data.Aeson qualified as Aeson
-import Data.Aeson.Key qualified as Aeson.Key
-import Data.Aeson.KeyMap qualified as Aeson.KeyMap
 import Data.Maybe (isJust)
 import Data.Text (Text)
 import Data.Text qualified as T
-import Data.Vector qualified as V
 import Slab.Error qualified as Error
 import Slab.PreProcess qualified as PreProcess
 import Slab.Syntax
@@ -185,7 +181,6 @@ eval env stack bl = case bl of
     body <- call env stack (T.pack path) [] args
     pure $ BlockImport path (Just body) args
   node@(BlockRun _ _) -> pure node
-  node@(BlockReadJson _ _ _) -> pure node
   node@(BlockAssignVars _) -> pure node
   BlockIf cond as bs -> do
     cond' <- evalExpr env cond
@@ -398,23 +393,11 @@ extractVariable env = \case
   (BlockImport path (Just body) _) -> [(T.pack path, Frag [] env body)]
   (BlockImport _ _ _) -> []
   (BlockRun _ _) -> []
-  (BlockReadJson name _ (Just val)) -> [(name, jsonToExpr val)]
-  (BlockReadJson _ _ Nothing) -> []
   (BlockAssignVars pairs) -> pairs
   (BlockIf _ _ _) -> []
   (BlockList _) -> []
   (BlockCode _) -> []
 
-jsonToExpr :: Aeson.Value -> Expr
-jsonToExpr = \case
-  Aeson.String s -> SingleQuoteString s
-  Aeson.Array xs ->
-    List $ map jsonToExpr (V.toList xs)
-  Aeson.Object kvs ->
-    let f (k, v) = (SingleQuoteString $ Aeson.Key.toText k, jsonToExpr v)
-     in Object $ map f (Aeson.KeyMap.toList kvs)
-  x -> error $ "jsonToExpr: " <> show x
-
 --------------------------------------------------------------------------------
 simplify :: [Block] -> [Block]
 simplify = concatMap simplify'
@@ -434,7 +417,6 @@ simplify' = \case
   BlockDefault _ nodes -> simplify nodes
   BlockImport _ mbody _ -> maybe [] simplify mbody
   BlockRun _ mbody -> maybe [] simplify mbody
-  BlockReadJson _ _ _ -> []
   BlockAssignVars _ -> []
   BlockIf _ [] bs -> simplify bs
   BlockIf _ as _ -> simplify as

src/Slab/Execute.hs

@@ -76,7 +76,6 @@ exec ctx = \case
     pure $
       Syntax.BlockRun cmd $
         Just [Syntax.BlockText Syntax.RunOutput [Syntax.Lit $ T.pack out]]
-  node@(Syntax.BlockReadJson _ _ _) -> pure node
   node@(Syntax.BlockAssignVars _) -> pure node
   Syntax.BlockIf cond as bs -> do
     as' <- execute ctx as

src/Slab/Parse.hs

@@ -251,6 +251,7 @@ parserExprInd initialIndent = makeExprParser pApp (operatorTable' initialIndent)
       <|> lx (SingleQuoteString <$> parserDoubleQuoteString) -- TODO Double
       <|> lx parserVariable'
       <|> lx (Object <$> parserObject)
+      <|> lx (JsonPath <$> try parserPath) -- TODO Force the .json extension.
       <|> parens (parserExprInd initialIndent)
   parens = between (lx $ char '(') (lx $ char ')')
   lx = lexeme' initialIndent
@@ -613,14 +614,7 @@ parserRun = do
 
 --------------------------------------------------------------------------------
 parserLet :: Parser (L.IndentOpt Parser Block Block)
-parserLet =
-  choice
-    [ try parserReadJson
-    , parserAssignVar
-    ]
-
-parserAssignVar :: Parser (L.IndentOpt Parser Block Block)
-parserAssignVar = do
+parserLet = do
   _ <- lexeme (string "let")
   scn
   blockIndent <- getSourcePos
@@ -635,14 +629,6 @@ parserAssignVar = do
     pure (name, val)
   pure $ L.IndentNone $ BlockAssignVars pairs
 
-parserReadJson :: Parser (L.IndentOpt Parser Block Block)
-parserReadJson = do
-  _ <- lexeme (string "let")
-  name <- lexeme parserName
-  _ <- lexeme (string "=")
-  path <- parserPath
-  pure $ L.IndentNone $ BlockReadJson name path Nothing
-
 --------------------------------------------------------------------------------
 -- Similar to space, but counts newlines
 space' :: Parser Int

src/Slab/PreProcess.hs

@@ -17,9 +17,12 @@ module Slab.PreProcess
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
 import Data.Aeson qualified as Aeson
+import Data.Aeson.Key qualified as Aeson.Key
+import Data.Aeson.KeyMap qualified as Aeson.KeyMap
 import Data.ByteString.Lazy qualified as BL
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
+import Data.Vector qualified as V
 import Slab.Error qualified as Error
 import Slab.Parse qualified as Parse
 import Slab.Syntax
@@ -106,15 +109,18 @@ preproc ctx@Context {..} = \case
         | otherwise ->
             throwE $ Error.PreProcessError $ "File " <> T.pack includedPath <> " doesn't exist"
   node@(BlockRun _ _) -> pure node
-  BlockReadJson name path _ -> do
-    let path' = takeDirectory ctxStartPath </> path
-    content <- liftIO $ BL.readFile path'
-    case Aeson.eitherDecode content of
-      Right val ->
-        pure $ BlockReadJson name path $ Just val
-      Left err ->
-        throwE $ Error.PreProcessError $ "Can't decode JSON: " <> T.pack err
-  node@(BlockAssignVars _) -> pure node
+  BlockAssignVars pairs -> do
+    let f (name, JsonPath path) = do
+          let path' = takeDirectory ctxStartPath </> path
+          content <- liftIO $ BL.readFile path'
+          case Aeson.eitherDecode content of
+            Right val ->
+              pure (name, jsonToExpr val)
+            Left err ->
+              throwE $ Error.PreProcessError $ "Can't decode JSON: " <> T.pack err
+        f pair = pure pair
+    pairs' <- mapM f pairs
+    pure $ BlockAssignVars pairs'
   BlockIf cond as bs -> do
     -- File inclusion is done right away, without checking the condition.
     as' <- preprocess ctx as
@@ -124,3 +130,13 @@ preproc ctx@Context {..} = \case
     nodes' <- preprocess ctx nodes
     pure $ BlockList nodes'
   node@(BlockCode _) -> pure node
+
+jsonToExpr :: Aeson.Value -> Expr
+jsonToExpr = \case
+  Aeson.String s -> SingleQuoteString s
+  Aeson.Array xs ->
+    List $ map jsonToExpr (V.toList xs)
+  Aeson.Object kvs ->
+    let f (k, v) = (SingleQuoteString $ Aeson.Key.toText k, jsonToExpr v)
+     in Object $ map f (Aeson.KeyMap.toList kvs)
+  x -> error $ "jsonToExpr: " <> show x

src/Slab/Render.hs

@@ -101,7 +101,6 @@ renderBlock (Syntax.BlockImport _ (Just nodes) _) = mapM_ renderBlock nodes
 renderBlock (Syntax.BlockRun _ (Just nodes)) = mapM_ renderBlock nodes
 renderBlock (Syntax.BlockRun cmd _) = H.textComment $ "run " <> cmd
 renderBlock (Syntax.BlockImport path Nothing _) = H.stringComment $ "extends " <> path
-renderBlock (Syntax.BlockReadJson _ _ _) = mempty
 renderBlock (Syntax.BlockAssignVars _) = mempty
 renderBlock (Syntax.BlockIf _ as bs) = do
   -- The evaluation code transforms a BlockIf into a BlockList, so this should
@@ -148,7 +147,6 @@ extractText = f
   f (Syntax.BlockDefault _ _) = error "extractTexts called on a BlockDefault"
   f (Syntax.BlockImport _ _ _) = error "extractTexts called on a BlockImport"
   f (Syntax.BlockRun _ _) = error "extractTexts called on a BlockRun"
-  f (Syntax.BlockReadJson _ _ _) = error "extractTexts called on a BlockReadJson"
   f (Syntax.BlockAssignVars _) = error "extractTexts called on a BlockAssignVars"
   f (Syntax.BlockIf _ _ _) = error "extractTexts called on a BlockIf"
   f (Syntax.BlockList _) = error "extractTexts called on a BlockList"

src/Slab/Report.hs

@@ -108,7 +108,6 @@ extractHeadings = concatMap f
   f (Syntax.BlockDefault _ children) = extractHeadings children
   f (Syntax.BlockImport _ children args) = maybe [] extractHeadings children <> extractHeadings args
   f (Syntax.BlockRun _ _) = []
-  f (Syntax.BlockReadJson _ _ _) = []
   f (Syntax.BlockAssignVars _) = []
   f (Syntax.BlockIf _ as bs) = extractHeadings as <> extractHeadings bs
   f (Syntax.BlockList children) = extractHeadings children

src/Slab/Syntax.hs

@@ -36,7 +36,6 @@ module Slab.Syntax
   , groupAttrs
   ) where
 
-import Data.Aeson qualified as Aeson
 import Data.List (nub, sort)
 import Data.Text (Text)
 import Data.Text qualified as T
@@ -67,8 +66,6 @@ data Block
     -- content of the referenced file.
     BlockImport FilePath (Maybe [Block]) [Block]
   | BlockRun Text (Maybe [Block])
-  | -- | Allow to assign the content of a JSON file to a variable.
-    BlockReadJson Text FilePath (Maybe Aeson.Value)
   | BlockAssignVars [(Text, Expr)]
   | BlockIf Expr [Block] [Block]
   | BlockList [Block]
@@ -224,6 +221,8 @@ data Expr
     Frag [Text] Env [Block]
   | -- Same for Expr instead of Block.
     Thunk Env Expr
+  | -- | Allow to assign the content of a JSON file to a variable.
+    JsonPath FilePath
   | BuiltIn Text
   deriving (Show, Eq)
 
@@ -297,7 +296,6 @@ extractClasses = nub . sort . concatMap f
   f (BlockDefault _ children) = extractClasses children
   f (BlockImport _ children blocks) = maybe [] extractClasses children <> extractClasses blocks
   f (BlockRun _ _) = []
-  f (BlockReadJson _ _ _) = []
   f (BlockAssignVars _) = []
   f (BlockIf _ as bs) = extractClasses as <> extractClasses bs
   f (BlockList children) = extractClasses children
@@ -333,7 +331,6 @@ extractFragments = concatMap f
   f (BlockDefault _ children) = extractFragments children
   f (BlockImport _ children args) = maybe [] extractFragments children <> extractFragments args
   f (BlockRun _ _) = []
-  f (BlockReadJson _ _ _) = []
   f (BlockAssignVars _) = []
   f (BlockIf _ as bs) = extractFragments as <> extractFragments bs
   f (BlockList children) = extractFragments children