-- | Error data type definitions (shared between parsers).

module Binrep.Get.Error where

import GHC.Generics ( Generic )
import Data.Text ( Text )
import Numeric.Natural ( Natural )
import Data.Word ( Word8 )
import Data.ByteString ( ByteString )

-- | Structured parse error.
data E
  = E Int EMiddle

  -- | Unhandled parse error.
  --
  -- You get this if you don't change a flatparse fail to an error.
  --
  -- Should not be set except by library code.
  | EFail

    deriving stock (E -> E -> Bool
(E -> E -> Bool) -> (E -> E -> Bool) -> Eq E
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E -> E -> Bool
== :: E -> E -> Bool
$c/= :: E -> E -> Bool
/= :: E -> E -> Bool
Eq, Int -> E -> ShowS
[E] -> ShowS
E -> String
(Int -> E -> ShowS) -> (E -> String) -> ([E] -> ShowS) -> Show E
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E -> ShowS
showsPrec :: Int -> E -> ShowS
$cshow :: E -> String
show :: E -> String
$cshowList :: [E] -> ShowS
showList :: [E] -> ShowS
Show, (forall x. E -> Rep E x) -> (forall x. Rep E x -> E) -> Generic E
forall x. Rep E x -> E
forall x. E -> Rep E x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. E -> Rep E x
from :: forall x. E -> Rep E x
$cto :: forall x. Rep E x -> E
to :: forall x. Rep E x -> E
Generic)

data EMiddle

  -- | Parse error with no further context.
  = EBase EBase

  -- | Somehow, we got two parse errors.
  --
  -- I have a feeling that seeing this indicates a problem in your code.
  | EAnd E EBase

  -- | Parse error decorated with generic info.
  --
  -- Should not be set except by library code.
  | EGeneric String {- ^ data type name -} (EGeneric E)

    deriving stock (EMiddle -> EMiddle -> Bool
(EMiddle -> EMiddle -> Bool)
-> (EMiddle -> EMiddle -> Bool) -> Eq EMiddle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EMiddle -> EMiddle -> Bool
== :: EMiddle -> EMiddle -> Bool
$c/= :: EMiddle -> EMiddle -> Bool
/= :: EMiddle -> EMiddle -> Bool
Eq, Int -> EMiddle -> ShowS
[EMiddle] -> ShowS
EMiddle -> String
(Int -> EMiddle -> ShowS)
-> (EMiddle -> String) -> ([EMiddle] -> ShowS) -> Show EMiddle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EMiddle -> ShowS
showsPrec :: Int -> EMiddle -> ShowS
$cshow :: EMiddle -> String
show :: EMiddle -> String
$cshowList :: [EMiddle] -> ShowS
showList :: [EMiddle] -> ShowS
Show, (forall x. EMiddle -> Rep EMiddle x)
-> (forall x. Rep EMiddle x -> EMiddle) -> Generic EMiddle
forall x. Rep EMiddle x -> EMiddle
forall x. EMiddle -> Rep EMiddle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EMiddle -> Rep EMiddle x
from :: forall x. EMiddle -> Rep EMiddle x
$cto :: forall x. Rep EMiddle x -> EMiddle
to :: forall x. Rep EMiddle x -> EMiddle
Generic)

data EBase
  = EExpectedByte Word8 Word8
  -- ^ expected first, got second

  | EOverlong Int Int
  -- ^ expected first, got second

  | EExpected ByteString ByteString
  -- ^ expected first, got second

  | EFailNamed String
  -- ^ known fail

  | EFailParse String ByteString Word8
  -- ^ parse fail (where you parse a larger object, then a smaller one in it)

  | ERanOut Int
  -- ^ ran out of input, needed precisely @n@ bytes for this part (n > 0)
  --
  -- Actually a 'Natural', but we use 'Int' because that's what flatparse uses
  -- internally.

    deriving stock (EBase -> EBase -> Bool
(EBase -> EBase -> Bool) -> (EBase -> EBase -> Bool) -> Eq EBase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EBase -> EBase -> Bool
== :: EBase -> EBase -> Bool
$c/= :: EBase -> EBase -> Bool
/= :: EBase -> EBase -> Bool
Eq, Int -> EBase -> ShowS
[EBase] -> ShowS
EBase -> String
(Int -> EBase -> ShowS)
-> (EBase -> String) -> ([EBase] -> ShowS) -> Show EBase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EBase -> ShowS
showsPrec :: Int -> EBase -> ShowS
$cshow :: EBase -> String
show :: EBase -> String
$cshowList :: [EBase] -> ShowS
showList :: [EBase] -> ShowS
Show, (forall x. EBase -> Rep EBase x)
-> (forall x. Rep EBase x -> EBase) -> Generic EBase
forall x. Rep EBase x -> EBase
forall x. EBase -> Rep EBase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EBase -> Rep EBase x
from :: forall x. EBase -> Rep EBase x
$cto :: forall x. Rep EBase x -> EBase
to :: forall x. Rep EBase x -> EBase
Generic)

-- | A generic context layer for a parse error of type @e@.
--
-- Recursive: parse errors occurring in fields are wrapped up here. (Those
-- errors may also have a generic context layer.)
--
-- Making this explicitly recursive may seem strange, but it clarifies that this
-- data type is to be seen as a layer over a top-level type.
data EGeneric e
  -- | Parse error relating to sum types (constructors).
  = EGenericSum (EGenericSum e)

  -- | Parse error in a constructor field.
  | EGenericField
        String          -- ^ constructor name
        (Maybe String)  -- ^ field record name (if present)
        Natural         -- ^ field index in constructor
        e               -- ^ field parse error
    deriving stock (EGeneric e -> EGeneric e -> Bool
(EGeneric e -> EGeneric e -> Bool)
-> (EGeneric e -> EGeneric e -> Bool) -> Eq (EGeneric e)
forall e. Eq e => EGeneric e -> EGeneric e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => EGeneric e -> EGeneric e -> Bool
== :: EGeneric e -> EGeneric e -> Bool
$c/= :: forall e. Eq e => EGeneric e -> EGeneric e -> Bool
/= :: EGeneric e -> EGeneric e -> Bool
Eq, Int -> EGeneric e -> ShowS
[EGeneric e] -> ShowS
EGeneric e -> String
(Int -> EGeneric e -> ShowS)
-> (EGeneric e -> String)
-> ([EGeneric e] -> ShowS)
-> Show (EGeneric e)
forall e. Show e => Int -> EGeneric e -> ShowS
forall e. Show e => [EGeneric e] -> ShowS
forall e. Show e => EGeneric e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> EGeneric e -> ShowS
showsPrec :: Int -> EGeneric e -> ShowS
$cshow :: forall e. Show e => EGeneric e -> String
show :: EGeneric e -> String
$cshowList :: forall e. Show e => [EGeneric e] -> ShowS
showList :: [EGeneric e] -> ShowS
Show, (forall x. EGeneric e -> Rep (EGeneric e) x)
-> (forall x. Rep (EGeneric e) x -> EGeneric e)
-> Generic (EGeneric e)
forall x. Rep (EGeneric e) x -> EGeneric e
forall x. EGeneric e -> Rep (EGeneric e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (EGeneric e) x -> EGeneric e
forall e x. EGeneric e -> Rep (EGeneric e) x
$cfrom :: forall e x. EGeneric e -> Rep (EGeneric e) x
from :: forall x. EGeneric e -> Rep (EGeneric e) x
$cto :: forall e x. Rep (EGeneric e) x -> EGeneric e
to :: forall x. Rep (EGeneric e) x -> EGeneric e
Generic)

data EGenericSum e
  -- | Parse error parsing prefix tag.
  = EGenericSumTag e

  -- | Unable to match a constructor to the parsed prefix tag.
  | EGenericSumTagNoMatch
        [String] -- ^ constructors tested
        Text     -- ^ prettified prefix tag
    deriving stock (EGenericSum e -> EGenericSum e -> Bool
(EGenericSum e -> EGenericSum e -> Bool)
-> (EGenericSum e -> EGenericSum e -> Bool) -> Eq (EGenericSum e)
forall e. Eq e => EGenericSum e -> EGenericSum e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => EGenericSum e -> EGenericSum e -> Bool
== :: EGenericSum e -> EGenericSum e -> Bool
$c/= :: forall e. Eq e => EGenericSum e -> EGenericSum e -> Bool
/= :: EGenericSum e -> EGenericSum e -> Bool
Eq, Int -> EGenericSum e -> ShowS
[EGenericSum e] -> ShowS
EGenericSum e -> String
(Int -> EGenericSum e -> ShowS)
-> (EGenericSum e -> String)
-> ([EGenericSum e] -> ShowS)
-> Show (EGenericSum e)
forall e. Show e => Int -> EGenericSum e -> ShowS
forall e. Show e => [EGenericSum e] -> ShowS
forall e. Show e => EGenericSum e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> EGenericSum e -> ShowS
showsPrec :: Int -> EGenericSum e -> ShowS
$cshow :: forall e. Show e => EGenericSum e -> String
show :: EGenericSum e -> String
$cshowList :: forall e. Show e => [EGenericSum e] -> ShowS
showList :: [EGenericSum e] -> ShowS
Show, (forall x. EGenericSum e -> Rep (EGenericSum e) x)
-> (forall x. Rep (EGenericSum e) x -> EGenericSum e)
-> Generic (EGenericSum e)
forall x. Rep (EGenericSum e) x -> EGenericSum e
forall x. EGenericSum e -> Rep (EGenericSum e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (EGenericSum e) x -> EGenericSum e
forall e x. EGenericSum e -> Rep (EGenericSum e) x
$cfrom :: forall e x. EGenericSum e -> Rep (EGenericSum e) x
from :: forall x. EGenericSum e -> Rep (EGenericSum e) x
$cto :: forall e x. Rep (EGenericSum e) x -> EGenericSum e
to :: forall x. Rep (EGenericSum e) x -> EGenericSum e
Generic)