From 10e4d64052aabbbe3fd82daf83138723ae4af3b6 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Fri, 19 Feb 2021 08:09:04 +0100 Subject: [PATCH] Replace Map with OrderedMap --- CHANGELOG.md | 3 +++ src/Language/GraphQL/Execute/Coerce.hs | 10 +++++--- src/Language/GraphQL/Execute/Execution.hs | 16 ++++++------- src/Language/GraphQL/Execute/OrderedMap.hs | 24 ++++++++++++++----- src/Language/GraphQL/Execute/Subscribe.hs | 4 ++-- .../GraphQL/Execute/OrderedMapSpec.hs | 6 +++++ 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"