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

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

import Unsafe qualified (fromIntegral)

import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import Data.Default (Default(..))
import Data.Text qualified as T
import Fmt (Buildable(..))
import Morley.Michelson.Printer.Util (RenderDoc(..), buildRenderDocExtended, renderAnyBuildable)
import Text.PrettyPrint.Leijen.Text (list, (<+>))

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 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 RenderDoc InstrCallStack where
  renderDoc _ InstrCallStack{icsCallStack, icsSrcPos = SrcPos (Pos row) (Pos col)} =
    "Error occurred on line" <+> (renderAnyBuildable (row + 1)) <+> "char" <+> (renderAnyBuildable (col + 1))
    <> case icsCallStack of
         [] -> "."
         _ -> " inside these let defenitions:" <+> (list $ fmap renderAnyBuildable icsCallStack) <> "."

instance Buildable InstrCallStack where
  build = buildRenderDocExtended

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