{-# LANGUAGE Safe #-}
{-# OPTIONS_HADDOCK hide #-}
{-# OPTIONS_GHC -Wno-partial-fields -Wno-missing-import-lists #-}
module Text.Gigaparsec.Internal.Errors.ParseError (
    module Text.Gigaparsec.Internal.Errors.ParseError
  ) where

import Prelude hiding (lines)

import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty, (<|))
import Data.Set qualified as Set (map, foldr)

import Text.Gigaparsec.Errors.ErrorBuilder (ErrorBuilder, Token)
import Text.Gigaparsec.Errors.ErrorBuilder qualified as Builder (ErrorBuilder(..))
import Text.Gigaparsec.Errors.ErrorBuilder qualified as Token (Token(..))

import Text.Gigaparsec.Internal.Errors.CaretControl
import Text.Gigaparsec.Internal.Errors.ErrorItem

import Data.Set (Set)

type ParseError :: *
data ParseError = VanillaError { ParseError -> Word
presentationOffset :: {-# UNPACK #-} !Word
                               , ParseError -> Word
line :: {-# UNPACK #-} !Word
                               , ParseError -> Word
col :: {-# UNPACK #-} !Word
                               , ParseError -> Either Word UnexpectItem
unexpected :: !(Either Word UnexpectItem)
                               , ParseError -> Set ExpectItem
expecteds :: !(Set ExpectItem)
                               , ParseError -> Set String
reasons :: !(Set String)
                               , ParseError -> Bool
lexicalError :: !Bool
                               }
                | SpecialisedError { presentationOffset :: {-# UNPACK #-} !Word
                                   , line :: {-# UNPACK #-} !Word
                                   , col :: {-# UNPACK #-} !Word
                                   , ParseError -> [String]
msgs :: ![String]
                                   , ParseError -> Word
caretWidth :: {-# UNPACK #-} !Span
                                   }

{-# INLINABLE fromParseError #-}
fromParseError :: forall err. ErrorBuilder err => Maybe FilePath -> String -> ParseError -> err
fromParseError :: forall err.
ErrorBuilder err =>
Maybe String -> String -> ParseError -> err
fromParseError Maybe String
srcFile String
input ParseError
err =
  Position err -> Source err -> ErrorInfoLines err -> err
forall err.
ErrorBuilder err =>
Position err -> Source err -> ErrorInfoLines err -> err
Builder.build (forall err. ErrorBuilder err => Word -> Word -> Position err
Builder.pos @err (ParseError -> Word
line ParseError
err) (ParseError -> Word
col ParseError
err)) (forall err. ErrorBuilder err => Maybe String -> Source err
Builder.source @err Maybe String
srcFile) (ParseError -> ErrorInfoLines err
buildErr ParseError
err)
  where buildErr :: ParseError -> Builder.ErrorInfoLines err
        buildErr :: ParseError -> ErrorInfoLines err
buildErr VanillaError{Bool
Word
Either Word UnexpectItem
Set String
Set ExpectItem
presentationOffset :: ParseError -> Word
line :: ParseError -> Word
col :: ParseError -> Word
unexpected :: ParseError -> Either Word UnexpectItem
expecteds :: ParseError -> Set ExpectItem
reasons :: ParseError -> Set String
lexicalError :: ParseError -> Bool
presentationOffset :: Word
line :: Word
col :: Word
unexpected :: Either Word UnexpectItem
expecteds :: Set ExpectItem
reasons :: Set String
lexicalError :: Bool
..} =
          forall err.
ErrorBuilder err =>
UnexpectedLine err
-> ExpectedLine err
-> Messages err
-> LineInfo err
-> ErrorInfoLines err
Builder.vanillaError @err
            (forall err.
ErrorBuilder err =>
Maybe (Item err) -> UnexpectedLine err
Builder.unexpected @err ((Word -> Maybe (Item err))
-> ((Item err, Word) -> Maybe (Item err))
-> Either Word (Item err, Word)
-> Maybe (Item err)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Item err) -> Word -> Maybe (Item err)
forall a b. a -> b -> a
const Maybe (Item err)
forall a. Maybe a
Nothing) (Item err -> Maybe (Item err)
forall a. a -> Maybe a
Just (Item err -> Maybe (Item err))
-> ((Item err, Word) -> Item err)
-> (Item err, Word)
-> Maybe (Item err)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Item err, Word) -> Item err
forall a b. (a, b) -> a
fst) Either Word (Item err, Word)
unexpectedTok))
            (forall err.
ErrorBuilder err =>
ExpectedItems err -> ExpectedLine err
Builder.expected @err (forall err. ErrorBuilder err => Set (Item err) -> ExpectedItems err
Builder.combineExpectedItems @err ((ExpectItem -> Item err) -> Set ExpectItem -> Set (Item err)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ExpectItem -> Item err
expectItem Set ExpectItem
expecteds)))
            (forall err. ErrorBuilder err => [Message err] -> Messages err
Builder.combineMessages @err ((String -> [Message err] -> [Message err])
-> [Message err] -> Set String -> [Message err]
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr (\String
r -> (forall err. ErrorBuilder err => String -> Message err
Builder.reason @err String
r Message err -> [Message err] -> [Message err]
forall a. a -> [a] -> [a]
:)) [] Set String
reasons))
            (forall err.
ErrorBuilder err =>
String
-> [String] -> [String] -> Word -> Word -> Word -> LineInfo err
Builder.lineInfo @err String
curLine [String]
linesBefore [String]
linesAfter Word
line Word
caret (Word -> Word
trimToLine Word
caretSize))
          where unexpectedTok :: Either Word (Item err, Word)
unexpectedTok = Bool -> UnexpectItem -> (Item err, Word)
unexpectItem Bool
lexicalError (UnexpectItem -> (Item err, Word))
-> Either Word UnexpectItem -> Either Word (Item err, Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Word UnexpectItem
unexpected
                caretSize :: Word
caretSize = (Word -> Word)
-> ((Item err, Word) -> Word)
-> Either Word (Item err, Word)
-> Word
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Word -> Word
forall a. a -> a
id (Item err, Word) -> Word
forall a b. (a, b) -> b
snd Either Word (Item err, Word)
unexpectedTok

        buildErr SpecialisedError{[String]
Word
presentationOffset :: ParseError -> Word
line :: ParseError -> Word
col :: ParseError -> Word
msgs :: ParseError -> [String]
caretWidth :: ParseError -> Word
presentationOffset :: Word
line :: Word
col :: Word
msgs :: [String]
caretWidth :: Word
..} =
          forall err.
ErrorBuilder err =>
Messages err -> LineInfo err -> ErrorInfoLines err
Builder.specialisedError @err
            (forall err. ErrorBuilder err => [Message err] -> Messages err
Builder.combineMessages @err ((String -> Message err) -> [String] -> [Message err]
forall a b. (a -> b) -> [a] -> [b]
map (forall err. ErrorBuilder err => String -> Message err
Builder.message @err) [String]
msgs))
            (forall err.
ErrorBuilder err =>
String
-> [String] -> [String] -> Word -> Word -> Word -> LineInfo err
Builder.lineInfo @err String
curLine [String]
linesBefore [String]
linesAfter Word
line Word
caret (Word -> Word
trimToLine Word
caretWidth))

        expectItem :: ExpectItem -> Builder.Item err
        expectItem :: ExpectItem -> Item err
expectItem (ExpectRaw String
t) = forall err. ErrorBuilder err => String -> Item err
Builder.raw @err String
t
        expectItem (ExpectNamed String
n) = forall err. ErrorBuilder err => String -> Item err
Builder.named @err String
n
        expectItem ExpectItem
ExpectEndOfInput = forall err. ErrorBuilder err => Item err
Builder.endOfInput @err

        unexpectItem :: Bool -> UnexpectItem -> (Builder.Item err, Span)
        unexpectItem :: Bool -> UnexpectItem -> (Item err, Word)
unexpectItem Bool
lexical (UnexpectRaw Input
cs Word
demanded) =
          case forall err. ErrorBuilder err => Input -> Word -> Bool -> Token
Builder.unexpectedToken @err Input
cs Word
demanded Bool
lexical of
            t :: Token
t@(Token.Raw String
tok) -> (forall err. ErrorBuilder err => String -> Item err
Builder.raw @err String
tok, Token -> Word
tokenSpan Token
t)
            Token.Named String
name Word
w -> (forall err. ErrorBuilder err => String -> Item err
Builder.named @err String
name, Word
w)
        unexpectItem Bool
_ (UnexpectNamed String
name CaretWidth
caretWidth) = (forall err. ErrorBuilder err => String -> Item err
Builder.named @err String
name, CaretWidth -> Word
width CaretWidth
caretWidth)
        unexpectItem Bool
_ UnexpectItem
UnexpectEndOfInput = (forall err. ErrorBuilder err => Item err
Builder.endOfInput @err, Word
1)

        -- it is definitely the case that there are at least `line` lines
        ([String]
allLinesBefore, String
curLine, [String]
allLinesAfter) = Word -> NonEmpty String -> ([String], String, [String])
breakLines (ParseError -> Word
line ParseError
err Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) (String -> NonEmpty String
lines String
input)
        linesBefore :: [String]
linesBefore = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
allLinesBefore Int -> Int -> Int
forall a. Num a => a -> a -> a
- forall err. ErrorBuilder err => Int
Builder.numLinesBefore @err) [String]
allLinesBefore
        linesAfter :: [String]
linesAfter = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take (forall err. ErrorBuilder err => Int
Builder.numLinesAfter @err) [String]
allLinesAfter

        caret :: Word
caret = ParseError -> Word
col ParseError
err Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
        trimToLine :: Word -> Word
trimToLine Word
width = Word -> Word -> Word
forall a. Ord a => a -> a -> a
min Word
width (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
curLine) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
caret Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)

        lines :: String -> NonEmpty String
        lines :: String -> NonEmpty String
lines [] = String
"" String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| []
        lines (Char
'\n':String
cs) = String
"" String -> NonEmpty String -> NonEmpty String
forall a. a -> NonEmpty a -> NonEmpty a
<| String -> NonEmpty String
lines String
cs
        lines (Char
c:String
cs) = let String
l :| [String]
ls = String -> NonEmpty String
lines String
cs in (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
l) String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [String]
ls

        breakLines :: Word -> NonEmpty String -> ([String], String, [String])
        breakLines :: Word -> NonEmpty String -> ([String], String, [String])
breakLines Word
0 (String
l :| [String]
ls) = ([], String
l, [String]
ls)
        breakLines Word
n (String
l :| [String]
ls) = case [String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [String]
ls of
          Maybe (NonEmpty String)
Nothing -> String -> ([String], String, [String])
forall a. HasCallStack => String -> a
error String
"the focus line is guaranteed to exist"
          Just NonEmpty String
ls' -> let ([String]
before, String
focus, [String]
after) = Word -> NonEmpty String -> ([String], String, [String])
breakLines (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) NonEmpty String
ls'
                      in (String
l String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
before, String
focus, [String]
after)

        tokenSpan :: Token -> Word
        tokenSpan :: Token -> Word
tokenSpan (Token.Raw String
cs) = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cs)
        tokenSpan (Token.Named String
_ Word
w) = Word
w