ErrorPos.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module Morley.Michelson.ErrorPos
  ( mkPos
  , Pos (..)
  , SrcPos (..)
  , srcPos
  , ErrorSrcPos (..)
  ) where

import Unsafe qualified (fromIntegral)

import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import Data.Default (Default(..))
import Fmt (Buildable(..), (<+>))

import Morley.Util.Aeson

newtype Pos = Pos {unPos :: Word}
  deriving stock (Eq, Ord, Show, Generic, Data)

instance NFData Pos

mkPos :: Int -> Either Text Pos
mkPos x
  | x < 0     = Left $ "negative pos: " <> show x
  | otherwise = Right $ Pos $ Unsafe.fromIntegral @Int @Word 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 ErrorSrcPos = ErrorSrcPos
  { unErrorSrcPos :: SrcPos
  } deriving stock (Eq, Ord, Show, Generic, Data)
    deriving newtype (Default)
    deriving anyclass (NFData)

instance Buildable ErrorSrcPos where
  build ErrorSrcPos{unErrorSrcPos = SrcPos (Pos row) (Pos col)} =
    "Error occurred on line" <+> build (row + 1) <+> "char" <+> build (col + 1) <> "."

instance Default Pos where
  def = Pos 0

instance Default SrcPos where
  def = SrcPos def def

deriveJSON morleyAesonOptions ''Pos
deriveJSON morleyAesonOptions ''SrcPos
deriveJSON morleyAesonOptions ''ErrorSrcPos