Rewrite selections into a Sequence. Fix #21

package.yaml

@@ -28,6 +28,7 @@ data-files:
 dependencies:
 - aeson
 - base >= 4.7 && < 5
+- containers
 - megaparsec
 - text
 - transformers

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.

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

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)

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