{-# options_ghc -Wno-orphans #-}

{-# language UndecidableInstances #-}

module ParseLib.Error where

import Data.Bifunctor (second)
import Data.Either (partitionEithers)
import Data.Foldable (toList)
import Data.List (intercalate, sortOn, stripPrefix)
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as N
import Data.Maybe (fromMaybe)
import qualified Data.Set as S
import Data.Void (Void)
import Debug.Trace (trace)
import Text.Megaparsec.Error
  ( ErrorFancy (ErrorFail),
    ErrorItem (EndOfInput, Tokens),
  )
import qualified Text.Megaparsec.Error as M
import qualified Text.Megaparsec.ErrorList as ML
import Text.Megaparsec.Pos (SourcePos (SourcePos), mkPos)
import Text.Megaparsec.State (PosState (PosState))
import Text.Megaparsec.Stream (Token)

-- * configuration

data Config =
  Config
    {
      -- | upper limit of positions where to collect errors from. a value
      -- of zero turns off error reporting. a negative value causes all
      -- errors to be reported.
      Config -> Int
errorCount :: Int,
      -- | upper limit of symbols to show before the offending symbol
      Config -> Int
symbolsBefore :: Int,
      -- | upper limit of symbols to show after the offending symbol
      Config -> Int
symbolsAfter :: Int
    }
  deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
/= :: Config -> Config -> Bool
Eq, Eq Config
Eq Config
-> (Config -> Config -> Ordering)
-> (Config -> Config -> Bool)
-> (Config -> Config -> Bool)
-> (Config -> Config -> Bool)
-> (Config -> Config -> Bool)
-> (Config -> Config -> Config)
-> (Config -> Config -> Config)
-> Ord Config
Config -> Config -> Bool
Config -> Config -> Ordering
Config -> Config -> Config
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Config -> Config -> Ordering
compare :: Config -> Config -> Ordering
$c< :: Config -> Config -> Bool
< :: Config -> Config -> Bool
$c<= :: Config -> Config -> Bool
<= :: Config -> Config -> Bool
$c> :: Config -> Config -> Bool
> :: Config -> Config -> Bool
$c>= :: Config -> Config -> Bool
>= :: Config -> Config -> Bool
$cmax :: Config -> Config -> Config
max :: Config -> Config -> Config
$cmin :: Config -> Config -> Config
min :: Config -> Config -> Config
Ord, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show)

-- | default configuration, setting `errorCount` to 1, `symbolsBefore` to
-- 16, and `symbolsAfter` to 15.
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
  Config {errorCount :: Int
errorCount = Int
1, symbolsBefore :: Int
symbolsBefore = Int
16, symbolsAfter :: Int
symbolsAfter = Int
15}

-- | set a configuration's `errorCount`
errorCountSet ::
  -- | new `errorCount`
  Int ->
  Config ->
  Config
errorCountSet :: Int -> Config -> Config
errorCountSet Int
errorCount (Config {Int
symbolsBefore :: Config -> Int
symbolsBefore :: Int
symbolsBefore, Int
symbolsAfter :: Config -> Int
symbolsAfter :: Int
symbolsAfter}) =
  Config {Int
errorCount :: Int
errorCount :: Int
errorCount, Int
symbolsBefore :: Int
symbolsBefore :: Int
symbolsBefore, Int
symbolsAfter :: Int
symbolsAfter :: Int
symbolsAfter}

-- | set a configuration's `symbolsBefore`
symbolsBeforeSet ::
  -- | new `symbolsBefore`
  Int ->
  Config ->
  Config
symbolsBeforeSet :: Int -> Config -> Config
symbolsBeforeSet Int
symbolsBefore (Config {Int
errorCount :: Config -> Int
errorCount :: Int
errorCount, Int
symbolsAfter :: Config -> Int
symbolsAfter :: Int
symbolsAfter}) =
  Config {Int
errorCount :: Int
errorCount :: Int
errorCount, Int
symbolsBefore :: Int
symbolsBefore :: Int
symbolsBefore, Int
symbolsAfter :: Int
symbolsAfter :: Int
symbolsAfter}

-- | set a configuration's `symbolsAfter`
symbolsAfterSet ::
  -- | new `symbolsAfter`
  Int ->
  Config ->
  Config
symbolsAfterSet :: Int -> Config -> Config
symbolsAfterSet Int
symbolsAfter (Config {Int
errorCount :: Config -> Int
errorCount :: Int
errorCount, Int
symbolsBefore :: Config -> Int
symbolsBefore :: Int
symbolsBefore}) =
  Config {Int
errorCount :: Int
errorCount :: Int
errorCount, Int
symbolsBefore :: Int
symbolsBefore :: Int
symbolsBefore, Int
symbolsAfter :: Int
symbolsAfter :: Int
symbolsAfter}

-- * parse error bundle

newtype ParseErrorBundle symbols =
  ParseErrorBundle
    [(WithLength symbols, NonEmpty (BundledParseError symbols))]
  deriving (ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
(ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool)
-> (ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool)
-> Eq (ParseErrorBundle symbols)
forall symbols.
Eq symbols =>
ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall symbols.
Eq symbols =>
ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
== :: ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
$c/= :: forall symbols.
Eq symbols =>
ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
/= :: ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
Eq, Eq (ParseErrorBundle symbols)
Eq (ParseErrorBundle symbols)
-> (ParseErrorBundle symbols
    -> ParseErrorBundle symbols -> Ordering)
-> (ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool)
-> (ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool)
-> (ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool)
-> (ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool)
-> (ParseErrorBundle symbols
    -> ParseErrorBundle symbols -> ParseErrorBundle symbols)
-> (ParseErrorBundle symbols
    -> ParseErrorBundle symbols -> ParseErrorBundle symbols)
-> Ord (ParseErrorBundle symbols)
ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
ParseErrorBundle symbols -> ParseErrorBundle symbols -> Ordering
ParseErrorBundle symbols
-> ParseErrorBundle symbols -> ParseErrorBundle symbols
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {symbols}. Ord symbols => Eq (ParseErrorBundle symbols)
forall symbols.
Ord symbols =>
ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
forall symbols.
Ord symbols =>
ParseErrorBundle symbols -> ParseErrorBundle symbols -> Ordering
forall symbols.
Ord symbols =>
ParseErrorBundle symbols
-> ParseErrorBundle symbols -> ParseErrorBundle symbols
$ccompare :: forall symbols.
Ord symbols =>
ParseErrorBundle symbols -> ParseErrorBundle symbols -> Ordering
compare :: ParseErrorBundle symbols -> ParseErrorBundle symbols -> Ordering
$c< :: forall symbols.
Ord symbols =>
ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
< :: ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
$c<= :: forall symbols.
Ord symbols =>
ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
<= :: ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
$c> :: forall symbols.
Ord symbols =>
ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
> :: ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
$c>= :: forall symbols.
Ord symbols =>
ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
>= :: ParseErrorBundle symbols -> ParseErrorBundle symbols -> Bool
$cmax :: forall symbols.
Ord symbols =>
ParseErrorBundle symbols
-> ParseErrorBundle symbols -> ParseErrorBundle symbols
max :: ParseErrorBundle symbols
-> ParseErrorBundle symbols -> ParseErrorBundle symbols
$cmin :: forall symbols.
Ord symbols =>
ParseErrorBundle symbols
-> ParseErrorBundle symbols -> ParseErrorBundle symbols
min :: ParseErrorBundle symbols
-> ParseErrorBundle symbols -> ParseErrorBundle symbols
Ord, Int -> ParseErrorBundle symbols -> ShowS
[ParseErrorBundle symbols] -> ShowS
ParseErrorBundle symbols -> String
(Int -> ParseErrorBundle symbols -> ShowS)
-> (ParseErrorBundle symbols -> String)
-> ([ParseErrorBundle symbols] -> ShowS)
-> Show (ParseErrorBundle symbols)
forall symbols.
Show symbols =>
Int -> ParseErrorBundle symbols -> ShowS
forall symbols. Show symbols => [ParseErrorBundle symbols] -> ShowS
forall symbols. Show symbols => ParseErrorBundle symbols -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall symbols.
Show symbols =>
Int -> ParseErrorBundle symbols -> ShowS
showsPrec :: Int -> ParseErrorBundle symbols -> ShowS
$cshow :: forall symbols. Show symbols => ParseErrorBundle symbols -> String
show :: ParseErrorBundle symbols -> String
$cshowList :: forall symbols. Show symbols => [ParseErrorBundle symbols] -> ShowS
showList :: [ParseErrorBundle symbols] -> ShowS
Show)

data BundledParseError symbols =
  BundledParseError symbols -- ^ expected
  |
  BundledFail String -- ^ message
  deriving (BundledParseError symbols -> BundledParseError symbols -> Bool
(BundledParseError symbols -> BundledParseError symbols -> Bool)
-> (BundledParseError symbols -> BundledParseError symbols -> Bool)
-> Eq (BundledParseError symbols)
forall symbols.
Eq symbols =>
BundledParseError symbols -> BundledParseError symbols -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall symbols.
Eq symbols =>
BundledParseError symbols -> BundledParseError symbols -> Bool
== :: BundledParseError symbols -> BundledParseError symbols -> Bool
$c/= :: forall symbols.
Eq symbols =>
BundledParseError symbols -> BundledParseError symbols -> Bool
/= :: BundledParseError symbols -> BundledParseError symbols -> Bool
Eq, Eq (BundledParseError symbols)
Eq (BundledParseError symbols)
-> (BundledParseError symbols
    -> BundledParseError symbols -> Ordering)
-> (BundledParseError symbols -> BundledParseError symbols -> Bool)
-> (BundledParseError symbols -> BundledParseError symbols -> Bool)
-> (BundledParseError symbols -> BundledParseError symbols -> Bool)
-> (BundledParseError symbols -> BundledParseError symbols -> Bool)
-> (BundledParseError symbols
    -> BundledParseError symbols -> BundledParseError symbols)
-> (BundledParseError symbols
    -> BundledParseError symbols -> BundledParseError symbols)
-> Ord (BundledParseError symbols)
BundledParseError symbols -> BundledParseError symbols -> Bool
BundledParseError symbols -> BundledParseError symbols -> Ordering
BundledParseError symbols
-> BundledParseError symbols -> BundledParseError symbols
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {symbols}. Ord symbols => Eq (BundledParseError symbols)
forall symbols.
Ord symbols =>
BundledParseError symbols -> BundledParseError symbols -> Bool
forall symbols.
Ord symbols =>
BundledParseError symbols -> BundledParseError symbols -> Ordering
forall symbols.
Ord symbols =>
BundledParseError symbols
-> BundledParseError symbols -> BundledParseError symbols
$ccompare :: forall symbols.
Ord symbols =>
BundledParseError symbols -> BundledParseError symbols -> Ordering
compare :: BundledParseError symbols -> BundledParseError symbols -> Ordering
$c< :: forall symbols.
Ord symbols =>
BundledParseError symbols -> BundledParseError symbols -> Bool
< :: BundledParseError symbols -> BundledParseError symbols -> Bool
$c<= :: forall symbols.
Ord symbols =>
BundledParseError symbols -> BundledParseError symbols -> Bool
<= :: BundledParseError symbols -> BundledParseError symbols -> Bool
$c> :: forall symbols.
Ord symbols =>
BundledParseError symbols -> BundledParseError symbols -> Bool
> :: BundledParseError symbols -> BundledParseError symbols -> Bool
$c>= :: forall symbols.
Ord symbols =>
BundledParseError symbols -> BundledParseError symbols -> Bool
>= :: BundledParseError symbols -> BundledParseError symbols -> Bool
$cmax :: forall symbols.
Ord symbols =>
BundledParseError symbols
-> BundledParseError symbols -> BundledParseError symbols
max :: BundledParseError symbols
-> BundledParseError symbols -> BundledParseError symbols
$cmin :: forall symbols.
Ord symbols =>
BundledParseError symbols
-> BundledParseError symbols -> BundledParseError symbols
min :: BundledParseError symbols
-> BundledParseError symbols -> BundledParseError symbols
Ord, Int -> BundledParseError symbols -> ShowS
[BundledParseError symbols] -> ShowS
BundledParseError symbols -> String
(Int -> BundledParseError symbols -> ShowS)
-> (BundledParseError symbols -> String)
-> ([BundledParseError symbols] -> ShowS)
-> Show (BundledParseError symbols)
forall symbols.
Show symbols =>
Int -> BundledParseError symbols -> ShowS
forall symbols.
Show symbols =>
[BundledParseError symbols] -> ShowS
forall symbols. Show symbols => BundledParseError symbols -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall symbols.
Show symbols =>
Int -> BundledParseError symbols -> ShowS
showsPrec :: Int -> BundledParseError symbols -> ShowS
$cshow :: forall symbols. Show symbols => BundledParseError symbols -> String
show :: BundledParseError symbols -> String
$cshowList :: forall symbols.
Show symbols =>
[BundledParseError symbols] -> ShowS
showList :: [BundledParseError symbols] -> ShowS
Show)

data WithLength a = WithLength a Int deriving (WithLength a -> WithLength a -> Bool
(WithLength a -> WithLength a -> Bool)
-> (WithLength a -> WithLength a -> Bool) -> Eq (WithLength a)
forall a. Eq a => WithLength a -> WithLength a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => WithLength a -> WithLength a -> Bool
== :: WithLength a -> WithLength a -> Bool
$c/= :: forall a. Eq a => WithLength a -> WithLength a -> Bool
/= :: WithLength a -> WithLength a -> Bool
Eq, Eq (WithLength a)
Eq (WithLength a)
-> (WithLength a -> WithLength a -> Ordering)
-> (WithLength a -> WithLength a -> Bool)
-> (WithLength a -> WithLength a -> Bool)
-> (WithLength a -> WithLength a -> Bool)
-> (WithLength a -> WithLength a -> Bool)
-> (WithLength a -> WithLength a -> WithLength a)
-> (WithLength a -> WithLength a -> WithLength a)
-> Ord (WithLength a)
WithLength a -> WithLength a -> Bool
WithLength a -> WithLength a -> Ordering
WithLength a -> WithLength a -> WithLength a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (WithLength a)
forall a. Ord a => WithLength a -> WithLength a -> Bool
forall a. Ord a => WithLength a -> WithLength a -> Ordering
forall a. Ord a => WithLength a -> WithLength a -> WithLength a
$ccompare :: forall a. Ord a => WithLength a -> WithLength a -> Ordering
compare :: WithLength a -> WithLength a -> Ordering
$c< :: forall a. Ord a => WithLength a -> WithLength a -> Bool
< :: WithLength a -> WithLength a -> Bool
$c<= :: forall a. Ord a => WithLength a -> WithLength a -> Bool
<= :: WithLength a -> WithLength a -> Bool
$c> :: forall a. Ord a => WithLength a -> WithLength a -> Bool
> :: WithLength a -> WithLength a -> Bool
$c>= :: forall a. Ord a => WithLength a -> WithLength a -> Bool
>= :: WithLength a -> WithLength a -> Bool
$cmax :: forall a. Ord a => WithLength a -> WithLength a -> WithLength a
max :: WithLength a -> WithLength a -> WithLength a
$cmin :: forall a. Ord a => WithLength a -> WithLength a -> WithLength a
min :: WithLength a -> WithLength a -> WithLength a
Ord, Int -> WithLength a -> ShowS
[WithLength a] -> ShowS
WithLength a -> String
(Int -> WithLength a -> ShowS)
-> (WithLength a -> String)
-> ([WithLength a] -> ShowS)
-> Show (WithLength a)
forall a. Show a => Int -> WithLength a -> ShowS
forall a. Show a => [WithLength a] -> ShowS
forall a. Show a => WithLength a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithLength a -> ShowS
showsPrec :: Int -> WithLength a -> ShowS
$cshow :: forall a. Show a => WithLength a -> String
show :: WithLength a -> String
$cshowList :: forall a. Show a => [WithLength a] -> ShowS
showList :: [WithLength a] -> ShowS
Show)

-- * pretty printing parse error bundles

class (Show symbol) => ErrorsPretty symbol where
  -- | pretty prints a `ParseErrorBundle` like `errorBundlePretty` but
  -- makes error messages bearable for @Parser Char@.
  -- `errorBundlePrettyImproved` is always preferable to
  -- `errorBundlePretty`.
  --
  -- if you see the following GHC error, you usually need to add an
  -- `ErrorsPretty` constraint to your function.
  --
  -- @
  -- Overlapping instances for ErrorsPretty
  -- arising from a use of ‘errorBundlePrettyImproved’
  -- @
  errorBundlePrettyImproved ::
    Config ->
    -- | entire input
    [symbol] ->
    ParseErrorBundle [symbol] ->
    String

-- | an `ErrorsPretty` constraint is automatically fulfilled by `Show`
-- instances.
instance {-# overlappable #-} (Show symbol, Ord symbol) => ErrorsPretty symbol where
  errorBundlePrettyImproved :: Config -> [symbol] -> ParseErrorBundle [symbol] -> String
errorBundlePrettyImproved = Config -> [symbol] -> ParseErrorBundle [symbol] -> String
forall symbol.
(Ord symbol, Show symbol) =>
Config -> [symbol] -> ParseErrorBundle [symbol] -> String
errorBundlePretty

instance ErrorsPretty Char where
  errorBundlePrettyImproved :: Config -> String -> ParseErrorBundle String -> String
errorBundlePrettyImproved Config
_ String
input =
    String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (ParseErrorBundle String -> Maybe String)
-> ParseErrorBundle String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (ParseErrorBundle String Void -> String)
-> Maybe (ParseErrorBundle String Void) -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
M.errorBundlePretty (Maybe (ParseErrorBundle String Void) -> Maybe String)
-> (ParseErrorBundle String
    -> Maybe (ParseErrorBundle String Void))
-> ParseErrorBundle String
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String
-> ParseErrorBundle String -> Maybe (ParseErrorBundle String Void)
forall s.
Ord s =>
[s] -> ParseErrorBundle [s] -> Maybe (ParseErrorBundle [s] Void)
toMegaparsecBundle String
input

-- | pretty prints a `ParseErrorBundle` like `errorBundlePrettyImproved`
-- but with much worse error messages for @Parser Char@.
-- `errorBundlePrettyImproved` is always preferable to `errorBundlePretty`.
errorBundlePretty ::
  (Ord symbol, Show symbol) =>
  Config ->
  -- | entire input
  [symbol] ->
  ParseErrorBundle [symbol] ->
  String
errorBundlePretty :: forall symbol.
(Ord symbol, Show symbol) =>
Config -> [symbol] -> ParseErrorBundle [symbol] -> String
errorBundlePretty (Config {Int
symbolsBefore :: Config -> Int
symbolsBefore :: Int
symbolsBefore, Int
symbolsAfter :: Config -> Int
symbolsAfter :: Int
symbolsAfter}) [symbol]
input (ParseErrorBundle [(WithLength [symbol], NonEmpty (BundledParseError [symbol]))]
bundle) =
  ((WithLength [symbol], NonEmpty (BundledParseError [symbol]))
 -> String)
-> [(WithLength [symbol], NonEmpty (BundledParseError [symbol]))]
-> String
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
    (\errorBundled :: (WithLength [symbol], NonEmpty (BundledParseError [symbol]))
errorBundled@(WithLength [symbol]
_ Int
inputRestLength, NonEmpty (BundledParseError [symbol])
_) ->
      let
        position :: Int
position = Int
inputLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
inputRestLength
        symbolsBeforeActual :: Int
symbolsBeforeActual = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
symbolsBefore Int
position
        ([symbol]
theSymbolsBefore, [symbol]
theSymbolsAfter) =
          ([symbol] -> [symbol])
-> ([symbol], [symbol]) -> ([symbol], [symbol])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> [symbol] -> [symbol]
forall a. Int -> [a] -> [a]
take (Int -> [symbol] -> [symbol]) -> Int -> [symbol] -> [symbol]
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
symbolsAfter) (([symbol], [symbol]) -> ([symbol], [symbol]))
-> ([symbol], [symbol]) -> ([symbol], [symbol])
forall a b. (a -> b) -> a -> b
$
          Int -> [symbol] -> ([symbol], [symbol])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
symbolsBeforeActual ([symbol] -> ([symbol], [symbol]))
-> [symbol] -> ([symbol], [symbol])
forall a b. (a -> b) -> a -> b
$
          Int -> [symbol] -> [symbol]
forall a. Int -> [a] -> [a]
drop (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
symbolsBeforeActual) ([symbol] -> [symbol]) -> [symbol] -> [symbol]
forall a b. (a -> b) -> a -> b
$
          [symbol]
input
      in
        String
"input:" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
position String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        (symbol -> String) -> [symbol] -> String
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\symbol
s -> String
"  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> symbol -> String
forall a. Show a => a -> String
show symbol
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n") [symbol]
theSymbolsBefore String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        String
">" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        (
          String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"\n" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$
          String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
" " (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$
          (symbol -> String) -> [symbol] -> String
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\symbol
s -> String
"  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> symbol -> String
forall a. Show a => a -> String
show symbol
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n") ([symbol] -> String) -> [symbol] -> String
forall a b. (a -> b) -> a -> b
$
          [symbol]
theSymbolsAfter
        ) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        (
          String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
          (ParseError [symbol] Void -> String)
-> [ParseError [symbol] Void] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseError [symbol] Void -> String
forall s e.
(Show (Token s), ShowErrorComponent e) =>
ParseError s e -> String
ML.parseErrorTextPretty ([ParseError [symbol] Void] -> [String])
-> [ParseError [symbol] Void] -> [String]
forall a b. (a -> b) -> a -> b
$
          Int
-> (WithLength [symbol], NonEmpty (BundledParseError [symbol]))
-> [ParseError [symbol] Void]
forall s.
Ord s =>
Int
-> (WithLength [s], NonEmpty (BundledParseError [s]))
-> [ParseError [s] Void]
toMegaparsecBundled Int
inputLength ((WithLength [symbol], NonEmpty (BundledParseError [symbol]))
 -> [ParseError [symbol] Void])
-> (WithLength [symbol], NonEmpty (BundledParseError [symbol]))
-> [ParseError [symbol] Void]
forall a b. (a -> b) -> a -> b
$
          (WithLength [symbol], NonEmpty (BundledParseError [symbol]))
errorBundled
        ) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        String
"\n\n"
    )
    [(WithLength [symbol], NonEmpty (BundledParseError [symbol]))]
bundle
  where
    inputLength :: Int
    inputLength :: Int
inputLength = [symbol] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [symbol]
input

-- | returns @[]@ in the case of `Left` and prints the `String` to standard
-- error (stderr) using `trace`.
traceErrorMessage :: Either String (NonEmpty (a, [s])) -> [(a, [s])]
traceErrorMessage :: forall a s. Either String (NonEmpty (a, [s])) -> [(a, [s])]
traceErrorMessage (Right NonEmpty (a, [s])
result) = NonEmpty (a, [s]) -> [(a, [s])]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (a, [s])
result
traceErrorMessage (Left String
errorMessage)
  | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
errorMessage = []
  | Bool
otherwise = String -> [(a, [s])] -> [(a, [s])]
forall a. String -> a -> a
trace String
errorMessage []

-- * unbundled parse error

data ParseError symbols =
  ParseError
    symbols -- ^ expected
    symbols -- ^ actual
  |
  Fail
    String -- ^ message
    symbols -- ^ actual
  deriving (ParseError symbols -> ParseError symbols -> Bool
(ParseError symbols -> ParseError symbols -> Bool)
-> (ParseError symbols -> ParseError symbols -> Bool)
-> Eq (ParseError symbols)
forall symbols.
Eq symbols =>
ParseError symbols -> ParseError symbols -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall symbols.
Eq symbols =>
ParseError symbols -> ParseError symbols -> Bool
== :: ParseError symbols -> ParseError symbols -> Bool
$c/= :: forall symbols.
Eq symbols =>
ParseError symbols -> ParseError symbols -> Bool
/= :: ParseError symbols -> ParseError symbols -> Bool
Eq)

toBundle ::
  (Ord s) =>
  [ParseError [s]] -> [(WithLength [s], NonEmpty (BundledParseError [s]))]
toBundle :: forall s.
Ord s =>
[ParseError [s]]
-> [(WithLength [s], NonEmpty (BundledParseError [s]))]
toBundle =
  -- [(WithLength [s], NonEmpty (BundledParseError [s]))]
  -- remove duplicates from each `NonEmpty BundledParseError`
  (((WithLength [s], NonEmpty (BundledParseError [s]))
 -> (WithLength [s], NonEmpty (BundledParseError [s])))
-> [(WithLength [s], NonEmpty (BundledParseError [s]))]
-> [(WithLength [s], NonEmpty (BundledParseError [s]))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((WithLength [s], NonEmpty (BundledParseError [s]))
  -> (WithLength [s], NonEmpty (BundledParseError [s])))
 -> [(WithLength [s], NonEmpty (BundledParseError [s]))]
 -> [(WithLength [s], NonEmpty (BundledParseError [s]))])
-> ((NonEmpty (BundledParseError [s])
     -> NonEmpty (BundledParseError [s]))
    -> (WithLength [s], NonEmpty (BundledParseError [s]))
    -> (WithLength [s], NonEmpty (BundledParseError [s])))
-> (NonEmpty (BundledParseError [s])
    -> NonEmpty (BundledParseError [s]))
-> [(WithLength [s], NonEmpty (BundledParseError [s]))]
-> [(WithLength [s], NonEmpty (BundledParseError [s]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (BundledParseError [s])
 -> NonEmpty (BundledParseError [s]))
-> (WithLength [s], NonEmpty (BundledParseError [s]))
-> (WithLength [s], NonEmpty (BundledParseError [s]))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second) ((NonEmpty (BundledParseError [s]) -> BundledParseError [s])
-> NonEmpty (NonEmpty (BundledParseError [s]))
-> NonEmpty (BundledParseError [s])
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (BundledParseError [s]) -> BundledParseError [s]
forall a. NonEmpty a -> a
N.head (NonEmpty (NonEmpty (BundledParseError [s]))
 -> NonEmpty (BundledParseError [s]))
-> (NonEmpty (BundledParseError [s])
    -> NonEmpty (NonEmpty (BundledParseError [s])))
-> NonEmpty (BundledParseError [s])
-> NonEmpty (BundledParseError [s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (BundledParseError [s])
-> NonEmpty (NonEmpty (BundledParseError [s]))
forall a. Eq a => NonEmpty a -> NonEmpty (NonEmpty a)
N.group1 (NonEmpty (BundledParseError [s])
 -> NonEmpty (NonEmpty (BundledParseError [s])))
-> (NonEmpty (BundledParseError [s])
    -> NonEmpty (BundledParseError [s]))
-> NonEmpty (BundledParseError [s])
-> NonEmpty (NonEmpty (BundledParseError [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (BundledParseError [s])
-> NonEmpty (BundledParseError [s])
forall a. Ord a => NonEmpty a -> NonEmpty a
N.sort) ([(WithLength [s], NonEmpty (BundledParseError [s]))]
 -> [(WithLength [s], NonEmpty (BundledParseError [s]))])
-> ([ParseError [s]]
    -> [(WithLength [s], NonEmpty (BundledParseError [s]))])
-> [ParseError [s]]
-> [(WithLength [s], NonEmpty (BundledParseError [s]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  -- [(WithLength [s], NonEmpty (BundledParseError [s]))]
  (((WithLength [s], NonEmpty (ParseError [s]))
 -> (WithLength [s], NonEmpty (BundledParseError [s])))
-> [(WithLength [s], NonEmpty (ParseError [s]))]
-> [(WithLength [s], NonEmpty (BundledParseError [s]))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((WithLength [s], NonEmpty (ParseError [s]))
  -> (WithLength [s], NonEmpty (BundledParseError [s])))
 -> [(WithLength [s], NonEmpty (ParseError [s]))]
 -> [(WithLength [s], NonEmpty (BundledParseError [s]))])
-> ((ParseError [s] -> BundledParseError [s])
    -> (WithLength [s], NonEmpty (ParseError [s]))
    -> (WithLength [s], NonEmpty (BundledParseError [s])))
-> (ParseError [s] -> BundledParseError [s])
-> [(WithLength [s], NonEmpty (ParseError [s]))]
-> [(WithLength [s], NonEmpty (BundledParseError [s]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (ParseError [s]) -> NonEmpty (BundledParseError [s]))
-> (WithLength [s], NonEmpty (ParseError [s]))
-> (WithLength [s], NonEmpty (BundledParseError [s]))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((NonEmpty (ParseError [s]) -> NonEmpty (BundledParseError [s]))
 -> (WithLength [s], NonEmpty (ParseError [s]))
 -> (WithLength [s], NonEmpty (BundledParseError [s])))
-> ((ParseError [s] -> BundledParseError [s])
    -> NonEmpty (ParseError [s]) -> NonEmpty (BundledParseError [s]))
-> (ParseError [s] -> BundledParseError [s])
-> (WithLength [s], NonEmpty (ParseError [s]))
-> (WithLength [s], NonEmpty (BundledParseError [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseError [s] -> BundledParseError [s])
-> NonEmpty (ParseError [s]) -> NonEmpty (BundledParseError [s])
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ParseError [s] -> BundledParseError [s]
forall symbols. ParseError symbols -> BundledParseError symbols
toBundled ([(WithLength [s], NonEmpty (ParseError [s]))]
 -> [(WithLength [s], NonEmpty (BundledParseError [s]))])
-> ([ParseError [s]]
    -> [(WithLength [s], NonEmpty (ParseError [s]))])
-> [ParseError [s]]
-> [(WithLength [s], NonEmpty (BundledParseError [s]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  -- [(WithLength [s], NonEmpty (ParseError [s]))]
  ((Int, NonEmpty (ParseError [s]))
 -> (WithLength [s], NonEmpty (ParseError [s])))
-> [(Int, NonEmpty (ParseError [s]))]
-> [(WithLength [s], NonEmpty (ParseError [s]))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
n, es :: NonEmpty (ParseError [s])
es@(ParseError [s]
h :| [ParseError [s]]
_)) -> ([s] -> Int -> WithLength [s]
forall a. a -> Int -> WithLength a
WithLength (ParseError [s] -> [s]
forall symbols. ParseError symbols -> symbols
inputRestGet ParseError [s]
h) Int
n, NonEmpty (ParseError [s])
es)) ([(Int, NonEmpty (ParseError [s]))]
 -> [(WithLength [s], NonEmpty (ParseError [s]))])
-> ([ParseError [s]] -> [(Int, NonEmpty (ParseError [s]))])
-> [ParseError [s]]
-> [(WithLength [s], NonEmpty (ParseError [s]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  -- [(Int, NonEmpty (ParseError [s]))]
  (ParseError [s] -> Int)
-> [ParseError [s]] -> [(Int, NonEmpty (ParseError [s]))]
forall b a. Ord b => (a -> b) -> [a] -> [(b, NonEmpty a)]
groupWithKey ([s] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([s] -> Int) -> (ParseError [s] -> [s]) -> ParseError [s] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError [s] -> [s]
forall symbols. ParseError symbols -> symbols
inputRestGet)
  -- [ParseError [s]]

-- * utilities

toMegaparsecBundle ::
  (Ord s) =>
  [s] -> ParseErrorBundle [s] -> Maybe (M.ParseErrorBundle [s] Void)
toMegaparsecBundle :: forall s.
Ord s =>
[s] -> ParseErrorBundle [s] -> Maybe (ParseErrorBundle [s] Void)
toMegaparsecBundle [s]
input (ParseErrorBundle [(WithLength [s], NonEmpty (BundledParseError [s]))]
bundle) =
  (NonEmpty (ParseError [s] Void)
 -> PosState [s] -> ParseErrorBundle [s] Void)
-> PosState [s]
-> NonEmpty (ParseError [s] Void)
-> ParseErrorBundle [s] Void
forall a b c. (a -> b -> c) -> b -> a -> c
flip NonEmpty (ParseError [s] Void)
-> PosState [s] -> ParseErrorBundle [s] Void
forall s e.
NonEmpty (ParseError s e) -> PosState s -> ParseErrorBundle s e
M.ParseErrorBundle
    ([s] -> Int -> SourcePos -> Pos -> String -> PosState [s]
forall s. s -> Int -> SourcePos -> Pos -> String -> PosState s
PosState
      [s]
input
      Int
0
      (String -> Pos -> Pos -> SourcePos
SourcePos String
"input" (Int -> Pos
mkPos Int
1) (Int -> Pos
mkPos Int
1))
      (Int -> Pos
mkPos Int
4)
      String
""
    )
    (NonEmpty (ParseError [s] Void) -> ParseErrorBundle [s] Void)
-> Maybe (NonEmpty (ParseError [s] Void))
-> Maybe (ParseErrorBundle [s] Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([ParseError [s] Void] -> Maybe (NonEmpty (ParseError [s] Void))
forall a. [a] -> Maybe (NonEmpty a)
N.nonEmpty ([ParseError [s] Void] -> Maybe (NonEmpty (ParseError [s] Void)))
-> [ParseError [s] Void] -> Maybe (NonEmpty (ParseError [s] Void))
forall a b. (a -> b) -> a -> b
$ ((WithLength [s], NonEmpty (BundledParseError [s]))
 -> [ParseError [s] Void])
-> [(WithLength [s], NonEmpty (BundledParseError [s]))]
-> [ParseError [s] Void]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int
-> (WithLength [s], NonEmpty (BundledParseError [s]))
-> [ParseError [s] Void]
forall s.
Ord s =>
Int
-> (WithLength [s], NonEmpty (BundledParseError [s]))
-> [ParseError [s] Void]
toMegaparsecBundled (Int
 -> (WithLength [s], NonEmpty (BundledParseError [s]))
 -> [ParseError [s] Void])
-> Int
-> (WithLength [s], NonEmpty (BundledParseError [s]))
-> [ParseError [s] Void]
forall a b. (a -> b) -> a -> b
$ [s] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [s]
input) ([(WithLength [s], NonEmpty (BundledParseError [s]))]
 -> [ParseError [s] Void])
-> [(WithLength [s], NonEmpty (BundledParseError [s]))]
-> [ParseError [s] Void]
forall a b. (a -> b) -> a -> b
$ [(WithLength [s], NonEmpty (BundledParseError [s]))]
bundle)

toMegaparsecBundled ::
  (Ord s) =>
  Int ->
  (WithLength [s], NonEmpty (BundledParseError [s])) ->
  [M.ParseError [s] Void]
toMegaparsecBundled :: forall s.
Ord s =>
Int
-> (WithLength [s], NonEmpty (BundledParseError [s]))
-> [ParseError [s] Void]
toMegaparsecBundled Int
inputLength (WithLength [s]
inputRest Int
inputRestLength, NonEmpty (BundledParseError [s])
errors) =
  (if [[s]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[s]]
trivialErrors
    then [ParseError [s] Void] -> [ParseError [s] Void]
forall a. a -> a
id
    else
      (:)
        (Int
-> Maybe (ErrorItem (Token [s]))
-> Set (ErrorItem (Token [s]))
-> ParseError [s] Void
forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
M.TrivialError
          Int
position
          (ErrorItem (Token [s]) -> Maybe (ErrorItem (Token [s]))
forall a. a -> Maybe a
Just (ErrorItem (Token [s]) -> Maybe (ErrorItem (Token [s])))
-> ErrorItem (Token [s]) -> Maybe (ErrorItem (Token [s]))
forall a b. (a -> b) -> a -> b
$ [s] -> ErrorItem (Token [s])
forall s. [s] -> ErrorItem (Token [s])
toErrorItem ([s] -> ErrorItem (Token [s])) -> [s] -> ErrorItem (Token [s])
forall a b. (a -> b) -> a -> b
$ Int -> [s] -> [s]
forall a. Int -> [a] -> [a]
take ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ ([s] -> Int) -> [[s]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [s] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[s]] -> [Int]) -> [[s]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[s]]
trivialErrors) ([s] -> [s]) -> [s] -> [s]
forall a b. (a -> b) -> a -> b
$ [s]
inputRest)
          ([ErrorItem (Token [s])] -> Set (ErrorItem (Token [s]))
forall a. Ord a => [a] -> Set a
S.fromList ([ErrorItem (Token [s])] -> Set (ErrorItem (Token [s])))
-> [ErrorItem (Token [s])] -> Set (ErrorItem (Token [s]))
forall a b. (a -> b) -> a -> b
$ ([s] -> ErrorItem (Token [s])) -> [[s]] -> [ErrorItem (Token [s])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [s] -> ErrorItem (Token [s])
forall s. [s] -> ErrorItem (Token [s])
toErrorItem ([[s]] -> [ErrorItem (Token [s])])
-> [[s]] -> [ErrorItem (Token [s])]
forall a b. (a -> b) -> a -> b
$ [[s]]
trivialErrors)
        )
  ) ([ParseError [s] Void] -> [ParseError [s] Void])
-> [ParseError [s] Void] -> [ParseError [s] Void]
forall a b. (a -> b) -> a -> b
$
  (if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
fancyErrors
    then [ParseError [s] Void] -> [ParseError [s] Void]
forall a. a -> a
id
    else (:) (Int -> Set (ErrorFancy Void) -> ParseError [s] Void
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
M.FancyError Int
position (Set (ErrorFancy Void) -> ParseError [s] Void)
-> Set (ErrorFancy Void) -> ParseError [s] Void
forall a b. (a -> b) -> a -> b
$ [ErrorFancy Void] -> Set (ErrorFancy Void)
forall a. Ord a => [a] -> Set a
S.fromList ([ErrorFancy Void] -> Set (ErrorFancy Void))
-> [ErrorFancy Void] -> Set (ErrorFancy Void)
forall a b. (a -> b) -> a -> b
$ (String -> ErrorFancy Void) -> [String] -> [ErrorFancy Void]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ErrorFancy Void
forall e. String -> ErrorFancy e
ErrorFail ([String] -> [ErrorFancy Void]) -> [String] -> [ErrorFancy Void]
forall a b. (a -> b) -> a -> b
$ [String]
fancyErrors)
  ) ([ParseError [s] Void] -> [ParseError [s] Void])
-> [ParseError [s] Void] -> [ParseError [s] Void]
forall a b. (a -> b) -> a -> b
$
  []
  where
    fancyErrors :: [String]
    ([String]
fancyErrors, [[s]]
trivialErrors) =
      -- ([String], [[s]])
      [Either String [s]] -> ([String], [[s]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either String [s]] -> ([String], [[s]]))
-> [Either String [s]] -> ([String], [[s]])
forall a b. (a -> b) -> a -> b
$
      -- [Either String [s]]
      NonEmpty (Either String [s]) -> [Either String [s]]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (Either String [s]) -> [Either String [s]])
-> NonEmpty (Either String [s]) -> [Either String [s]]
forall a b. (a -> b) -> a -> b
$
      -- NonEmpty (Either String [s])
      (BundledParseError [s] -> Either String [s])
-> NonEmpty (BundledParseError [s]) -> NonEmpty (Either String [s])
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (\case
          BundledParseError [s]
expected -> [s] -> Either String [s]
forall a b. b -> Either a b
Right [s]
expected
          BundledFail String
message -> String -> Either String [s]
forall a b. a -> Either a b
Left String
message
        ) (NonEmpty (BundledParseError [s]) -> NonEmpty (Either String [s]))
-> NonEmpty (BundledParseError [s]) -> NonEmpty (Either String [s])
forall a b. (a -> b) -> a -> b
$
      -- NonEmpty (BundledParseError [s])
      NonEmpty (BundledParseError [s])
errors
    position :: Int
    position :: Int
position = Int
inputLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
inputRestLength

toErrorItem :: [s] -> ErrorItem (Token [s])
toErrorItem :: forall s. [s] -> ErrorItem (Token [s])
toErrorItem (s
c : [s]
cs) = NonEmpty s -> ErrorItem s
forall t. NonEmpty t -> ErrorItem t
Tokens (s
c s -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:| [s]
cs)
toErrorItem [s]
_ = ErrorItem s
ErrorItem (Token [s])
forall t. ErrorItem t
EndOfInput

toBundled :: ParseError symbols -> BundledParseError symbols
toBundled :: forall symbols. ParseError symbols -> BundledParseError symbols
toBundled (ParseError symbols
expected symbols
_actual) = symbols -> BundledParseError symbols
forall symbols. symbols -> BundledParseError symbols
BundledParseError symbols
expected
toBundled (Fail String
expected symbols
_actual) = String -> BundledParseError symbols
forall symbols. String -> BundledParseError symbols
BundledFail String
expected

inputRestGet :: ParseError symbols -> symbols
inputRestGet :: forall symbols. ParseError symbols -> symbols
inputRestGet (ParseError symbols
_ symbols
input) = symbols
input
inputRestGet (Fail String
_ symbols
input) = symbols
input

groupWithKey :: (Ord b) => (a -> b) -> [a] -> [(b, NonEmpty a)]
groupWithKey :: forall b a. Ord b => (a -> b) -> [a] -> [(b, NonEmpty a)]
groupWithKey a -> b
f =
  -- [(b, NonEmpty a)]
  (((b, NonEmpty (b, a)) -> (b, NonEmpty a))
-> [(b, NonEmpty (b, a))] -> [(b, NonEmpty a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((b, NonEmpty (b, a)) -> (b, NonEmpty a))
 -> [(b, NonEmpty (b, a))] -> [(b, NonEmpty a)])
-> (((b, a) -> a) -> (b, NonEmpty (b, a)) -> (b, NonEmpty a))
-> ((b, a) -> a)
-> [(b, NonEmpty (b, a))]
-> [(b, NonEmpty a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (b, a) -> NonEmpty a)
-> (b, NonEmpty (b, a)) -> (b, NonEmpty a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((NonEmpty (b, a) -> NonEmpty a)
 -> (b, NonEmpty (b, a)) -> (b, NonEmpty a))
-> (((b, a) -> a) -> NonEmpty (b, a) -> NonEmpty a)
-> ((b, a) -> a)
-> (b, NonEmpty (b, a))
-> (b, NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a) -> a) -> NonEmpty (b, a) -> NonEmpty a
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (b, a) -> a
forall a b. (a, b) -> b
snd ([(b, NonEmpty (b, a))] -> [(b, NonEmpty a)])
-> ([a] -> [(b, NonEmpty (b, a))]) -> [a] -> [(b, NonEmpty a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  -- [(b, NonEmpty (b, a))]
  (NonEmpty (b, a) -> (b, NonEmpty (b, a)))
-> [NonEmpty (b, a)] -> [(b, NonEmpty (b, a))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\g :: NonEmpty (b, a)
g@((b, a)
h :| [(b, a)]
_) -> ((b, a) -> b
forall a b. (a, b) -> a
fst (b, a)
h, NonEmpty (b, a)
g)) ([NonEmpty (b, a)] -> [(b, NonEmpty (b, a))])
-> ([a] -> [NonEmpty (b, a)]) -> [a] -> [(b, NonEmpty (b, a))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. -- to do. inelegant ("redundant work")
  -- [NonEmpty (b, a)]
  ((b, a) -> b) -> [(b, a)] -> [NonEmpty (b, a)]
forall (f :: * -> *) b a.
(Foldable f, Eq b) =>
(a -> b) -> f a -> [NonEmpty a]
N.groupWith (b, a) -> b
forall a b. (a, b) -> a
fst ([(b, a)] -> [NonEmpty (b, a)])
-> ([a] -> [(b, a)]) -> [a] -> [NonEmpty (b, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  -- [(b, a)]
  ((b, a) -> b) -> [(b, a)] -> [(b, a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (b, a) -> b
forall a b. (a, b) -> a
fst ([(b, a)] -> [(b, a)]) -> ([a] -> [(b, a)]) -> [a] -> [(b, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  -- [(b, a)]
  (a -> (b, a)) -> [a] -> [(b, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a -> b
f a
a, a
a))
  -- [a]