{-# 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))

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

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

--TODO: this needs to deal with whitespace and unprintables
{-# 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)
      -- use a semi-colon here, it is more correct
      | 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)