1 files changed, 148 insertions, 0 deletions
diff --git a/src/Language/GraphQL/Execute/OrderedMap.hs b/src/Language/GraphQL/Execute/OrderedMap.hs
new file mode 100644
index 0000000..e905cce
--- /dev/null
+++ b/src/Language/GraphQL/Execute/OrderedMap.hs
@@ -0,0 +1,148 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE ExplicitForAll #-}
+
+-- | This module contains a map data structure, that preserves insertion order.
+-- Some definitions conflict with functions from prelude, so this module should
+-- probably be imported qualified.
+module Language.GraphQL.Execute.OrderedMap
+    ( OrderedMap
+    , elems
+    , empty
+    , insert
+    , foldlWithKey'
+    , keys
+    , lookup
+    , replace
+    , singleton
+    , size
+    , toList
+    , traverseMaybe
+    ) where
+
+import qualified Data.Foldable as Foldable
+import Data.HashMap.Strict (HashMap, (!))
+import qualified Data.HashMap.Strict as HashMap
+import Data.Text (Text)
+import Data.Vector (Vector)
+import qualified Data.Vector as Vector
+import Prelude hiding (filter, lookup)
+
+-- | This map associates values with the given text keys. Insertion order is
+-- preserved. When inserting a value with a key, that is already available in
+-- the map, the existing value isn't overridden, but combined with the new value
+-- using its 'Semigroup' instance.
+--
+-- Internally this map uses an array with keys to preserve the order and an
+-- unorded map with key-value pairs.
+data OrderedMap v = OrderedMap (Vector Text) (HashMap Text v)
+    deriving (Eq)
+
+instance Functor OrderedMap where
+    fmap f (OrderedMap vector hashMap) = OrderedMap vector $ fmap f hashMap
+
+instance Foldable OrderedMap where
+    foldr f = foldrWithKey $ const f
+    null (OrderedMap vector _) = Vector.null vector
+
+instance Semigroup v => Semigroup (OrderedMap v) where
+    (<>) = foldlWithKey'
+        $ \accumulator key value -> insert key value accumulator
+
+instance Semigroup v => Monoid (OrderedMap v) where
+    mempty = empty
+
+instance Traversable OrderedMap where
+    traverse f (OrderedMap vector hashMap) = OrderedMap vector
+        <$> traverse f hashMap
+
+instance Show v => Show (OrderedMap v) where
+    showsPrec precedence map' = showParen (precedence > 10)
+        $ showString "fromList " . shows (toList map')
+
+-- * Construction
+
+-- | Constructs a map with a single element.
+singleton :: forall v. Text -> v -> OrderedMap v
+singleton key value = OrderedMap (Vector.singleton key)
+    $ HashMap.singleton key value
+
+-- | Constructs an empty map.
+empty :: forall v. OrderedMap v
+empty = OrderedMap mempty mempty
+
+-- * Traversal
+
+-- | Reduces this map by applying a binary operator from right to left to all
+-- elements, using the given starting value.
+foldrWithKey :: forall v a. (Text -> v -> a -> a) -> a -> OrderedMap v -> a
+foldrWithKey f initial (OrderedMap vector hashMap) = foldr go initial vector
+  where
+    go key = f key (hashMap ! key)
+
+-- | Reduces this map by applying a binary operator from left to right to all
+-- elements, using the given starting value.
+foldlWithKey' :: forall v a. (a -> Text -> v -> a) -> a -> OrderedMap v -> a
+foldlWithKey' f initial (OrderedMap vector hashMap) =
+    Vector.foldl' go initial vector
+  where
+    go accumulator key = f accumulator key (hashMap ! key)
+
+-- | Traverse over the elements and collect the 'Just' results.
+traverseMaybe
+    :: Applicative f
+    => forall a
+    . (a -> f (Maybe b))
+    -> OrderedMap a
+    -> f (OrderedMap b)
+traverseMaybe f orderedMap = foldlWithKey' filter empty
+    <$> traverse f orderedMap
+  where
+    filter accumulator key (Just value) = replace key value accumulator
+    filter accumulator _ Nothing = accumulator
+
+-- * Lists
+
+-- | Converts this map to the list of key-value pairs.
+toList :: forall v. OrderedMap v -> [(Text, v)]
+toList = foldrWithKey ((.) (:) . (,)) []
+
+-- | Returns a list with all keys in this map.
+keys :: forall v. OrderedMap v -> [Text]
+keys (OrderedMap vector _) = Foldable.toList vector
+
+-- | Returns a list with all elements in this map.
+elems :: forall v. OrderedMap v -> [v]
+elems = fmap snd . toList
+
+-- * Basic interface
+
+-- | Associates the specified value with the specified key in this map. If this
+-- map previously contained a mapping for the key, the existing and new values
+-- are combined.
+insert :: Semigroup v => Text -> v -> OrderedMap v -> OrderedMap v
+insert key value (OrderedMap vector hashMap)
+    | Just available <- HashMap.lookup key hashMap = OrderedMap vector
+        $ HashMap.insert key (available <> value) 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
+
+-- | Looks up a value in this map by key.
+lookup :: forall v. Text -> OrderedMap v -> Maybe v
+lookup key (OrderedMap _ hashMap) = HashMap.lookup key hashMap