-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Core parser types

module Michelson.Parser.Types
  ( Parser
  , LetEnv (..)
  , noLetEnv
  ) where

import Data.Default (Default(..))
import qualified Data.Map as Map
import Text.Megaparsec (Parsec)

import Michelson.Let (LetType, LetValue)
import Michelson.Macro (LetMacro)
import Michelson.Parser.Error

type Parser = ReaderT LetEnv (Parsec CustomParserException Text)

instance Default a => Default (Parser a) where
  def :: Parser a
def = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Default a => a
def

-- | The environment containing lets from the let-block
data LetEnv = LetEnv
  { LetEnv -> Map Text LetMacro
letMacros :: Map Text LetMacro
  , LetEnv -> Map Text LetValue
letValues :: Map Text LetValue
  , LetEnv -> Map Text LetType
letTypes  :: Map Text LetType
  } deriving stock (Int -> LetEnv -> ShowS
[LetEnv] -> ShowS
LetEnv -> String
(Int -> LetEnv -> ShowS)
-> (LetEnv -> String) -> ([LetEnv] -> ShowS) -> Show LetEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LetEnv] -> ShowS
$cshowList :: [LetEnv] -> ShowS
show :: LetEnv -> String
$cshow :: LetEnv -> String
showsPrec :: Int -> LetEnv -> ShowS
$cshowsPrec :: Int -> LetEnv -> ShowS
Show, LetEnv -> LetEnv -> Bool
(LetEnv -> LetEnv -> Bool)
-> (LetEnv -> LetEnv -> Bool) -> Eq LetEnv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LetEnv -> LetEnv -> Bool
$c/= :: LetEnv -> LetEnv -> Bool
== :: LetEnv -> LetEnv -> Bool
$c== :: LetEnv -> LetEnv -> Bool
Eq)

noLetEnv :: LetEnv
noLetEnv :: LetEnv
noLetEnv = Map Text LetMacro
-> Map Text LetValue -> Map Text LetType -> LetEnv
LetEnv Map Text LetMacro
forall k a. Map k a
Map.empty Map Text LetValue
forall k a. Map k a
Map.empty Map Text LetType
forall k a. Map k a
Map.empty