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

-- |  Custom exceptions that can happen during parsing.

module Morley.Michelson.Parser.Error
  ( CustomParserException (..)
  , StringLiteralParserException (..)
  , ParseErrorBundle
  , ParserException (..)
  ) where

import Data.Data (Data(..))
import Fmt (Buildable(build), pretty, (+|), (|+))
import Text.Megaparsec (ParseErrorBundle, ShowErrorComponent(..), errorBundlePretty)

import Morley.Michelson.Untyped.View
import Morley.Util.Instances ()
import Morley.Util.Positive

data CustomParserException
  = StringLiteralException StringLiteralParserException
  | ViewNameException BadViewNameError
  | OddNumberBytesException
  | WrongTagArgs Natural Positive
  | WrongAccessArgs Natural Positive
  | WrongSetArgs Natural Positive
  | ExcessFieldAnnotation
  | MultiRootAnnotationException
  | DeprecatedException
  deriving stock (Eq, Data, Ord, Show, Generic)

{-# DEPRECATED
    WrongTagArgs
  , WrongAccessArgs
  , WrongSetArgs

  "Exceptions specific to deprecated Morley language extensions"
  #-}

instance NFData CustomParserException

instance ShowErrorComponent CustomParserException where
  showErrorComponent (StringLiteralException e) = showErrorComponent e
  showErrorComponent (ViewNameException e) = pretty e
  showErrorComponent OddNumberBytesException = "odd number bytes"
  showErrorComponent ExcessFieldAnnotation = "excess field annotation"
  showErrorComponent MultiRootAnnotationException = "unexpected multiple root annotations"
  showErrorComponent DeprecatedException = "deprecated syntax, use --deprecated-morley-extensions \
    \command-line argument to silence this error"
  showErrorComponent (WrongTagArgs idx size) =
    "TAG: too large index: " +| idx |+ " \
           \exceedes union size " +| size |+ ""
  showErrorComponent (WrongAccessArgs idx size) =
    "ACCESS: too large index: " +| idx |+ " \
           \exceedes tuple size " +| size |+ ""
  showErrorComponent (WrongSetArgs idx size) =
    "SET: too large index: " +| idx |+ " \
           \exceedes tuple size " +| size |+ ""

data StringLiteralParserException
  = InvalidEscapeSequence Char
  | InvalidChar Char
  deriving stock (Eq, Data, Ord, Show, Generic)

instance NFData StringLiteralParserException

instance ShowErrorComponent StringLiteralParserException where
  showErrorComponent (InvalidEscapeSequence c) =
    "invalid escape sequence '\\" <> [c] <> "'"
  showErrorComponent (InvalidChar c) =
    "invalid character '" <> [c] <> "'"

data ParserException =
  ParserException (ParseErrorBundle Text CustomParserException)
  deriving stock (Eq, Show)

instance Exception ParserException where
  displayException (ParserException bundle) = errorBundlePretty bundle

instance Buildable ParserException where
  build (ParserException bundle) = build $ errorBundlePretty bundle