{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE DerivingVia, OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-missing-import-lists #-}
{-|
Module      : Text.Gigaparsec.Errors.DefaultErrorBuilder
Description : This module defines Gigaparsec's default error messages.
License     : BSD-3-Clause
Maintainer  : Jamie Willis, Gigaparsec Maintainers
Stability   : stable

This module defines Gigaparsec's default error messages.
The actual 'Text.Gigaparsec.Errors.ErrorBuilder.ErrorBuilder' class instance is found in 
"Text.Gigaparsec.Errors.ErrorBuilder".

-}
module Text.Gigaparsec.Errors.DefaultErrorBuilder (module Text.Gigaparsec.Errors.DefaultErrorBuilder) where

import Prelude hiding (lines)

import Data.Monoid (Endo(Endo))
import Data.String (IsString(fromString))
import Data.List (intersperse, sortBy)
import Data.Maybe (mapMaybe)
import Data.Foldable (toList)
import Data.Ord (comparing, Down (Down))

-- For now, this is the home of the default formatting functions

-- | A string-builder is an efficient way of constructing a string through a series of concatenations.
type StringBuilder :: *
newtype StringBuilder = StringBuilder (String -> String)
  deriving (NonEmpty StringBuilder -> StringBuilder
StringBuilder -> StringBuilder -> StringBuilder
(StringBuilder -> StringBuilder -> StringBuilder)
-> (NonEmpty StringBuilder -> StringBuilder)
-> (forall b. Integral b => b -> StringBuilder -> StringBuilder)
-> Semigroup StringBuilder
forall b. Integral b => b -> StringBuilder -> StringBuilder
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: StringBuilder -> StringBuilder -> StringBuilder
<> :: StringBuilder -> StringBuilder -> StringBuilder
$csconcat :: NonEmpty StringBuilder -> StringBuilder
sconcat :: NonEmpty StringBuilder -> StringBuilder
$cstimes :: forall b. Integral b => b -> StringBuilder -> StringBuilder
stimes :: forall b. Integral b => b -> StringBuilder -> StringBuilder
Semigroup, Semigroup StringBuilder
StringBuilder
Semigroup StringBuilder =>
StringBuilder
-> (StringBuilder -> StringBuilder -> StringBuilder)
-> ([StringBuilder] -> StringBuilder)
-> Monoid StringBuilder
[StringBuilder] -> StringBuilder
StringBuilder -> StringBuilder -> StringBuilder
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: StringBuilder
mempty :: StringBuilder
$cmappend :: StringBuilder -> StringBuilder -> StringBuilder
mappend :: StringBuilder -> StringBuilder -> StringBuilder
$cmconcat :: [StringBuilder] -> StringBuilder
mconcat :: [StringBuilder] -> StringBuilder
Monoid) via Endo String

instance IsString StringBuilder where
  {-# INLINE fromString #-}
  fromString :: String -> StringBuilder
  fromString :: [Char] -> StringBuilder
fromString [Char]
str = ([Char] -> [Char]) -> StringBuilder
StringBuilder ([Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)

{-# INLINE toString #-}
-- | Runs the given string-builder, producing a string.
toString :: StringBuilder -> String
toString :: StringBuilder -> [Char]
toString (StringBuilder [Char] -> [Char]
build) = [Char] -> [Char]
build [Char]
forall a. Monoid a => a
mempty

{-# INLINE from #-}
-- | Create a string-builder which starts with the string representation of the given argument.
from :: Show a => a -> StringBuilder
from :: forall a. Show a => a -> StringBuilder
from = ([Char] -> [Char]) -> StringBuilder
StringBuilder (([Char] -> [Char]) -> StringBuilder)
-> (a -> [Char] -> [Char]) -> a -> StringBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows

{-|
Forms an error message with 'blockError', with two spaces of indentation and incorporating 
the source file and position into the header.
-}
{-# INLINABLE buildDefault #-}
buildDefault :: StringBuilder -> Maybe StringBuilder -> [StringBuilder] -> String
buildDefault :: StringBuilder -> Maybe StringBuilder -> [StringBuilder] -> [Char]
buildDefault StringBuilder
pos Maybe StringBuilder
source [StringBuilder]
lines = StringBuilder -> [Char]
toString (StringBuilder -> [StringBuilder] -> Int -> StringBuilder
blockError StringBuilder
header [StringBuilder]
lines Int
2)
  where header :: StringBuilder
header = StringBuilder
-> (StringBuilder -> StringBuilder)
-> Maybe StringBuilder
-> StringBuilder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StringBuilder
forall a. Monoid a => a
mempty (\StringBuilder
src -> StringBuilder
"In " StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
src StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
" ") Maybe StringBuilder
source StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
pos

{-|
Forms a vanilla error by combining all the components in sequence, if there is no information other than the lines,
"unknown parse error" is used instead.
-}
{-# INLINABLE vanillaErrorDefault #-}
vanillaErrorDefault :: Foldable t => Maybe StringBuilder -> Maybe StringBuilder -> t StringBuilder -> [StringBuilder] -> [StringBuilder]
vanillaErrorDefault :: forall (t :: * -> *).
Foldable t =>
Maybe StringBuilder
-> Maybe StringBuilder
-> t StringBuilder
-> [StringBuilder]
-> [StringBuilder]
vanillaErrorDefault Maybe StringBuilder
unexpected Maybe StringBuilder
expected t StringBuilder
reasons =
  [StringBuilder] -> [StringBuilder] -> [StringBuilder]
combineInfoWithLines (([StringBuilder] -> [StringBuilder])
-> (StringBuilder -> [StringBuilder] -> [StringBuilder])
-> Maybe StringBuilder
-> [StringBuilder]
-> [StringBuilder]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [StringBuilder] -> [StringBuilder]
forall a. a -> a
id (:) Maybe StringBuilder
unexpected (([StringBuilder] -> [StringBuilder])
-> (StringBuilder -> [StringBuilder] -> [StringBuilder])
-> Maybe StringBuilder
-> [StringBuilder]
-> [StringBuilder]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [StringBuilder] -> [StringBuilder]
forall a. a -> a
id (:) Maybe StringBuilder
expected (t StringBuilder -> [StringBuilder]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t StringBuilder
reasons)))

{-|
Forms a specialized error by combining all components in sequence, if there are no msgs, then "unknown parse error" is used instead.
-}
{-# INLINABLE specialisedErrorDefault #-}
specialisedErrorDefault :: [StringBuilder] -> [StringBuilder] -> [StringBuilder]
specialisedErrorDefault :: [StringBuilder] -> [StringBuilder] -> [StringBuilder]
specialisedErrorDefault = [StringBuilder] -> [StringBuilder] -> [StringBuilder]
combineInfoWithLines

{-|
Joins together the given sequences: if the first is empty, then "unknown parse error" is prepended onto lines instead.
-}
{-# INLINABLE combineInfoWithLines #-}
combineInfoWithLines :: [StringBuilder] -> [StringBuilder] -> [StringBuilder]
combineInfoWithLines :: [StringBuilder] -> [StringBuilder] -> [StringBuilder]
combineInfoWithLines [] [StringBuilder]
lines = StringBuilder
"unknown parse error" StringBuilder -> [StringBuilder] -> [StringBuilder]
forall a. a -> [a] -> [a]
: [StringBuilder]
lines
combineInfoWithLines [StringBuilder]
info [StringBuilder]
lines = [StringBuilder]
info [StringBuilder] -> [StringBuilder] -> [StringBuilder]
forall a. [a] -> [a] -> [a]
++ [StringBuilder]
lines

{-|
Encloses the item in double-quotes.
-}
--TODO: this needs to deal with whitespace and unprintables
{-
If the given item is either a whitespace character or is otherwise "unprintable", 
a special name is given to it, otherwise the item is enclosed in double-quotes.
-}
{-# INLINABLE rawDefault #-}
rawDefault :: String -> String
rawDefault :: [Char] -> [Char]
rawDefault [Char]
n = [Char]
"\"" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
n [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\""

-- | Returns the given name unchanged.
{-# INLINABLE namedDefault #-}
namedDefault :: String -> String
namedDefault :: [Char] -> [Char]
namedDefault = [Char] -> [Char]
forall a. a -> a
id

-- | Simply displays "end of input"
{-# INLINABLE endOfInputDefault #-}
endOfInputDefault :: String
endOfInputDefault :: [Char]
endOfInputDefault = [Char]
"end of input"

-- | Returns the given message unchanged.
{-# INLINABLE messageDefault #-}
messageDefault :: String -> String
messageDefault :: [Char] -> [Char]
messageDefault = [Char] -> [Char]
forall a. a -> a
id

-- | Adds "expected " before the given alternatives, should they exist.
{-# INLINABLE expectedDefault #-}
expectedDefault :: Maybe StringBuilder -> Maybe StringBuilder
expectedDefault :: Maybe StringBuilder -> Maybe StringBuilder
expectedDefault = (StringBuilder -> StringBuilder)
-> Maybe StringBuilder -> Maybe StringBuilder
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StringBuilder
"expected " StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<>)

-- | Adds "unexpected " before the unexpected item.
{-# INLINABLE unexpectedDefault #-}
unexpectedDefault :: Maybe String -> Maybe StringBuilder
unexpectedDefault :: Maybe [Char] -> Maybe StringBuilder
unexpectedDefault = ([Char] -> StringBuilder) -> Maybe [Char] -> Maybe StringBuilder
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((StringBuilder
"unexpected " StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<>) (StringBuilder -> StringBuilder)
-> ([Char] -> StringBuilder) -> [Char] -> StringBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString)

{-|
Combines the alternatives, separated by commas/semicolons, with the final two separated by "or". 
If the elements contain a comma, then semicolon is used as the list separator.
-}
{-# INLINABLE disjunct #-}
disjunct :: Bool -> [String] -> Maybe StringBuilder
disjunct :: Bool -> [[Char]] -> Maybe StringBuilder
disjunct Bool
oxford [[Char]]
elems = Bool -> [[Char]] -> [Char] -> Maybe StringBuilder
junct Bool
oxford [[Char]]
elems [Char]
"or"

{-|
Combines the alternatives, separated by commas/semicolons, with the final two separated by "or". 
An Oxford comma is added if there are more than two elements, as this helps prevent ambiguity in the list. 
If the elements contain a comma, then semicolon is used as the list separator.
-}
{-# INLINABLE junct #-}
junct :: Bool -> [String] -> String -> Maybe StringBuilder
junct :: Bool -> [[Char]] -> [Char] -> Maybe StringBuilder
junct Bool
oxford [[Char]]
elems [Char]
junction = [[Char]] -> Maybe StringBuilder
junct' (([Char] -> [Char] -> Ordering) -> [[Char]] -> [[Char]]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (([Char] -> Down [Char]) -> [Char] -> [Char] -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing [Char] -> Down [Char]
forall a. a -> Down a
Down) [[Char]]
elems)
  where
    j :: StringBuilder
    j :: StringBuilder
j = [Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString [Char]
junction

    junct' :: [[Char]] -> Maybe StringBuilder
junct' [] = Maybe StringBuilder
forall a. Maybe a
Nothing
    junct' [[Char]
alt] = StringBuilder -> Maybe StringBuilder
forall a. a -> Maybe a
Just ([Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString [Char]
alt)
    junct' [[Char]
alt1, [Char]
alt2] = StringBuilder -> Maybe StringBuilder
forall a. a -> Maybe a
Just ([Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString [Char]
alt2 StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
" " StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> [Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString [Char]
junction StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
" " StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> [Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString [Char]
alt1)
    junct' as :: [[Char]]
as@([Char]
alt:[[Char]]
alts)
      -- use a semi-colon here, it is more correct
      | ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
',') [[Char]]
as = StringBuilder -> Maybe StringBuilder
forall a. a -> Maybe a
Just ([[Char]] -> [Char] -> [Char] -> StringBuilder
junct'' ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
alts) [Char]
alt [Char]
"; ")
      | Bool
otherwise         = StringBuilder -> Maybe StringBuilder
forall a. a -> Maybe a
Just ([[Char]] -> [Char] -> [Char] -> StringBuilder
junct'' ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
alts) [Char]
alt [Char]
", ")

    junct'' :: [[Char]] -> [Char] -> [Char] -> StringBuilder
junct'' [[Char]]
is [Char]
l [Char]
delim = StringBuilder
front StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
back
      where front :: StringBuilder
front = StringBuilder -> [StringBuilder] -> StringBuilder
forall m. Monoid m => m -> [m] -> m
intercalate ([Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString [Char]
delim) (([Char] -> StringBuilder) -> [[Char]] -> [StringBuilder]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString [[Char]]
is) :: StringBuilder
            back :: StringBuilder
back
              | Bool
oxford    = [Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString [Char]
delim StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
j StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
" " StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> [Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString [Char]
l
              | Bool
otherwise = StringBuilder
" " StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
j StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
" " StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> [Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString [Char]
l

{-|
Filters out any empty messages and returns the rest.
-}
{-# INLINABLE combineMessagesDefault #-}
combineMessagesDefault :: Foldable t => t String -> [StringBuilder]
combineMessagesDefault :: forall (t :: * -> *). Foldable t => t [Char] -> [StringBuilder]
combineMessagesDefault = ([Char] -> Maybe StringBuilder) -> [[Char]] -> [StringBuilder]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\[Char]
msg -> if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
msg then Maybe StringBuilder
forall a. Maybe a
Nothing else StringBuilder -> Maybe StringBuilder
forall a. a -> Maybe a
Just ([Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString [Char]
msg)) ([[Char]] -> [StringBuilder])
-> (t [Char] -> [[Char]]) -> t [Char] -> [StringBuilder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t [Char] -> [[Char]]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

{-|
Forms an error with the given header followed by a colon, a newline, then the remainder of the lines indented.
-}
{-# INLINABLE blockError #-}
blockError :: StringBuilder -> [StringBuilder] -> Int -> StringBuilder
blockError :: StringBuilder -> [StringBuilder] -> Int -> StringBuilder
blockError StringBuilder
header [StringBuilder]
lines Int
indent = StringBuilder
header StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
":\n" StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> [StringBuilder] -> Int -> StringBuilder
indentAndUnlines [StringBuilder]
lines Int
indent

{-|
Indents and concatenates the given lines by the given depth.
-}
{-# INLINABLE indentAndUnlines #-}
indentAndUnlines :: [StringBuilder] -> Int -> StringBuilder
indentAndUnlines :: [StringBuilder] -> Int -> StringBuilder
indentAndUnlines [StringBuilder]
lines Int
indent = [Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString [Char]
pre StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder -> [StringBuilder] -> StringBuilder
forall m. Monoid m => m -> [m] -> m
intercalate ([Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString (Char
'\n' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
pre)) [StringBuilder]
lines
  where pre :: [Char]
pre = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
indent Char
' '

{-|
Constructs error context by concatenating them together with a "caret line" 
underneath the focus line, line, where the error occurs.
-}
{-# INLINABLE lineInfoDefault #-}
lineInfoDefault :: String -> [String] -> [String] -> Word -> Word -> Word -> [StringBuilder]
lineInfoDefault :: [Char]
-> [[Char]] -> [[Char]] -> Word -> Word -> Word -> [StringBuilder]
lineInfoDefault [Char]
curLine [[Char]]
beforeLines [[Char]]
afterLines Word
_line Word
pointsAt Word
width =
  [[StringBuilder]] -> [StringBuilder]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [([Char] -> StringBuilder) -> [[Char]] -> [StringBuilder]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> StringBuilder
inputLine [[Char]]
beforeLines, [[Char] -> StringBuilder
inputLine [Char]
curLine, StringBuilder
caretLine], ([Char] -> StringBuilder) -> [[Char]] -> [StringBuilder]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> StringBuilder
inputLine [[Char]]
afterLines]
  where inputLine :: String -> StringBuilder
        inputLine :: [Char] -> StringBuilder
inputLine = [Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString ([Char] -> StringBuilder)
-> ([Char] -> [Char]) -> [Char] -> StringBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'>' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)
        caretLine :: StringBuilder
        caretLine :: StringBuilder
caretLine = [Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
pointsAt Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)) Char
' ') StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> [Char] -> StringBuilder
forall a. IsString a => [Char] -> a
fromString (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
width) Char
'^')

{-|
Pairs the line and column up in the form @(line m, column n)@.
-}
{-# INLINABLE posDefault #-}
posDefault :: Word -> Word -> StringBuilder
posDefault :: Word -> Word -> StringBuilder
posDefault Word
line Word
col = StringBuilder
"(line "
                   StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> StringBuilder
forall a. Show a => a -> StringBuilder
from Word
line
                   StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
", column "
                   StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> StringBuilder
forall a. Show a => a -> StringBuilder
from Word
col
                   StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder
")"

{-# INLINABLE intercalate #-}
intercalate :: Monoid m => m -> [m] -> m
intercalate :: forall m. Monoid m => m -> [m] -> m
intercalate m
x [m]
xs = [m] -> m
forall a. Monoid a => [a] -> a
mconcat (m -> [m] -> [m]
forall a. a -> [a] -> [a]
intersperse m
x [m]
xs)