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