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

-- | Core parser types

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

  , MichelsonSource (.., MSStdin, MSCli)
  , codeSrc
  ) where

import Data.Default (Default(..))
import qualified Data.Map as Map
import Fmt (Buildable(..))
import GHC.Stack (SrcLoc(..))
import Text.Megaparsec (Parsec)

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

type Parser = ReaderT LetEnv (Parsec CustomParserException Text)

instance Default a => Default (Parser a) where
  def = pure def

-- | The environment containing lets from the let-block
data LetEnv = LetEnv
  { letMacros :: Map Text LetMacro
  , letValues :: Map Text LetValue
  , letTypes  :: Map Text LetType
  } deriving stock (Show, Eq)

noLetEnv :: LetEnv
noLetEnv = LetEnv Map.empty Map.empty Map.empty

-- | Where a contract or value in Michelson comes from.
data MichelsonSource
  -- | From given file.
  = MSFile FilePath
  -- | Only source name is known.
  | MSName Text
  -- | Defined in Haskell code.
  | MSCode SrcLoc
  -- | Some unknown source.
  | MSUnspecified
  deriving stock (Show, Eq)

-- | Designates @stdin@ source.
pattern MSStdin :: MichelsonSource
pattern MSStdin = MSName "<stdin>"

-- | Designates command line input source.
pattern MSCli :: MichelsonSource
pattern MSCli = MSName "<cli>"

instance IsString MichelsonSource where
  fromString = MSName . fromString

-- Dunno why these are necessary, hlint behaves weirdly
{-# ANN module ("HLint: ignore Use 'callStack' from Universum" :: Text) #-}
{-# ANN module ("HLint: ignore Use 'getCallStack' from Universum" :: Text) #-}

-- | 'MichelsonSource' that points to the current position.
codeSrc :: HasCallStack => MichelsonSource
codeSrc = MSCode $
  case reverse (getCallStack callStack) of
    [] -> error "Unexpectedly empty callstack"
    (_funName, srcLoc) : _ -> srcLoc

instance Buildable MichelsonSource where
  build = \case
    MSFile file -> build file
    MSStdin -> "<user input>"
    MSCli -> "<user input via CLI>"
    MSName name -> build name
    MSCode SrcLoc{..} ->
      build srcLocFile <> ":" <> build srcLocStartLine <> ":" <> build srcLocStartCol
    MSUnspecified -> ""