{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Parsing records in the Swarm language.
module Swarm.Language.Parser.Record (
  parseRecord,
) where

import Data.Map (Map)
import Data.Map qualified as M
import Swarm.Language.Parser.Core (Parser)
import Swarm.Language.Parser.Lex (symbol, tmVar)
import Swarm.Language.Var (Var)
import Swarm.Util (failT, findDup, squote)
import Text.Megaparsec (sepBy)

-- | Parse something using record syntax of the form @x1 v1, x2 v2,
--   ...@.  The same parser is used both in parsing record types and
--   record values, so it is factored out into its own module.
--
--   The @Parser a@ argument is the parser to use for the RHS of each
--   binding in the record.
parseRecord :: Parser a -> Parser (Map Var a)
parseRecord :: forall a. Parser a -> Parser (Map Var a)
parseRecord Parser a
p = (ReaderT ParserConfig (StateT WSState (Parsec Void Var)) (Var, a)
parseBinding ReaderT ParserConfig (StateT WSState (Parsec Void Var)) (Var, a)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Var)) Var
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Var)) [(Var, a)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Var -> ReaderT ParserConfig (StateT WSState (Parsec Void Var)) Var
symbol Var
",") ReaderT ParserConfig (StateT WSState (Parsec Void Var)) [(Var, a)]
-> ([(Var, a)]
    -> ReaderT
         ParserConfig (StateT WSState (Parsec Void Var)) (Map Var a))
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Var)) (Map Var a)
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Var)) a
-> (a -> ReaderT ParserConfig (StateT WSState (Parsec Void Var)) b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Var)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Var, a)]
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Var)) (Map Var a)
forall {m :: * -> *} {a}.
MonadFail m =>
[(Var, a)] -> m (Map Var a)
fromListUnique
 where
  parseBinding :: ReaderT ParserConfig (StateT WSState (Parsec Void Var)) (Var, a)
parseBinding = (,) (Var -> a -> (Var, a))
-> ReaderT ParserConfig (StateT WSState (Parsec Void Var)) Var
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Var)) (a -> (Var, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ParserConfig (StateT WSState (Parsec Void Var)) Var
tmVar ReaderT
  ParserConfig (StateT WSState (Parsec Void Var)) (a -> (Var, a))
-> Parser a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Var)) (Var, a)
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Var)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Var)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Var)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
p
  fromListUnique :: [(Var, a)] -> m (Map Var a)
fromListUnique [(Var, a)]
kvs = case [Var] -> Maybe Var
forall a. Ord a => [a] -> Maybe a
findDup (((Var, a) -> Var) -> [(Var, a)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, a) -> Var
forall a b. (a, b) -> a
fst [(Var, a)]
kvs) of
    Maybe Var
Nothing -> Map Var a -> m (Map Var a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Var a -> m (Map Var a)) -> Map Var a -> m (Map Var a)
forall a b. (a -> b) -> a -> b
$ [(Var, a)] -> Map Var a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Var, a)]
kvs
    Just Var
x -> [Var] -> m (Map Var a)
forall (m :: * -> *) a. MonadFail m => [Var] -> m a
failT [Var
"duplicate field name", Var -> Var
squote Var
x, Var
"in record literal"]