diff --git a/package.yaml b/package.yaml index cbb7337..e21417d 100644 --- a/package.yaml +++ b/package.yaml @@ -28,6 +28,7 @@ data-files: dependencies: - aeson - base >= 4.7 && < 5 +- containers - megaparsec - text - transformers diff --git a/src/Language/GraphQL/AST/Core.hs b/src/Language/GraphQL/AST/Core.hs index 2cdb122..f7a008f 100644 --- a/src/Language/GraphQL/AST/Core.hs +++ b/src/Language/GraphQL/AST/Core.hs @@ -15,6 +15,7 @@ module Language.GraphQL.AST.Core import Data.Int (Int32) import Data.HashMap.Strict (HashMap) import Data.List.NonEmpty (NonEmpty) +import Data.Sequence (Seq) import Data.String (IsString(..)) import Data.Text (Text) import Language.GraphQL.AST (Alias, Name, TypeCondition) @@ -26,19 +27,21 @@ type Document = NonEmpty Operation -- -- Currently only queries and mutations are supported. data Operation - = Query (Maybe Text) (NonEmpty Selection) - | Mutation (Maybe Text) (NonEmpty Selection) + = Query (Maybe Text) (Seq Selection) + | Mutation (Maybe Text) (Seq Selection) deriving (Eq, Show) -- | Single GraphQL field. -data Field = Field (Maybe Alias) Name [Argument] [Selection] deriving (Eq, Show) +data Field + = Field (Maybe Alias) Name [Argument] (Seq Selection) + deriving (Eq, Show) -- | Single argument. data Argument = Argument Name Value deriving (Eq, Show) -- | Represents fragments and inline fragments. data Fragment - = Fragment TypeCondition (NonEmpty Selection) + = Fragment TypeCondition (Seq Selection) deriving (Eq, Show) -- | Single selection element. diff --git a/src/Language/GraphQL/AST/Transform.hs b/src/Language/GraphQL/AST/Transform.hs index d70a163..0dfc5e5 100644 --- a/src/Language/GraphQL/AST/Transform.hs +++ b/src/Language/GraphQL/AST/Transform.hs @@ -13,17 +13,19 @@ import Control.Monad (foldM, unless) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT) import Control.Monad.Trans.State (StateT, evalStateT, gets, modify) +import Data.Foldable (toList) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap -import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty +import Data.Sequence (Seq, (<|), (><)) +import qualified Data.Sequence as Sequence import qualified Language.GraphQL.AST as Full import qualified Language.GraphQL.AST.Core as Core import qualified Language.GraphQL.Schema as Schema -- | Associates a fragment name with a list of 'Core.Field's. data Replacement = Replacement - { fragments :: HashMap Core.Name (NonEmpty Core.Selection) + { fragments :: HashMap Core.Name (Seq Core.Selection) , fragmentDefinitions :: HashMap Full.Name Full.FragmentDefinition } @@ -63,13 +65,13 @@ operation (Full.OperationDefinition Full.Mutation name _vars _dirs sels) = selection :: Full.Selection -> - TransformT (Either (NonEmpty Core.Selection) Core.Selection) + TransformT (Either (Seq Core.Selection) Core.Selection) selection (Full.SelectionField fld) = Right . Core.SelectionField <$> field fld selection (Full.SelectionFragmentSpread (Full.FragmentSpread name _)) = do fragments' <- gets fragments Left <$> maybe lookupDefinition liftJust (HashMap.lookup name fragments') where - lookupDefinition :: TransformT (NonEmpty Core.Selection) + lookupDefinition :: TransformT (Seq Core.Selection) lookupDefinition = do fragmentDefinitions' <- gets fragmentDefinitions found <- lift . lift $ HashMap.lookup name fragmentDefinitions' @@ -96,11 +98,11 @@ collectFragments = do fragmentDefinition :: Full.FragmentDefinition -> - TransformT (NonEmpty Core.Selection) + TransformT (Seq Core.Selection) fragmentDefinition (Full.FragmentDefinition name _tc _dirs sels) = do modify deleteFragmentDefinition selections <- traverse selection sels - let newValue = either id pure =<< selections + let newValue = either id pure =<< Sequence.fromList (toList selections) modify $ insertFragment newValue liftJust newValue where @@ -113,7 +115,7 @@ fragmentDefinition (Full.FragmentDefinition name _tc _dirs sels) = do field :: Full.Field -> TransformT Core.Field field (Full.Field a n args _dirs sels) = do arguments <- traverse argument args - selection' <- appendSelectionOpt sels + selection' <- appendSelection sels return $ Core.Field a n arguments selection' argument :: Full.Argument -> TransformT Core.Argument @@ -137,22 +139,15 @@ value (Full.Object o) = objectField :: Full.ObjectField -> TransformT (Core.Name, Core.Value) objectField (Full.ObjectField n v) = (n,) <$> value v -appendSelectionOpt :: +appendSelection :: Traversable t => t Full.Selection -> - TransformT [Core.Selection] -appendSelectionOpt = foldM go [] + TransformT (Seq Core.Selection) +appendSelection = foldM go mempty where go acc sel = append acc <$> selection sel - append acc (Left list) = NonEmpty.toList list <> acc - append acc (Right one) = one : acc - -appendSelection :: - NonEmpty Full.Selection -> - TransformT (NonEmpty Core.Selection) -appendSelection fullSelection = do - coreSelection <-appendSelectionOpt fullSelection - lift . lift $ NonEmpty.nonEmpty coreSelection + append acc (Left list) = list >< acc + append acc (Right one) = one <| acc liftJust :: forall a. a -> TransformT a liftJust = lift . lift . Just diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs index 9228dd5..59e85bf 100644 --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -8,6 +8,7 @@ module Language.GraphQL.Execute import Control.Monad.IO.Class (MonadIO) import qualified Data.Aeson as Aeson +import Data.Foldable (toList) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE import Data.Text (Text) @@ -71,6 +72,6 @@ operation :: MonadIO m -> AST.Core.Operation -> m Aeson.Value operation schema (AST.Core.Query _ flds) - = runCollectErrs (Schema.resolve (NE.toList schema) (NE.toList flds)) + = runCollectErrs (Schema.resolve (toList schema) flds) operation schema (AST.Core.Mutation _ flds) - = runCollectErrs (Schema.resolve (NE.toList schema) (NE.toList flds)) + = runCollectErrs (Schema.resolve (toList schema) flds) diff --git a/src/Language/GraphQL/Schema.hs b/src/Language/GraphQL/Schema.hs index 44e9077..984a4d7 100644 --- a/src/Language/GraphQL/Schema.hs +++ b/src/Language/GraphQL/Schema.hs @@ -28,6 +28,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Aeson as Aeson import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap +import Data.Sequence (Seq) import Data.Text (Text) import qualified Data.Text as T import Language.GraphQL.AST.Core @@ -118,7 +119,7 @@ withField v fld -- 'Resolver' to each 'Field'. Resolves into a value containing the -- resolved 'Field', or a null value and error information. resolve :: MonadIO m - => [Resolver m] -> [Selection] -> CollectErrsT m Aeson.Value + => [Resolver m] -> Seq Selection -> CollectErrsT m Aeson.Value resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers where resolveTypeName (Resolver "__typename" f) = do