{-# 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,
    SourcePos (..),
    attachSourcePos,
    bundleErrors,
    bundlePosState,
    errorOffset,
    getSourcePos,
    parseErrorPretty,
    runParserT,
    unPos,
  )

getLocation :: Parser Position
getLocation :: Parser Position
getLocation = (SourcePos -> Position)
-> ParsecT MyError ByteString GQLResult SourcePos
-> Parser Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SourcePos -> Position
toLocation ParsecT MyError ByteString GQLResult SourcePos
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 :: Int -> Int -> Position
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 :: Parser a -> ByteString -> GQLResult a
processParser Parser a
parser ByteString
txt = case Parser a
-> String
-> ByteString
-> GQLResult (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 err a. Result err a -> a
result :: Either (ParseErrorBundle ByteString MyError) a
result} ->
    (ParseErrorBundle ByteString MyError -> GQLResult a)
-> (a -> GQLResult a)
-> Either (ParseErrorBundle ByteString MyError) a
-> GQLResult a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      (NonEmpty GQLError -> GQLResult a
forall err a. NonEmpty err -> Result err a
Failure (NonEmpty GQLError -> GQLResult a)
-> (ParseErrorBundle ByteString MyError -> NonEmpty GQLError)
-> ParseErrorBundle ByteString MyError
-> GQLResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ParseError ByteString MyError, SourcePos) -> GQLError)
-> NonEmpty (ParseError ByteString MyError, SourcePos)
-> NonEmpty GQLError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParseError ByteString MyError, SourcePos) -> GQLError
parseErrorToGQLError (NonEmpty (ParseError ByteString MyError, SourcePos)
 -> NonEmpty GQLError)
-> (ParseErrorBundle ByteString MyError
    -> NonEmpty (ParseError ByteString MyError, SourcePos))
-> ParseErrorBundle ByteString MyError
-> NonEmpty GQLError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle ByteString MyError
-> NonEmpty (ParseError ByteString MyError, SourcePos)
bundleToErrors)
      a -> GQLResult a
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} -> NonEmpty GQLError -> GQLResult a
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) = String -> GQLError
forall a. Msg a => a -> GQLError
msg (ParseError ByteString MyError -> String
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} =
  (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