{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Parsing.Internal.Internal ( Parser, Position, getLocation, processParser, ) where import Data.ByteString.Lazy (ByteString) import qualified Data.List.NonEmpty as NonEmpty import Data.Morpheus.Types.Internal.AST ( GQLError (..), GQLErrors, Position (..), msg, ) import Data.Morpheus.Types.Internal.Resolving ( Eventless, Result (..), failure, ) import Relude ( ($), (.), Applicative (..), Either (..), Functor (..), Void, fst, ) import Text.Megaparsec ( ParseError, ParseErrorBundle ( ParseErrorBundle ), ParsecT, SourcePos, SourcePos (..), attachSourcePos, bundleErrors, bundlePosState, errorOffset, getSourcePos, parseErrorPretty, runParserT, unPos, ) getLocation :: Parser Position getLocation :: Parser Position getLocation = (SourcePos -> Position) -> ParsecT MyError ByteString Eventless SourcePos -> Parser Position forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap SourcePos -> Position toLocation ParsecT MyError ByteString Eventless SourcePos forall s e (m :: * -> *). (TraversableStream s, MonadParsec e s m) => m SourcePos getSourcePos toLocation :: SourcePos -> Position toLocation :: SourcePos -> Position toLocation SourcePos {Pos sourceLine :: SourcePos -> Pos sourceLine :: Pos sourceLine, Pos sourceColumn :: SourcePos -> Pos sourceColumn :: Pos sourceColumn} = Position :: Int -> Int -> Position Position {line :: Int line = Pos -> Int unPos Pos sourceLine, column :: Int column = Pos -> Int unPos Pos sourceColumn} type MyError = Void type Parser = ParsecT MyError ByteString Eventless type ErrorBundle = ParseErrorBundle ByteString MyError processParser :: Parser a -> ByteString -> Eventless a processParser :: Parser a -> ByteString -> Eventless a processParser Parser a parser ByteString txt = case Parser a -> String -> ByteString -> Eventless (Either (ParseErrorBundle ByteString MyError) a) forall (m :: * -> *) e s a. Monad m => ParsecT e s m a -> String -> s -> m (Either (ParseErrorBundle s e) a) runParserT Parser a parser [] ByteString txt of Success {Either (ParseErrorBundle ByteString MyError) a result :: forall events a. Result events a -> a result :: Either (ParseErrorBundle ByteString MyError) a result} -> case Either (ParseErrorBundle ByteString MyError) a result of Right a root -> a -> Eventless a forall (f :: * -> *) a. Applicative f => a -> f a pure a root Left ParseErrorBundle ByteString MyError parseError -> GQLErrors -> Eventless a forall error (f :: * -> *) v. Failure error f => error -> f v failure (ParseErrorBundle ByteString MyError -> GQLErrors processErrorBundle ParseErrorBundle ByteString MyError parseError) Failure {GQLErrors errors :: forall events a. Result events a -> GQLErrors errors :: GQLErrors errors} -> GQLErrors -> Eventless a forall error (f :: * -> *) v. Failure error f => error -> f v failure GQLErrors errors processErrorBundle :: ErrorBundle -> GQLErrors processErrorBundle :: ParseErrorBundle ByteString MyError -> GQLErrors processErrorBundle = ((ParseError ByteString MyError, SourcePos) -> GQLError) -> [(ParseError ByteString MyError, SourcePos)] -> GQLErrors forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (ParseError ByteString MyError, SourcePos) -> GQLError parseErrorToGQLError ([(ParseError ByteString MyError, SourcePos)] -> GQLErrors) -> (ParseErrorBundle ByteString MyError -> [(ParseError ByteString MyError, SourcePos)]) -> ParseErrorBundle ByteString MyError -> GQLErrors forall b c a. (b -> c) -> (a -> b) -> a -> c . ParseErrorBundle ByteString MyError -> [(ParseError ByteString MyError, SourcePos)] bundleToErrors parseErrorToGQLError :: (ParseError ByteString MyError, SourcePos) -> GQLError parseErrorToGQLError :: (ParseError ByteString MyError, SourcePos) -> GQLError parseErrorToGQLError (ParseError ByteString MyError err, SourcePos position) = GQLError :: Message -> [Position] -> GQLError GQLError { message :: Message message = String -> Message forall a. Msg a => a -> Message msg (ParseError ByteString MyError -> String forall s e. (VisualStream s, ShowErrorComponent e) => ParseError s e -> String parseErrorPretty ParseError ByteString MyError err), locations :: [Position] locations = [SourcePos -> Position toLocation SourcePos position] } bundleToErrors :: ErrorBundle -> [(ParseError ByteString MyError, SourcePos)] bundleToErrors :: ParseErrorBundle ByteString MyError -> [(ParseError ByteString MyError, SourcePos)] bundleToErrors ParseErrorBundle {NonEmpty (ParseError ByteString MyError) bundleErrors :: NonEmpty (ParseError ByteString MyError) bundleErrors :: forall s e. ParseErrorBundle s e -> NonEmpty (ParseError s e) bundleErrors, PosState ByteString bundlePosState :: PosState ByteString bundlePosState :: forall s e. ParseErrorBundle s e -> PosState s bundlePosState} = NonEmpty (ParseError ByteString MyError, SourcePos) -> [(ParseError ByteString MyError, SourcePos)] forall a. NonEmpty a -> [a] NonEmpty.toList (NonEmpty (ParseError ByteString MyError, SourcePos) -> [(ParseError ByteString MyError, SourcePos)]) -> NonEmpty (ParseError ByteString MyError, SourcePos) -> [(ParseError ByteString MyError, SourcePos)] forall a b. (a -> b) -> a -> b $ (NonEmpty (ParseError ByteString MyError, SourcePos), PosState ByteString) -> NonEmpty (ParseError ByteString MyError, SourcePos) forall a b. (a, b) -> a fst ((NonEmpty (ParseError ByteString MyError, SourcePos), PosState ByteString) -> NonEmpty (ParseError ByteString MyError, SourcePos)) -> (NonEmpty (ParseError ByteString MyError, SourcePos), PosState ByteString) -> NonEmpty (ParseError ByteString MyError, SourcePos) forall a b. (a -> b) -> a -> b $ (ParseError ByteString MyError -> Int) -> NonEmpty (ParseError ByteString MyError) -> PosState ByteString -> (NonEmpty (ParseError ByteString MyError, SourcePos), PosState ByteString) forall (t :: * -> *) s a. (Traversable t, TraversableStream s) => (a -> Int) -> t a -> PosState s -> (t (a, SourcePos), PosState s) attachSourcePos ParseError ByteString MyError -> Int forall s e. ParseError s e -> Int errorOffset NonEmpty (ParseError ByteString MyError) bundleErrors PosState ByteString bundlePosState