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

module Michelson.ErrorPos
  ( mkPos
  , unsafeMkPos
  , 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 {unPos :: Word}
  deriving stock (Eq, Ord, Show, Generic, Data)

instance NFData Pos

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

mkPos :: Int -> Maybe Pos
mkPos x
  | x < 0     = Nothing
  | otherwise = Just $ Pos $ fromIntegral x

data SrcPos =
  SrcPos
  { srcLine :: Pos
  , srcCol :: Pos
  } deriving stock (Eq, Ord, Show, Generic, Data)

instance Buildable SrcPos where
  build (SrcPos (Pos l) (Pos c)) = build l <> ":" <> build c

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