{-# LANGUAGE CPP                  #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
--
-- Module:      Language.Egison.Parser.Pattern.Prim.Error
-- Description: Parse errors
-- Stability:   experimental
--
-- This module defines datatypes representing parser errors

module Language.Egison.Parser.Pattern.Prim.Error
  ( Error(..)
  , ErrorItem(..)
  , Errors
  -- * Internal Errors
  , CustomError(..)
  -- * Conversion
  , fromParseErrorBundle
  )
where

import           Data.Proxy                     ( Proxy(..) )
import           Data.List.NonEmpty             ( NonEmpty )
import qualified Data.List.NonEmpty            as NonEmpty
                                                ( toList )
import qualified Data.Set                      as Set
                                                ( toList
                                                , size
                                                , elemAt
                                                )

import           Language.Egison.Parser.Pattern.Prim.Source
                                                ( Tokens
                                                , Token
                                                )
import           Language.Egison.Parser.Pattern.Prim.Location
                                                ( Position
                                                , fromSourcePos
                                                )

import qualified Text.Megaparsec               as Parsec
                                                ( Stream
                                                , ErrorItem(..)
                                                , ErrorFancy(..)
                                                , SourcePos
#if MIN_VERSION_megaparsec(9,0,0)
                                                , TraversableStream (..)
#endif
                                                , ParseError(..)
                                                , ParseErrorBundle(..)
                                                , attachSourcePos
                                                , errorOffset
                                                , tokensToChunk
                                                )


-- | Token representation in 'Error'.
data ErrorItem s
  = Tokens (Tokens s)
  | Label String
  | EndOfInput

deriving instance Show (Tokens s) => Show (ErrorItem s)
deriving instance Eq (Tokens s) => Eq (ErrorItem s)


-- | Parse error.
data Error s
  = UnexpectedToken { Error s -> Position
position :: Position
                    , Error s -> [ErrorItem s]
expected :: [ErrorItem s]
                    , Error s -> Maybe (ErrorItem s)
found    :: Maybe (ErrorItem s)
                    }
  | ExternalError { position :: Position
                  , Error s -> Tokens s
input :: Tokens s
                  , Error s -> String
message :: String
                  }
  | UnexpectedEndOfFile { Error s -> Tokens s
rest :: Tokens s
                        }

deriving instance Show (Tokens s) => Show (Error s)
deriving instance Eq (Tokens s) => Eq (Error s)

-- | Type synonym for an error list.
type Errors s = NonEmpty (Error s)


-- | Internal error type to use as a custom error in 'Text.Megaparsec.Parsec' monad.
data CustomError s = ExtParserError { CustomError s -> Tokens s
input :: Tokens s
                                    , CustomError s -> String
message :: String
                                    }

deriving instance Eq (Tokens s) => Eq (CustomError s)
deriving instance Ord (Tokens s) => Ord (CustomError s)


makeErrorItem
  :: forall s . Parsec.Stream s => Parsec.ErrorItem (Token s) -> ErrorItem s
makeErrorItem :: ErrorItem (Token s) -> ErrorItem s
makeErrorItem (Parsec.Tokens NonEmpty (Token s)
ts) =
  Tokens s -> ErrorItem s
forall s. Tokens s -> ErrorItem s
Tokens (Tokens s -> ErrorItem s)
-> ([Token s] -> Tokens s) -> [Token s] -> ErrorItem s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
Parsec.tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy @s) ([Token s] -> ErrorItem s) -> [Token s] -> ErrorItem s
forall a b. (a -> b) -> a -> b
$ NonEmpty (Token s) -> [Token s]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Token s)
ts
makeErrorItem (Parsec.Label NonEmpty Char
cs) = String -> ErrorItem s
forall s. String -> ErrorItem s
Label (String -> ErrorItem s) -> String -> ErrorItem s
forall a b. (a -> b) -> a -> b
$ NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Char
cs
makeErrorItem ErrorItem (Token s)
Parsec.EndOfInput = ErrorItem s
forall s. ErrorItem s
EndOfInput

makeFancyError
  :: Parsec.SourcePos -> Parsec.ErrorFancy (CustomError s) -> Error s
makeFancyError :: SourcePos -> ErrorFancy (CustomError s) -> Error s
makeFancyError SourcePos
pos (Parsec.ErrorCustom CustomError s
err) = Error s
extError
 where
  position :: Position
position                          = SourcePos -> Position
fromSourcePos SourcePos
pos
  ExtParserError { Tokens s
input :: Tokens s
$sel:input:ExtParserError :: forall s. CustomError s -> Tokens s
input, String
message :: String
$sel:message:ExtParserError :: forall s. CustomError s -> String
message } = CustomError s
err
  extError :: Error s
extError                          = ExternalError :: forall s. Position -> Tokens s -> String -> Error s
ExternalError { Position
position :: Position
$sel:position:UnexpectedToken :: Position
position, Tokens s
input :: Tokens s
$sel:input:UnexpectedToken :: Tokens s
input, String
message :: String
$sel:message:UnexpectedToken :: String
message }
makeFancyError SourcePos
_ ErrorFancy (CustomError s)
_ = String -> Error s
forall a. HasCallStack => String -> a
error String
"unreachable: unused fancy error"

makeError
  :: forall s
   . Parsec.Stream s
  => (Parsec.ParseError s (CustomError s), Parsec.SourcePos)
  -> Error s
makeError :: (ParseError s (CustomError s), SourcePos) -> Error s
makeError (Parsec.FancyError Int
_ Set (ErrorFancy (CustomError s))
es, SourcePos
pos) | Set (ErrorFancy (CustomError s)) -> Int
forall a. Set a -> Int
Set.size Set (ErrorFancy (CustomError s))
es Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 =
  SourcePos -> ErrorFancy (CustomError s) -> Error s
forall s. SourcePos -> ErrorFancy (CustomError s) -> Error s
makeFancyError SourcePos
pos (ErrorFancy (CustomError s) -> Error s)
-> ErrorFancy (CustomError s) -> Error s
forall a b. (a -> b) -> a -> b
$ Int
-> Set (ErrorFancy (CustomError s)) -> ErrorFancy (CustomError s)
forall a. Int -> Set a -> a
Set.elemAt Int
0 Set (ErrorFancy (CustomError s))
es
makeError (Parsec.TrivialError Int
_ Maybe (ErrorItem (Token s))
mfound Set (ErrorItem (Token s))
expectedSet, SourcePos
pos) = UnexpectedToken :: forall s.
Position -> [ErrorItem s] -> Maybe (ErrorItem s) -> Error s
UnexpectedToken
  { Position
position :: Position
$sel:position:UnexpectedToken :: Position
position
  , [ErrorItem s]
expected :: [ErrorItem s]
$sel:expected:UnexpectedToken :: [ErrorItem s]
expected
  , Maybe (ErrorItem s)
found :: Maybe (ErrorItem s)
$sel:found:UnexpectedToken :: Maybe (ErrorItem s)
found
  }
 where
  found :: Maybe (ErrorItem s)
found    = (ErrorItem (Token s) -> ErrorItem s)
-> Maybe (ErrorItem (Token s)) -> Maybe (ErrorItem s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Stream s => ErrorItem (Token s) -> ErrorItem s
forall s. Stream s => ErrorItem (Token s) -> ErrorItem s
makeErrorItem @s) Maybe (ErrorItem (Token s))
mfound
  expected :: [ErrorItem s]
expected = (ErrorItem (Token s) -> ErrorItem s)
-> [ErrorItem (Token s)] -> [ErrorItem s]
forall a b. (a -> b) -> [a] -> [b]
map (Stream s => ErrorItem (Token s) -> ErrorItem s
forall s. Stream s => ErrorItem (Token s) -> ErrorItem s
makeErrorItem @s) ([ErrorItem (Token s)] -> [ErrorItem s])
-> [ErrorItem (Token s)] -> [ErrorItem s]
forall a b. (a -> b) -> a -> b
$ Set (ErrorItem (Token s)) -> [ErrorItem (Token s)]
forall a. Set a -> [a]
Set.toList Set (ErrorItem (Token s))
expectedSet
  position :: Position
position = SourcePos -> Position
fromSourcePos SourcePos
pos
makeError (ParseError s (CustomError s), SourcePos)
_ = String -> Error s
forall a. HasCallStack => String -> a
error String
"unreachable: unused error"

-- | Convert 'Parsec.ParseErrorBundle' to 'Errors'.
fromParseErrorBundle
#if MIN_VERSION_megaparsec(9,0,0)
  :: Parsec.TraversableStream s => Parsec.ParseErrorBundle s (CustomError s) -> Errors s
#else
  :: Parsec.Stream s => Parsec.ParseErrorBundle s (CustomError s) -> Errors s
#endif
fromParseErrorBundle :: ParseErrorBundle s (CustomError s) -> Errors s
fromParseErrorBundle Parsec.ParseErrorBundle { bundleErrors :: forall s e. ParseErrorBundle s e -> NonEmpty (ParseError s e)
Parsec.bundleErrors = NonEmpty (ParseError s (CustomError s))
errors, bundlePosState :: forall s e. ParseErrorBundle s e -> PosState s
Parsec.bundlePosState = PosState s
posState }
  = ((ParseError s (CustomError s), SourcePos) -> Error s)
-> NonEmpty (ParseError s (CustomError s), SourcePos) -> Errors s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParseError s (CustomError s), SourcePos) -> Error s
forall s.
Stream s =>
(ParseError s (CustomError s), SourcePos) -> Error s
makeError NonEmpty (ParseError s (CustomError s), SourcePos)
errorsWithPos
 where
  (NonEmpty (ParseError s (CustomError s), SourcePos)
errorsWithPos, PosState s
_) =
    (ParseError s (CustomError s) -> Int)
-> NonEmpty (ParseError s (CustomError s))
-> PosState s
-> (NonEmpty (ParseError s (CustomError s), SourcePos), PosState s)
forall (t :: * -> *) s a.
(Traversable t, TraversableStream s) =>
(a -> Int) -> t a -> PosState s -> (t (a, SourcePos), PosState s)
Parsec.attachSourcePos ParseError s (CustomError s) -> Int
forall s e. ParseError s e -> Int
Parsec.errorOffset NonEmpty (ParseError s (CustomError s))
errors PosState s
posState