morpheus-graphql-0.7.0: src/Data/Morpheus/Parsing/Internal/Internal.hs

{-# LANGUAGE NamedFieldPuns #-}

module Data.Morpheus.Parsing.Internal.Internal
  ( Parser
  , Position
  , processErrorBundle
  , getLocation
  )
where

import qualified Data.List.NonEmpty            as NonEmpty
import           Data.Morpheus.Error.Utils      ( toLocation )
import           Data.Morpheus.Types.Internal.AST
                                                ( Position )
import           Data.Morpheus.Types.Internal.Resolving
                                                ( GQLError(..)
                                                , GQLErrors
                                                )
import           Data.Text                      ( Text
                                                , pack
                                                )
import           Data.Void                      ( Void )
import           Text.Megaparsec                ( ParseError
                                                , ParseErrorBundle
                                                  ( ParseErrorBundle
                                                  )
                                                , Parsec
                                                , SourcePos
                                                , attachSourcePos
                                                , bundleErrors
                                                , bundlePosState
                                                , errorOffset
                                                , getSourcePos
                                                , parseErrorPretty
                                                )


getLocation :: Parser Position
getLocation = fmap toLocation getSourcePos

type Parser = Parsec Void Text

processErrorBundle :: ParseErrorBundle Text Void -> GQLErrors
processErrorBundle = fmap parseErrorToGQLError . bundleToErrors
 where
  parseErrorToGQLError :: (ParseError Text Void, SourcePos) -> GQLError
  parseErrorToGQLError (err, position) = GQLError
    { message   = pack (parseErrorPretty err)
    , locations = [toLocation position]
    }
  bundleToErrors
    :: ParseErrorBundle Text Void -> [(ParseError Text Void, SourcePos)]
  bundleToErrors ParseErrorBundle { bundleErrors, bundlePosState } =
    NonEmpty.toList $ fst $ attachSourcePos errorOffset
                                            bundleErrors
                                            bundlePosState