ErrorPos.hs

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

module Michelson.ErrorPos
  ( mkPos
  , Pos (..)
  , SrcPos (..)
  , srcPos
  , InstrCallStack (..)
  , LetCallStack
  , LetName (..)
  ) where

import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import Data.Default (Default(..))
import qualified Data.Text as T
import Fmt (Buildable)

import Util.Aeson

newtype Pos = Pos Word
  deriving stock (Eq, Ord, Show, Generic, Data)

instance NFData Pos

mkPos :: Int -> Pos
mkPos x
  | x < 0     = error $ "negative pos: " <> show x
  | otherwise = Pos $ fromIntegral x

data SrcPos = SrcPos Pos Pos
  deriving stock (Eq, Ord, Show, Generic, Data)

instance NFData SrcPos

srcPos :: Word -> Word -> SrcPos
srcPos x y = SrcPos (Pos x) (Pos y)

newtype LetName = LetName T.Text
  deriving stock (Eq, Ord, Show, Data, Generic)
  deriving newtype Buildable

instance NFData LetName

type LetCallStack = [LetName]
data InstrCallStack = InstrCallStack
  { icsCallStack :: LetCallStack
  , icsSrcPos    :: SrcPos
  } deriving stock (Eq, Ord, Show, Generic, Data)

instance NFData InstrCallStack

instance Default Pos where
  def = Pos 0

instance Default SrcPos where
  def = SrcPos def def

instance Default InstrCallStack where
  def = InstrCallStack def def

deriveJSON morleyAesonOptions ''Pos
deriveJSON morleyAesonOptions ''SrcPos
deriveJSON morleyAesonOptions ''LetName
deriveJSON morleyAesonOptions ''InstrCallStack