{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE DerivingVia, OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-missing-import-lists #-}
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))
type StringBuilder :: *
newtype StringBuilder = StringBuilder (String -> String)
deriving (NonEmpty StringBuilder -> StringBuilder
StringBuilder -> StringBuilder -> 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
stimes :: forall b. Integral b => b -> StringBuilder -> StringBuilder
$cstimes :: forall b. Integral b => b -> StringBuilder -> StringBuilder
sconcat :: NonEmpty StringBuilder -> StringBuilder
$csconcat :: NonEmpty StringBuilder -> StringBuilder
<> :: StringBuilder -> StringBuilder -> StringBuilder
$c<> :: StringBuilder -> StringBuilder -> StringBuilder
Semigroup, Semigroup StringBuilder
StringBuilder
[StringBuilder] -> StringBuilder
StringBuilder -> StringBuilder -> StringBuilder
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [StringBuilder] -> StringBuilder
$cmconcat :: [StringBuilder] -> StringBuilder
mappend :: StringBuilder -> StringBuilder -> StringBuilder
$cmappend :: StringBuilder -> StringBuilder -> StringBuilder
mempty :: StringBuilder
$cmempty :: 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 forall a. [a] -> [a] -> [a]
++)
{-# INLINE toString #-}
toString :: StringBuilder -> String
toString :: StringBuilder -> String
toString (StringBuilder String -> String
build) = String -> String
build forall a. Monoid a => a
mempty
{-# INLINE from #-}
from :: Show a => a -> StringBuilder
from :: forall a. Show a => a -> StringBuilder
from = (String -> String) -> StringBuilder
StringBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String -> String
shows
{-# INLINABLE formatDefault #-}
formatDefault :: StringBuilder -> Maybe StringBuilder -> [StringBuilder] -> String
formatDefault :: StringBuilder -> Maybe StringBuilder -> [StringBuilder] -> String
formatDefault 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\StringBuilder
src -> StringBuilder
"In " forall a. Semigroup a => a -> a -> a
<> StringBuilder
src forall a. Semigroup a => a -> a -> a
<> StringBuilder
" ") Maybe StringBuilder
source forall a. Semigroup a => a -> a -> a
<> StringBuilder
pos
{-# 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 (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) Maybe StringBuilder
unexpected (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) Maybe StringBuilder
expected (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t StringBuilder
reasons)))
{-# INLINABLE specialisedErrorDefault #-}
specialisedErrorDefault :: [StringBuilder] -> [StringBuilder] -> [StringBuilder]
specialisedErrorDefault :: [StringBuilder] -> [StringBuilder] -> [StringBuilder]
specialisedErrorDefault = [StringBuilder] -> [StringBuilder] -> [StringBuilder]
combineInfoWithLines
{-# INLINABLE combineInfoWithLines #-}
combineInfoWithLines :: [StringBuilder] -> [StringBuilder] -> [StringBuilder]
combineInfoWithLines :: [StringBuilder] -> [StringBuilder] -> [StringBuilder]
combineInfoWithLines [] [StringBuilder]
lines = StringBuilder
"unknown parse error" forall a. a -> [a] -> [a]
: [StringBuilder]
lines
combineInfoWithLines [StringBuilder]
info [StringBuilder]
lines = [StringBuilder]
info forall a. [a] -> [a] -> [a]
++ [StringBuilder]
lines
{-# INLINABLE rawDefault #-}
rawDefault :: String -> String
rawDefault :: String -> String
rawDefault String
n = String
"\"" forall a. Semigroup a => a -> a -> a
<> String
n forall a. Semigroup a => a -> a -> a
<> String
"\""
{-# INLINABLE namedDefault #-}
namedDefault :: String -> String
namedDefault :: String -> String
namedDefault = forall a. a -> a
id
{-# INLINABLE endOfInputDefault #-}
endOfInputDefault :: String
endOfInputDefault :: String
endOfInputDefault = String
"end of input"
{-# INLINABLE messageDefault #-}
messageDefault :: String -> String
messageDefault :: String -> String
messageDefault = forall a. a -> a
id
{-# INLINABLE expectedDefault #-}
expectedDefault :: Maybe StringBuilder -> Maybe StringBuilder
expectedDefault :: Maybe StringBuilder -> Maybe StringBuilder
expectedDefault = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StringBuilder
"expected " forall a. Semigroup a => a -> a -> a
<>)
{-# INLINABLE unexpectedDefault #-}
unexpectedDefault :: Maybe String -> Maybe StringBuilder
unexpectedDefault :: Maybe String -> Maybe StringBuilder
unexpectedDefault = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((StringBuilder
"unexpected " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString)
{-# 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"
{-# 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' (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a. a -> Down a
Down) [String]
elems)
where
j :: StringBuilder
j :: StringBuilder
j = forall a. IsString a => String -> a
fromString String
junction
junct' :: [String] -> Maybe StringBuilder
junct' [] = forall a. Maybe a
Nothing
junct' [String
alt] = forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString String
alt)
junct' [String
alt1, String
alt2] = forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString String
alt2 forall a. Semigroup a => a -> a -> a
<> StringBuilder
" " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString String
junction forall a. Semigroup a => a -> a -> a
<> StringBuilder
" " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString String
alt1)
junct' as :: [String]
as@(String
alt:[String]
alts)
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
',') [String]
as = forall a. a -> Maybe a
Just ([String] -> String -> String -> StringBuilder
junct'' (forall a. [a] -> [a]
reverse [String]
alts) String
alt String
"; ")
| Bool
otherwise = forall a. a -> Maybe a
Just ([String] -> String -> String -> StringBuilder
junct'' (forall a. [a] -> [a]
reverse [String]
alts) String
alt String
", ")
junct'' :: [String] -> String -> String -> StringBuilder
junct'' [String]
is String
l String
delim = StringBuilder
front forall a. Semigroup a => a -> a -> a
<> StringBuilder
back
where front :: StringBuilder
front = forall m. Monoid m => m -> [m] -> m
intercalate (forall a. IsString a => String -> a
fromString String
delim) (forall a b. (a -> b) -> [a] -> [b]
map forall a. IsString a => String -> a
fromString [String]
is) :: StringBuilder
back :: StringBuilder
back
| Bool
oxford = forall a. IsString a => String -> a
fromString String
delim forall a. Semigroup a => a -> a -> a
<> StringBuilder
j forall a. Semigroup a => a -> a -> a
<> StringBuilder
" " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString String
l
| Bool
otherwise = StringBuilder
" " forall a. Semigroup a => a -> a -> a
<> StringBuilder
j forall a. Semigroup a => a -> a -> a
<> StringBuilder
" " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString String
l
{-# INLINABLE combineMessagesDefault #-}
combineMessagesDefault :: Foldable t => t String -> [StringBuilder]
combineMessagesDefault :: forall (t :: * -> *). Foldable t => t String -> [StringBuilder]
combineMessagesDefault = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\String
msg -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
msg then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString String
msg)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
{-# INLINABLE blockError #-}
blockError :: StringBuilder -> [StringBuilder] -> Int -> StringBuilder
blockError :: StringBuilder -> [StringBuilder] -> Int -> StringBuilder
blockError StringBuilder
header [StringBuilder]
lines Int
indent = StringBuilder
header forall a. Semigroup a => a -> a -> a
<> StringBuilder
":\n" forall a. Semigroup a => a -> a -> a
<> [StringBuilder] -> Int -> StringBuilder
indentAndUnlines [StringBuilder]
lines Int
indent
{-# INLINABLE indentAndUnlines #-}
indentAndUnlines :: [StringBuilder] -> Int -> StringBuilder
indentAndUnlines :: [StringBuilder] -> Int -> StringBuilder
indentAndUnlines [StringBuilder]
lines Int
indent = forall a. IsString a => String -> a
fromString String
pre forall a. Semigroup a => a -> a -> a
<> forall m. Monoid m => m -> [m] -> m
intercalate (forall a. IsString a => String -> a
fromString (Char
'\n' forall a. a -> [a] -> [a]
: String
pre)) [StringBuilder]
lines
where pre :: String
pre = forall a. Int -> a -> [a]
replicate Int
indent Char
' '
{-# INLINABLE lineInfoDefault #-}
lineInfoDefault :: String -> [String] -> [String] -> Word -> Word -> [StringBuilder]
lineInfoDefault :: String -> [String] -> [String] -> Word -> Word -> [StringBuilder]
lineInfoDefault String
curLine [String]
beforeLines [String]
afterLines Word
pointsAt Word
width =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a b. (a -> b) -> [a] -> [b]
map String -> StringBuilder
inputLine [String]
beforeLines, [String -> StringBuilder
inputLine String
curLine, StringBuilder
caretLine], forall a b. (a -> b) -> [a] -> [b]
map String -> StringBuilder
inputLine [String]
afterLines]
where inputLine :: String -> StringBuilder
inputLine :: String -> StringBuilder
inputLine = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'>' forall a. a -> [a] -> [a]
:)
caretLine :: StringBuilder
caretLine :: StringBuilder
caretLine = forall a. IsString a => String -> a
fromString (forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
pointsAt forall a. Num a => a -> a -> a
+ Word
1)) Char
' ') forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
width) Char
'^')
{-# INLINABLE formatPosDefault #-}
formatPosDefault :: Word -> Word -> StringBuilder
formatPosDefault :: Word -> Word -> StringBuilder
formatPosDefault Word
line Word
col = StringBuilder
"(line "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> StringBuilder
from Word
line
forall a. Semigroup a => a -> a -> a
<> StringBuilder
", column "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> StringBuilder
from Word
col
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 = forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse m
x [m]
xs)