{-# 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 :: String -> StringBuilder
fromString String
str = (String -> String) -> StringBuilder
StringBuilder (String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++)

{-# INLINE toString #-}
-- | Runs the given string-builder, producing a string.
toString :: StringBuilder -> String
toString :: StringBuilder -> String
toString (StringBuilder String -> String
build) = String -> String
build String
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 = (String -> String) -> StringBuilder
StringBuilder ((String -> String) -> StringBuilder)
-> (a -> String -> String) -> a -> StringBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String -> String
forall a. Show a => a -> String -> String
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] -> String
buildDefault StringBuilder
pos Maybe StringBuilder
source [StringBuilder]
lines = StringBuilder -> String
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 :: String -> String
rawDefault String
n = String
"\"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\""

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

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

-- | Returns the given message unchanged.
{-# INLINABLE messageDefault #-}
messageDefault :: String -> String
messageDefault :: String -> String
messageDefault = String -> String
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 String -> Maybe StringBuilder
unexpectedDefault = (String -> StringBuilder) -> Maybe String -> 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)
-> (String -> StringBuilder) -> String -> StringBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringBuilder
forall a. IsString a => String -> 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 -> [String] -> Maybe StringBuilder
disjunct Bool
oxford [String]
elems = Bool -> [String] -> String -> Maybe StringBuilder
junct Bool
oxford [String]
elems String
"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 -> [String] -> String -> Maybe StringBuilder
junct Bool
oxford [String]
elems String
junction = [String] -> Maybe StringBuilder
junct' ((String -> String -> Ordering) -> [String] -> [String]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((String -> Down String) -> String -> String -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing String -> Down String
forall a. a -> Down a
Down) [String]
elems)
  where
    j :: StringBuilder
    j :: StringBuilder
j = String -> StringBuilder
forall a. IsString a => String -> a
fromString String
junction

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

    junct'' :: [String] -> String -> String -> StringBuilder
junct'' [String]
is String
l String
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 (String -> StringBuilder
forall a. IsString a => String -> a
fromString String
delim) ((String -> StringBuilder) -> [String] -> [StringBuilder]
forall a b. (a -> b) -> [a] -> [b]
map String -> StringBuilder
forall a. IsString a => String -> a
fromString [String]
is) :: StringBuilder
            back :: StringBuilder
back
              | Bool
oxford    = String -> StringBuilder
forall a. IsString a => String -> a
fromString String
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
<> String -> StringBuilder
forall a. IsString a => String -> a
fromString String
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
<> String -> StringBuilder
forall a. IsString a => String -> a
fromString String
l

{-|
Filters out any empty messages and returns the rest.
-}
{-# INLINABLE combineMessagesDefault #-}
combineMessagesDefault :: Foldable t => t String -> [StringBuilder]
combineMessagesDefault :: forall (t :: * -> *). Foldable t => t String -> [StringBuilder]
combineMessagesDefault = (String -> Maybe StringBuilder) -> [String] -> [StringBuilder]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\String
msg -> if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
msg then Maybe StringBuilder
forall a. Maybe a
Nothing else StringBuilder -> Maybe StringBuilder
forall a. a -> Maybe a
Just (String -> StringBuilder
forall a. IsString a => String -> a
fromString String
msg)) ([String] -> [StringBuilder])
-> (t String -> [String]) -> t String -> [StringBuilder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t String -> [String]
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 = String -> StringBuilder
forall a. IsString a => String -> a
fromString String
pre StringBuilder -> StringBuilder -> StringBuilder
forall a. Semigroup a => a -> a -> a
<> StringBuilder -> [StringBuilder] -> StringBuilder
forall m. Monoid m => m -> [m] -> m
intercalate (String -> StringBuilder
forall a. IsString a => String -> a
fromString (Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String
pre)) [StringBuilder]
lines
  where pre :: String
pre = Int -> Char -> String
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 :: String
-> [String] -> [String] -> Word -> Word -> Word -> [StringBuilder]
lineInfoDefault String
curLine [String]
beforeLines [String]
afterLines Word
_line Word
pointsAt Word
width =
  [[StringBuilder]] -> [StringBuilder]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(String -> StringBuilder) -> [String] -> [StringBuilder]
forall a b. (a -> b) -> [a] -> [b]
map String -> StringBuilder
inputLine [String]
beforeLines, [String -> StringBuilder
inputLine String
curLine, StringBuilder
caretLine], (String -> StringBuilder) -> [String] -> [StringBuilder]
forall a b. (a -> b) -> [a] -> [b]
map String -> StringBuilder
inputLine [String]
afterLines]
  where inputLine :: String -> StringBuilder
        inputLine :: String -> StringBuilder
inputLine = String -> StringBuilder
forall a. IsString a => String -> a
fromString (String -> StringBuilder)
-> (String -> String) -> String -> StringBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'>' Char -> String -> String
forall a. a -> [a] -> [a]
:)
        caretLine :: StringBuilder
        caretLine :: StringBuilder
caretLine = String -> StringBuilder
forall a. IsString a => String -> a
fromString (Int -> Char -> String
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
<> String -> StringBuilder
forall a. IsString a => String -> a
fromString (Int -> Char -> String
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)