Add OrderedMap prototype

This commit is contained in:
Eugen Wissner 2021-02-13 06:56:10 +01:00
parent 1e8405a6d6
commit c1a1b47aea
4 changed files with 87 additions and 1 deletions

View File

@ -4,7 +4,7 @@ cabal-version: 2.2
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: 15a0880180192f918ba0bd3b3e955c57232f1efe8993745d505fcb6e1aab1451 -- hash: dcf3c9aaaaef892c7f75781a0c181c77477fc5bb2757704494c398b99f7fb1c7
name: graphql name: graphql
version: 0.11.1.0 version: 0.11.1.0
@ -43,6 +43,7 @@ library
Language.GraphQL.Error Language.GraphQL.Error
Language.GraphQL.Execute Language.GraphQL.Execute
Language.GraphQL.Execute.Coerce Language.GraphQL.Execute.Coerce
Language.GraphQL.Execute.OrderedMap
Language.GraphQL.Type Language.GraphQL.Type
Language.GraphQL.Type.In Language.GraphQL.Type.In
Language.GraphQL.Type.Out Language.GraphQL.Type.Out
@ -72,6 +73,7 @@ library
, text , text
, transformers , transformers
, unordered-containers , unordered-containers
, vector
default-language: Haskell2010 default-language: Haskell2010
test-suite graphql-test test-suite graphql-test
@ -84,6 +86,7 @@ test-suite graphql-test
Language.GraphQL.AST.ParserSpec Language.GraphQL.AST.ParserSpec
Language.GraphQL.ErrorSpec Language.GraphQL.ErrorSpec
Language.GraphQL.Execute.CoerceSpec Language.GraphQL.Execute.CoerceSpec
Language.GraphQL.Execute.OrderedMapSpec
Language.GraphQL.ExecuteSpec Language.GraphQL.ExecuteSpec
Language.GraphQL.Type.OutSpec Language.GraphQL.Type.OutSpec
Language.GraphQL.Validate.RulesSpec Language.GraphQL.Validate.RulesSpec
@ -114,4 +117,5 @@ test-suite graphql-test
, text , text
, transformers , transformers
, unordered-containers , unordered-containers
, vector
default-language: Haskell2010 default-language: Haskell2010

View File

@ -38,6 +38,7 @@ dependencies:
- text - text
- transformers - transformers
- unordered-containers - unordered-containers
- vector
library: library:
source-dirs: src source-dirs: src

View File

@ -0,0 +1,64 @@
{- 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 #-}
module Language.GraphQL.Execute.OrderedMap
( OrderedMap
, singleton
) where
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
data OrderedMap v = OrderedMap (Vector Text) (HashMap Text v)
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 Show v => Show (OrderedMap v) where
showsPrec precedence map' = showParen (precedence > 10)
$ showString "fromList " . shows (toList map')
instance Semigroup (OrderedMap v) where
(<>) = foldrWithKey go
where
go key value accumulator@(OrderedMap vector hashMap)
| Nothing <- HashMap.lookup key hashMap
= OrderedMap (Vector.snoc vector key)
$ HashMap.insert key value hashMap
| otherwise = accumulator
instance Monoid (OrderedMap v) where
mempty = OrderedMap mempty mempty
-- * 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
-- * Folds
-- | Reduces this map by applying a binary operator 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 accumulator = f key (hashMap HashMap.! key) accumulator
-- * Lists
-- | Converts this map to the list of key-value pairs.
toList :: forall v. OrderedMap v -> [(Text, v)]
toList = foldrWithKey f []
where
f key value accumulator = (key, value) : accumulator

View File

@ -0,0 +1,17 @@
{- 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 OverloadedStrings #-}
module Language.GraphQL.Execute.OrderedMapSpec
( spec
) where
import Language.GraphQL.Execute.OrderedMap (OrderedMap)
import Test.Hspec (Spec, describe, it, shouldSatisfy)
spec :: Spec
spec =
describe "OrderedMap" $
it "creates an empty map" $
(mempty :: OrderedMap Int) `shouldSatisfy` null