summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--CHANGELOG.md3
-rw-r--r--src/Language/GraphQL/Execute/Coerce.hs10
-rw-r--r--src/Language/GraphQL/Execute/Execution.hs16
-rw-r--r--src/Language/GraphQL/Execute/OrderedMap.hs24
-rw-r--r--src/Language/GraphQL/Execute/Subscribe.hs4
-rw-r--r--tests/Language/GraphQL/Execute/OrderedMapSpec.hs6
6 files changed, 44 insertions, 19 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 6f400c4..246c907 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -7,6 +7,9 @@ and this project adheres to
[Haskell Package Versioning Policy](https://pvp.haskell.org/).
## [Unreleased]
+### Added
+- `Language.GraphQL.Execute.OrderedMap` is a map data structure, that preserves
+ insertion order.
## [0.11.1.0] - 2021-02-07
### Added
diff --git a/src/Language/GraphQL/Execute/Coerce.hs b/src/Language/GraphQL/Execute/Coerce.hs
index 08a2fc0..f5ee204 100644
--- a/src/Language/GraphQL/Execute/Coerce.hs
+++ b/src/Language/GraphQL/Execute/Coerce.hs
@@ -19,7 +19,6 @@ import qualified Data.Aeson as Aeson
import Data.Int (Int32)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
-import Data.Map.Strict (Map)
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text.Lazy as Text.Lazy
@@ -27,6 +26,8 @@ import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
import Data.Scientific (toBoundedInteger, toRealFloat)
import Language.GraphQL.AST (Name)
+import Language.GraphQL.Execute.OrderedMap (OrderedMap)
+import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
import qualified Language.GraphQL.Type as Type
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
@@ -209,7 +210,7 @@ data Output a
| Boolean Bool
| Enum Name
| List [a]
- | Object (Map Name a)
+ | Object (OrderedMap a)
deriving (Eq, Show)
instance forall a. IsString (Output a) where
@@ -229,6 +230,9 @@ instance Serialize Aeson.Value where
, Boolean boolean <- value = Just $ Aeson.Bool boolean
serialize _ (Enum enum) = Just $ Aeson.String enum
serialize _ (List list) = Just $ Aeson.toJSON list
- serialize _ (Object object) = Just $ Aeson.toJSON object
+ serialize _ (Object object) = Just
+ $ Aeson.object
+ $ OrderedMap.toList
+ $ Aeson.toJSON <$> object
serialize _ _ = Nothing
null = Aeson.Null
diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs
index 9d588ca..0ea361d 100644
--- a/src/Language/GraphQL/Execute/Execution.hs
+++ b/src/Language/GraphQL/Execute/Execution.hs
@@ -13,16 +13,16 @@ import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (runReaderT)
import Control.Monad.Trans.State (gets)
import Data.List.NonEmpty (NonEmpty(..))
-import Data.Map.Strict (Map)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
-import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq(..))
import qualified Data.Text as Text
import Language.GraphQL.AST (Name)
import Language.GraphQL.Error
import Language.GraphQL.Execute.Coerce
+import Language.GraphQL.Execute.OrderedMap (OrderedMap)
+import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
import qualified Language.GraphQL.Execute.Transform as Transform
import qualified Language.GraphQL.Type as Type
import qualified Language.GraphQL.Type.In as In
@@ -51,17 +51,17 @@ resolveFieldValue result args resolver =
collectFields :: Monad m
=> Out.ObjectType m
-> Seq (Transform.Selection m)
- -> Map Name (NonEmpty (Transform.Field m))
-collectFields objectType = foldl forEach Map.empty
+ -> OrderedMap (NonEmpty (Transform.Field m))
+collectFields objectType = foldl forEach OrderedMap.empty
where
forEach groupedFields (Transform.SelectionField field) =
let responseKey = aliasOrName field
- in Map.insertWith (<>) responseKey (field :| []) groupedFields
+ in OrderedMap.insert responseKey (field :| []) groupedFields
forEach groupedFields (Transform.SelectionFragment selectionFragment)
| Transform.Fragment fragmentType fragmentSelectionSet <- selectionFragment
, Internal.doesFragmentTypeApply fragmentType objectType =
let fragmentGroupedFieldSet = collectFields objectType fragmentSelectionSet
- in Map.unionWith (<>) groupedFields fragmentGroupedFieldSet
+ in groupedFields <> fragmentGroupedFieldSet
| otherwise = groupedFields
aliasOrName :: forall m. Transform.Field m -> Name
@@ -170,10 +170,10 @@ executeSelectionSet :: (MonadCatch m, Serialize a)
-> CollectErrsT m a
executeSelectionSet result objectType@(Out.ObjectType _ _ _ resolvers) selectionSet = do
let fields = collectFields objectType selectionSet
- resolvedValues <- Map.traverseMaybeWithKey forEach fields
+ resolvedValues <- OrderedMap.traverseMaybe forEach fields
coerceResult (Out.NonNullObjectType objectType) $ Object resolvedValues
where
- forEach _ fields@(field :| _) =
+ forEach fields@(field :| _) =
let Transform.Field _ name _ _ = field
in traverse (tryResolver fields) $ lookupResolver name
lookupResolver = flip HashMap.lookup resolvers
diff --git a/src/Language/GraphQL/Execute/OrderedMap.hs b/src/Language/GraphQL/Execute/OrderedMap.hs
index f8759c9..e905cce 100644
--- a/src/Language/GraphQL/Execute/OrderedMap.hs
+++ b/src/Language/GraphQL/Execute/OrderedMap.hs
@@ -15,8 +15,10 @@ module Language.GraphQL.Execute.OrderedMap
, foldlWithKey'
, keys
, lookup
+ , replace
, singleton
, size
+ , toList
, traverseMaybe
) where
@@ -49,8 +51,8 @@ instance Semigroup v => Semigroup (OrderedMap v) where
(<>) = foldlWithKey'
$ \accumulator key value -> insert key value accumulator
-instance Monoid v => Monoid (OrderedMap v) where
- mempty = OrderedMap mempty mempty
+instance Semigroup v => Monoid (OrderedMap v) where
+ mempty = empty
instance Traversable OrderedMap where
traverse f (OrderedMap vector hashMap) = OrderedMap vector
@@ -68,8 +70,8 @@ singleton key value = OrderedMap (Vector.singleton key)
$ HashMap.singleton key value
-- | Constructs an empty map.
-empty :: Monoid v => OrderedMap v
-empty = mempty
+empty :: forall v. OrderedMap v
+empty = OrderedMap mempty mempty
-- * Traversal
@@ -90,7 +92,7 @@ foldlWithKey' f initial (OrderedMap vector hashMap) =
-- | Traverse over the elements and collect the 'Just' results.
traverseMaybe
- :: (Applicative f, Monoid b)
+ :: Applicative f
=> forall a
. (a -> f (Maybe b))
-> OrderedMap a
@@ -98,7 +100,7 @@ traverseMaybe
traverseMaybe f orderedMap = foldlWithKey' filter empty
<$> traverse f orderedMap
where
- filter accumulator key (Just value) = insert key value accumulator
+ filter accumulator key (Just value) = replace key value accumulator
filter accumulator _ Nothing = accumulator
-- * Lists
@@ -127,6 +129,16 @@ insert key value (OrderedMap vector hashMap)
| otherwise = OrderedMap (Vector.snoc vector key)
$ HashMap.insert key value hashMap
+-- | Associates the specified value with the specified key in this map. If this
+-- map previously contained a mapping for the key, the existing value is
+-- replaced by the new one.
+replace :: Text -> v -> OrderedMap v -> OrderedMap v
+replace key value (OrderedMap vector hashMap)
+ | HashMap.member key hashMap = OrderedMap vector
+ $ HashMap.insert key value hashMap
+ | otherwise = OrderedMap (Vector.snoc vector key)
+ $ HashMap.insert key value hashMap
+
-- | Gives the size of this map, i.e. number of elements in it.
size :: forall v. OrderedMap v -> Int
size (OrderedMap vector _) = Vector.length vector
diff --git a/src/Language/GraphQL/Execute/Subscribe.hs b/src/Language/GraphQL/Execute/Subscribe.hs
index 0bd274f..4f2a6a6 100644
--- a/src/Language/GraphQL/Execute/Subscribe.hs
+++ b/src/Language/GraphQL/Execute/Subscribe.hs
@@ -13,7 +13,6 @@ import Control.Monad.Catch (Exception(..), MonadCatch(..))
import Control.Monad.Trans.Reader (ReaderT(..), runReaderT)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
-import qualified Data.Map.Strict as Map
import qualified Data.List.NonEmpty as NonEmpty
import Data.Sequence (Seq(..))
import Data.Text (Text)
@@ -21,6 +20,7 @@ import qualified Data.Text as Text
import Language.GraphQL.AST (Name)
import Language.GraphQL.Execute.Coerce
import Language.GraphQL.Execute.Execution
+import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
import qualified Language.GraphQL.Execute.Transform as Transform
import Language.GraphQL.Error
import qualified Language.GraphQL.Type.Definition as Definition
@@ -55,7 +55,7 @@ createSourceEventStream :: MonadCatch m
-> Seq (Transform.Selection m)
-> m (Either Text (Out.SourceEventStream m))
createSourceEventStream _types subscriptionType@(Out.ObjectType _ _ _ fieldTypes) fields
- | [fieldGroup] <- Map.elems groupedFieldSet
+ | [fieldGroup] <- OrderedMap.elems groupedFieldSet
, Transform.Field _ fieldName arguments' _ <- NonEmpty.head fieldGroup
, resolverT <- fieldTypes HashMap.! fieldName
, Out.EventStreamResolver fieldDefinition _ resolver <- resolverT
diff --git a/tests/Language/GraphQL/Execute/OrderedMapSpec.hs b/tests/Language/GraphQL/Execute/OrderedMapSpec.hs
index fd33316..7c6a44f 100644
--- a/tests/Language/GraphQL/Execute/OrderedMapSpec.hs
+++ b/tests/Language/GraphQL/Execute/OrderedMapSpec.hs
@@ -64,3 +64,9 @@ spec =
$ OrderedMap.insert "key2" "2"
$ OrderedMap.singleton "key1" "1"
in (map1 <> map2) `shouldBe` expected
+
+ it "replaces existing values" $
+ let key = "key"
+ actual = OrderedMap.replace key ("2" :: String)
+ $ OrderedMap.singleton key ("1" :: String)
+ in OrderedMap.lookup key actual `shouldBe` Just "2"
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-26 22:14:08 +0000