{-# LANGUAGE Safe #-}
{-# LANGUAGE OverloadedLists, RecordWildCards #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}
module Text.Gigaparsec.Errors.ErrorGen (
    ErrorGen(..), UnexpectedItem(..), asFail, asSelect, asErr, vanillaGen, specializedGen
  ) where
import Text.Gigaparsec.Internal (Parsec)
import Text.Gigaparsec.Internal qualified as Internal (Parsec(Parsec), State, specialisedErr, emptyErr, expectedErr, unexpectedErr, raise)
import Text.Gigaparsec.Internal.Errors qualified as Internal (Error, CaretWidth(RigidCaret), addReason)

type ErrorGen :: * -> *
data ErrorGen a = SpecializedGen { forall a. ErrorGen a -> a -> [String]
messages :: a -> [String] -- FIXME: 0.3.0.0 change to NonEmptyList
                                 , forall a. ErrorGen a -> a -> Word -> Word
adjustWidth :: a -> Word -> Word
                                 }
                | VanillaGen { forall a. ErrorGen a -> a -> UnexpectedItem
unexpected :: a -> UnexpectedItem
                             , forall a. ErrorGen a -> a -> Maybe String
reason :: a -> Maybe String
                             , adjustWidth :: a -> Word -> Word
                             }

vanillaGen :: ErrorGen a
vanillaGen :: forall a. ErrorGen a
vanillaGen = VanillaGen { unexpected :: a -> UnexpectedItem
unexpected = UnexpectedItem -> a -> UnexpectedItem
forall a b. a -> b -> a
const UnexpectedItem
EmptyItem
                        , reason :: a -> Maybe String
reason = Maybe String -> a -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing
                        , adjustWidth :: a -> Word -> Word
adjustWidth = (Word -> Word) -> a -> Word -> Word
forall a b. a -> b -> a
const Word -> Word
forall a. a -> a
id
                        }

specializedGen :: ErrorGen a
specializedGen :: forall a. ErrorGen a
specializedGen = SpecializedGen { messages :: a -> [String]
messages = [String] -> a -> [String]
forall a b. a -> b -> a
const []
                                , adjustWidth :: a -> Word -> Word
adjustWidth = (Word -> Word) -> a -> Word -> Word
forall a b. a -> b -> a
const Word -> Word
forall a. a -> a
id
                                }

type UnexpectedItem :: *
data UnexpectedItem = RawItem | EmptyItem | NamedItem String

asErr :: ErrorGen a -> a -> Word -> Parsec b
asErr :: forall a b. ErrorGen a -> a -> Word -> Parsec b
asErr ErrorGen a
errGen a
x Word
w = (State -> Error) -> Parsec b
forall a. (State -> Error) -> Parsec a
Internal.raise ((State -> Error) -> Parsec b) -> (State -> Error) -> Parsec b
forall a b. (a -> b) -> a -> b
$ \State
st -> ErrorGen a -> State -> a -> Word -> Error
forall a. ErrorGen a -> State -> a -> Word -> Error
genErr ErrorGen a
errGen State
st a
x Word
w

asFail :: ErrorGen a -> Parsec (a, Word) -> Parsec b
asFail :: forall a b. ErrorGen a -> Parsec (a, Word) -> Parsec b
asFail ErrorGen a
errGen (Internal.Parsec forall r.
State
-> ((a, Word) -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p) = (forall r.
 State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec b
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
  State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec b)
-> (forall r.
    State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec b
forall a b. (a -> b) -> a -> b
$ \State
st b -> State -> RT r
_ Error -> State -> RT r
bad ->
  let good :: (a, Word) -> State -> RT r
good (a
x, Word
w) State
st' = Error -> State -> RT r
bad (ErrorGen a -> State -> a -> Word -> Error
forall a. ErrorGen a -> State -> a -> Word -> Error
genErr ErrorGen a
errGen State
st' a
x Word
w) State
st'
  in  State
-> ((a, Word) -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State
-> ((a, Word) -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p State
st (a, Word) -> State -> RT r
good Error -> State -> RT r
bad

asSelect :: ErrorGen a -> Parsec (Either (a, Word) b) -> Parsec b
asSelect :: forall a b. ErrorGen a -> Parsec (Either (a, Word) b) -> Parsec b
asSelect ErrorGen a
errGen (Internal.Parsec forall r.
State
-> (Either (a, Word) b -> State -> RT r)
-> (Error -> State -> RT r)
-> RT r
p) = (forall r.
 State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec b
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Internal.Parsec ((forall r.
  State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec b)
-> (forall r.
    State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec b
forall a b. (a -> b) -> a -> b
$ \State
st b -> State -> RT r
good Error -> State -> RT r
bad ->
  let good' :: Either (a, Word) b -> State -> RT r
good' (Right b
x) State
st' = b -> State -> RT r
good b
x State
st'
      good' (Left (a
x, Word
w)) State
st' = Error -> State -> RT r
bad (ErrorGen a -> State -> a -> Word -> Error
forall a. ErrorGen a -> State -> a -> Word -> Error
genErr ErrorGen a
errGen State
st' a
x Word
w) State
st'
  in State
-> (Either (a, Word) b -> State -> RT r)
-> (Error -> State -> RT r)
-> RT r
forall r.
State
-> (Either (a, Word) b -> State -> RT r)
-> (Error -> State -> RT r)
-> RT r
p State
st Either (a, Word) b -> State -> RT r
good' Error -> State -> RT r
bad

genErr :: ErrorGen a -> Internal.State -> a -> Word -> Internal.Error
genErr :: forall a. ErrorGen a -> State -> a -> Word -> Error
genErr SpecializedGen{a -> [String]
a -> Word -> Word
messages :: forall a. ErrorGen a -> a -> [String]
adjustWidth :: forall a. ErrorGen a -> a -> Word -> Word
messages :: a -> [String]
adjustWidth :: a -> Word -> Word
..} State
st a
x Word
w =
  State -> [String] -> CaretWidth -> Error
Internal.specialisedErr State
st (a -> [String]
messages a
x) (Word -> CaretWidth
Internal.RigidCaret (a -> Word -> Word
adjustWidth a
x Word
w))
genErr VanillaGen{a -> Maybe String
a -> UnexpectedItem
a -> Word -> Word
adjustWidth :: forall a. ErrorGen a -> a -> Word -> Word
unexpected :: forall a. ErrorGen a -> a -> UnexpectedItem
reason :: forall a. ErrorGen a -> a -> Maybe String
unexpected :: a -> UnexpectedItem
reason :: a -> Maybe String
adjustWidth :: a -> Word -> Word
..} State
st a
x Word
w =
  Maybe String -> Error -> Error
addReason (a -> Maybe String
reason a
x) (UnexpectedItem -> State -> Word -> Error
makeError (a -> UnexpectedItem
unexpected a
x) State
st (a -> Word -> Word
adjustWidth a
x Word
w))

makeError :: UnexpectedItem -> Internal.State -> Word -> Internal.Error
makeError :: UnexpectedItem -> State -> Word -> Error
makeError UnexpectedItem
RawItem State
st Word
cw = State -> Set ExpectItem -> Word -> Error
Internal.expectedErr State
st [] Word
cw
makeError UnexpectedItem
EmptyItem State
st Word
cw = State -> Word -> Error
Internal.emptyErr State
st Word
cw
makeError (NamedItem String
name) State
st Word
cw = State -> Set ExpectItem -> String -> CaretWidth -> Error
Internal.unexpectedErr State
st [] String
name (Word -> CaretWidth
Internal.RigidCaret Word
cw)

-- no fold, unlifed type
addReason :: Maybe String -> Internal.Error -> Internal.Error
addReason :: Maybe String -> Error -> Error
addReason Maybe String
Nothing Error
err = Error
err
addReason (Just String
reason) Error
err = String -> Error -> Error
Internal.addReason String
reason Error
err