{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE UndecidableInstances #-}

{-|
Module      : Hectoparsec.Error
Copyright   : (c) comp 2020
License     : MIT
Maintainer  : onecomputer00@gmail.com
Stability   : stable
Portability : portable

Data types for errors reported during parsing.

Hectoparsec itself does not come with error pretty printing, but errors can be formatted while prototyping with the
functions from "Hectoparsec.Debug". External libraries or your own error pretty printer can be used instead.
-}
module Hectoparsec.Error
    ( -- * Parse error data
      Unexpected(..)
    , Message(..)
    , ErrorItem(..)
    , ParseError(..)
    ) where

import Hectoparsec.Pos
import Hectoparsec.Stream

-- | An unexpected item from the input stream.
data Unexpected s
    = UnexpectedToken (Token s) -- ^ An unexpected token.
    | UnexpectedChunk (Chunk s) -- ^ An unexpected chunk.
    | UnexpectedEnd             -- ^ An unexpected end of input.
    | UnexpectedEmpty           -- ^ An unexpected empty parser.

{-|
Chooses between two unexpected items. 'UnexpectedEmpty' items are discarded in favor of more descriptive items. When
choosing between other items, the second item is chosen.
-}
instance Semigroup (Unexpected s) where
    Unexpected s
UnexpectedEmpty <> :: Unexpected s -> Unexpected s -> Unexpected s
<> Unexpected s
a               = Unexpected s
a
    Unexpected s
a               <> Unexpected s
UnexpectedEmpty = Unexpected s
a
    Unexpected s
_               <> Unexpected s
a               = Unexpected s
a
    {-# INLINE (<>) #-}

instance Monoid (Unexpected s) where
    mempty :: Unexpected s
mempty = Unexpected s
forall s. Unexpected s
UnexpectedEmpty

deriving instance (Show (Token s), Show (Chunk s)) => Show (Unexpected s)
deriving instance (Eq (Token s), Eq (Chunk s)) => Eq (Unexpected s)

-- | An error message from the input stream.
data Message e
    = MessageCustom e    -- ^ A custom error message.
    | MessageFail String -- ^ A string error message.
    deriving (Int -> Message e -> ShowS
[Message e] -> ShowS
Message e -> String
(Int -> Message e -> ShowS)
-> (Message e -> String)
-> ([Message e] -> ShowS)
-> Show (Message e)
forall e. Show e => Int -> Message e -> ShowS
forall e. Show e => [Message e] -> ShowS
forall e. Show e => Message e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message e] -> ShowS
$cshowList :: forall e. Show e => [Message e] -> ShowS
show :: Message e -> String
$cshow :: forall e. Show e => Message e -> String
showsPrec :: Int -> Message e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> Message e -> ShowS
Show, Message e -> Message e -> Bool
(Message e -> Message e -> Bool)
-> (Message e -> Message e -> Bool) -> Eq (Message e)
forall e. Eq e => Message e -> Message e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message e -> Message e -> Bool
$c/= :: forall e. Eq e => Message e -> Message e -> Bool
== :: Message e -> Message e -> Bool
$c== :: forall e. Eq e => Message e -> Message e -> Bool
Eq)

-- | A possible error during parsing for a stream @s@, with error type @e@ and label type @l@.
data ErrorItem s e l
      {-|
      An error generated through matching tokens. There is an unexpected item and a list of labels from parsers that
      make up the expected items. There may be duplicates in the list of expected labels, so it is up to you to
      deduplicate it if needed.
      -}
    = ErrorItemLabels (Unexpected s) [l]
      {-|
      An error generated by 'fail' and 'Hectoparsec.Class.failure', and by custom errors, which can generally happen
      anywhere. These errors are preferred over the errors generated by matching tokens.
      -}
    | ErrorItemMessages [Message e]

{-|
Merges two error items. We prefer 'ErrorItemMessages' over 'ErrorItemLabels'. When two error items of the same variant
are given, the two error items are merged together.
-}
instance Semigroup (ErrorItem s e l) where
    ErrorItemMessages [Message e]
xs    <> :: ErrorItem s e l -> ErrorItem s e l -> ErrorItem s e l
<> ErrorItemMessages [Message e]
ys    = [Message e] -> ErrorItem s e l
forall s e l. [Message e] -> ErrorItem s e l
ErrorItemMessages ([Message e]
xs [Message e] -> [Message e] -> [Message e]
forall a. Semigroup a => a -> a -> a
<> [Message e]
ys)
    ErrorItemLabels Unexpected s
xu [l]
xd   <> ErrorItemLabels Unexpected s
yu [l]
yd   = Unexpected s -> [l] -> ErrorItem s e l
forall s e l. Unexpected s -> [l] -> ErrorItem s e l
ErrorItemLabels (Unexpected s
xu Unexpected s -> Unexpected s -> Unexpected s
forall a. Semigroup a => a -> a -> a
<> Unexpected s
yu) ([l]
xd [l] -> [l] -> [l]
forall a. Semigroup a => a -> a -> a
<> [l]
yd)
    ErrorItem s e l
_                       <> e :: ErrorItem s e l
e@(ErrorItemMessages [Message e]
_) = ErrorItem s e l
e
    e :: ErrorItem s e l
e@(ErrorItemMessages [Message e]
_) <> ErrorItem s e l
_                       = ErrorItem s e l
e
    {-# INLINE (<>) #-}

deriving instance (Show (Token s), Show (Chunk s), Show e, Show l) => Show (ErrorItem s e l)
deriving instance (Eq (Token s), Eq (Chunk s), Eq e, Eq l) => Eq (ErrorItem s e l)

-- | A container for an error during parsing for a stream @s@, with error type @e@ and label type @l@.
data ParseError s e l = ParseError
    { forall s e l. ParseError s e l -> Pos
parseErrorPos    :: !Pos                -- ^ The position of the error in the source.
    , forall s e l. ParseError s e l -> Int
parseErrorOffset :: {-# UNPACK #-} !Int -- ^ The offset of the error in the stream.
    , forall s e l. ParseError s e l -> ErrorItem s e l
parseErrorItem   :: ErrorItem s e l     -- ^ The error item.
    }

deriving instance (Show (Token s), Show (Chunk s), Show e, Show l) => Show (ParseError s e l)
deriving instance (Eq (Token s), Eq (Chunk s), Eq e, Eq l) => Eq (ParseError s e l)

{-|
Merges two errors together. Errors that occur later in the stream are preferred. When they occur at the same place,
the error items are merged, with preference for the second parse error.
-}
instance Semigroup (ParseError s e l) where
    ParseError s e l
x <> :: ParseError s e l -> ParseError s e l -> ParseError s e l
<> ParseError s e l
y = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ParseError s e l -> Int
forall s e l. ParseError s e l -> Int
parseErrorOffset ParseError s e l
x) (ParseError s e l -> Int
forall s e l. ParseError s e l -> Int
parseErrorOffset ParseError s e l
y) of
        Ordering
LT -> ParseError s e l
y
        Ordering
EQ -> ParseError s e l
y { parseErrorItem :: ErrorItem s e l
parseErrorItem = ParseError s e l -> ErrorItem s e l
forall s e l. ParseError s e l -> ErrorItem s e l
parseErrorItem ParseError s e l
x ErrorItem s e l -> ErrorItem s e l -> ErrorItem s e l
forall a. Semigroup a => a -> a -> a
<> ParseError s e l -> ErrorItem s e l
forall s e l. ParseError s e l -> ErrorItem s e l
parseErrorItem ParseError s e l
y }
        Ordering
GT -> ParseError s e l
x
    {-# INLINE (<>) #-}