{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Parsing.Internal.Internal ( Parser, Position, getLocation, processParser, ) where import Data.ByteString.Lazy (ByteString) import Data.Morpheus.Ext.Result ( GQLResult, Result (..), ) import Data.Morpheus.Types.Internal.AST ( GQLError, Position (..), at, msg, ) import Relude hiding (ByteString) import Text.Megaparsec ( ParseError, ParseErrorBundle ( ParseErrorBundle ), ParsecT, SourcePos (..), attachSourcePos, bundleErrors, bundlePosState, errorOffset, getSourcePos, parseErrorPretty, runParserT, unPos, ) getLocation :: Parser Position getLocation :: Parser Position getLocation = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap SourcePos -> Position toLocation forall s e (m :: * -> *). (TraversableStream s, MonadParsec e s m) => m SourcePos getSourcePos {-# INLINEABLE getLocation #-} toLocation :: SourcePos -> Position toLocation :: SourcePos -> Position toLocation SourcePos {Pos sourceLine :: SourcePos -> Pos sourceLine :: Pos sourceLine, Pos sourceColumn :: SourcePos -> Pos sourceColumn :: Pos sourceColumn} = Position {line :: Int line = Pos -> Int unPos Pos sourceLine, column :: Int column = Pos -> Int unPos Pos sourceColumn} {-# INLINEABLE toLocation #-} type MyError = Void type Parser = ParsecT MyError ByteString GQLResult type ErrorBundle = ParseErrorBundle ByteString MyError processParser :: Parser a -> ByteString -> GQLResult a processParser :: forall a. Parser a -> ByteString -> GQLResult a processParser Parser a parser ByteString txt = case 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 err a. Result err a -> a result :: Either (ParseErrorBundle ByteString MyError) a result} -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (forall err a. NonEmpty err -> Result err a Failure forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (ParseError ByteString MyError, SourcePos) -> GQLError parseErrorToGQLError forall b c a. (b -> c) -> (a -> b) -> a -> c . ParseErrorBundle ByteString MyError -> NonEmpty (ParseError ByteString MyError, SourcePos) bundleToErrors) forall (f :: * -> *) a. Applicative f => a -> f a pure Either (ParseErrorBundle ByteString MyError) a result Failure {NonEmpty GQLError errors :: forall err a. Result err a -> NonEmpty err errors :: NonEmpty GQLError errors} -> forall err a. NonEmpty err -> Result err a Failure NonEmpty GQLError errors parseErrorToGQLError :: (ParseError ByteString MyError, SourcePos) -> GQLError parseErrorToGQLError :: (ParseError ByteString MyError, SourcePos) -> GQLError parseErrorToGQLError (ParseError ByteString MyError err, SourcePos position) = forall a. Msg a => a -> GQLError msg (forall s e. (VisualStream s, ShowErrorComponent e) => ParseError s e -> String parseErrorPretty ParseError ByteString MyError err) GQLError -> Position -> GQLError `at` SourcePos -> Position toLocation SourcePos position bundleToErrors :: ErrorBundle -> NonEmpty (ParseError ByteString MyError, SourcePos) bundleToErrors :: ParseErrorBundle ByteString MyError -> NonEmpty (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} = forall a b. (a, b) -> a fst forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) s a. (Traversable t, TraversableStream s) => (a -> Int) -> t a -> PosState s -> (t (a, SourcePos), PosState s) attachSourcePos forall s e. ParseError s e -> Int errorOffset NonEmpty (ParseError ByteString MyError) bundleErrors PosState ByteString bundlePosState