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