{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE Unsafe #-}
module Parser.TextParser (
module Text.Megaparsec,
module Text.Megaparsec.Char,
SourceContext,
TextParser,
getSourceContext,
runTextParser,
) where
import Data.Char (isSpace)
import Data.List (dropWhileEnd)
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Data.Set as Set
import Base.CompilerError
import Base.CompilerMessage
type TextParser = Parsec CompilerMessage String
instance ErrorContextM TextParser where
compilerErrorM :: forall a. String -> TextParser a
compilerErrorM = CompilerMessage -> ParsecT CompilerMessage String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CompilerMessage -> ParsecT CompilerMessage String Identity a)
-> (String -> CompilerMessage)
-> String
-> ParsecT CompilerMessage String Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CompilerMessage
compilerMessage
withContextM :: forall a. TextParser a -> String -> TextParser a
withContextM TextParser a
x String
e = (ParseError String CompilerMessage
-> ParseError String CompilerMessage)
-> TextParser a -> TextParser a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> ParseError s e) -> m a -> m a
region ((CompilerMessage -> CompilerMessage)
-> ParseError String CompilerMessage
-> ParseError String CompilerMessage
forall e' e s.
Ord e' =>
(e -> e') -> ParseError s e -> ParseError s e'
mapParseError (String -> CompilerMessage -> CompilerMessage
pushErrorScope String
e) (ParseError String CompilerMessage
-> ParseError String CompilerMessage)
-> (ParseError String CompilerMessage
-> ParseError String CompilerMessage)
-> ParseError String CompilerMessage
-> ParseError String CompilerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError String CompilerMessage
-> ParseError String CompilerMessage
promoteError) TextParser a
x
summarizeErrorsM :: forall a. TextParser a -> String -> TextParser a
summarizeErrorsM TextParser a
x String
e = (ParseError String CompilerMessage
-> ParseError String CompilerMessage)
-> TextParser a -> TextParser a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> ParseError s e) -> m a -> m a
region ((CompilerMessage -> CompilerMessage)
-> ParseError String CompilerMessage
-> ParseError String CompilerMessage
forall e' e s.
Ord e' =>
(e -> e') -> ParseError s e -> ParseError s e'
mapParseError (String -> CompilerMessage -> CompilerMessage
pushErrorScope String
e) (ParseError String CompilerMessage
-> ParseError String CompilerMessage)
-> (ParseError String CompilerMessage
-> ParseError String CompilerMessage)
-> ParseError String CompilerMessage
-> ParseError String CompilerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError String CompilerMessage
-> ParseError String CompilerMessage
promoteError) TextParser a
x
instance ShowErrorComponent CompilerMessage where
showErrorComponent :: CompilerMessage -> String
showErrorComponent = CompilerMessage -> String
forall a. Show a => a -> String
show
runTextParser :: ErrorContextM m => TextParser a -> String -> String -> m a
runTextParser :: forall (m :: * -> *) a.
ErrorContextM m =>
TextParser a -> String -> String -> m a
runTextParser TextParser a
p String
n String
s = case TextParser a
-> String
-> String
-> Either (ParseErrorBundle String CompilerMessage) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse TextParser a
p String
n String
s of
Left ParseErrorBundle String CompilerMessage
e -> String -> m a
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle String CompilerMessage -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle String CompilerMessage
e
Right a
x -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
newtype SourceContext = SourceContext SourcePos deriving (SourceContext -> SourceContext -> Bool
(SourceContext -> SourceContext -> Bool)
-> (SourceContext -> SourceContext -> Bool) -> Eq SourceContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceContext -> SourceContext -> Bool
== :: SourceContext -> SourceContext -> Bool
$c/= :: SourceContext -> SourceContext -> Bool
/= :: SourceContext -> SourceContext -> Bool
Eq,Eq SourceContext
Eq SourceContext =>
(SourceContext -> SourceContext -> Ordering)
-> (SourceContext -> SourceContext -> Bool)
-> (SourceContext -> SourceContext -> Bool)
-> (SourceContext -> SourceContext -> Bool)
-> (SourceContext -> SourceContext -> Bool)
-> (SourceContext -> SourceContext -> SourceContext)
-> (SourceContext -> SourceContext -> SourceContext)
-> Ord SourceContext
SourceContext -> SourceContext -> Bool
SourceContext -> SourceContext -> Ordering
SourceContext -> SourceContext -> SourceContext
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SourceContext -> SourceContext -> Ordering
compare :: SourceContext -> SourceContext -> Ordering
$c< :: SourceContext -> SourceContext -> Bool
< :: SourceContext -> SourceContext -> Bool
$c<= :: SourceContext -> SourceContext -> Bool
<= :: SourceContext -> SourceContext -> Bool
$c> :: SourceContext -> SourceContext -> Bool
> :: SourceContext -> SourceContext -> Bool
$c>= :: SourceContext -> SourceContext -> Bool
>= :: SourceContext -> SourceContext -> Bool
$cmax :: SourceContext -> SourceContext -> SourceContext
max :: SourceContext -> SourceContext -> SourceContext
$cmin :: SourceContext -> SourceContext -> SourceContext
min :: SourceContext -> SourceContext -> SourceContext
Ord)
instance Show SourceContext where
show :: SourceContext -> String
show (SourceContext (SourcePos String
f Pos
l Pos
c)) =
String
"line " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Pos -> Int
unPos Pos
l) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" column " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Pos -> Int
unPos Pos
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f
getSourceContext :: TextParser SourceContext
getSourceContext :: TextParser SourceContext
getSourceContext = (SourcePos -> SourceContext)
-> ParsecT CompilerMessage String Identity SourcePos
-> TextParser SourceContext
forall a b.
(a -> b)
-> ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SourcePos -> SourceContext
SourceContext ParsecT CompilerMessage String Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
promoteError :: ParseError String CompilerMessage -> ParseError String CompilerMessage
promoteError :: ParseError String CompilerMessage
-> ParseError String CompilerMessage
promoteError e :: ParseError String CompilerMessage
e@(TrivialError Int
i Maybe (ErrorItem (Token String))
_ Set (ErrorItem (Token String))
_) = Int
-> Set (ErrorFancy CompilerMessage)
-> ParseError String CompilerMessage
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
i (Set (ErrorFancy CompilerMessage)
-> ParseError String CompilerMessage)
-> Set (ErrorFancy CompilerMessage)
-> ParseError String CompilerMessage
forall a b. (a -> b) -> a -> b
$ [ErrorFancy CompilerMessage] -> Set (ErrorFancy CompilerMessage)
forall a. Ord a => [a] -> Set a
Set.fromList [CompilerMessage -> ErrorFancy CompilerMessage
forall e. e -> ErrorFancy e
ErrorCustom (CompilerMessage -> ErrorFancy CompilerMessage)
-> CompilerMessage -> ErrorFancy CompilerMessage
forall a b. (a -> b) -> a -> b
$ String -> CompilerMessage
compilerMessage (String -> CompilerMessage) -> String -> CompilerMessage
forall a b. (a -> b) -> a -> b
$ ParseError String CompilerMessage -> String
forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorTextPretty ParseError String CompilerMessage
e]
promoteError ParseError String CompilerMessage
e = ParseError String CompilerMessage
e