{- 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 (OrderedMap v -> OrderedMap v -> Bool
(OrderedMap v -> OrderedMap v -> Bool)
-> (OrderedMap v -> OrderedMap v -> Bool) -> Eq (OrderedMap v)
forall v. Eq v => OrderedMap v -> OrderedMap v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderedMap v -> OrderedMap v -> Bool
$c/= :: forall v. Eq v => OrderedMap v -> OrderedMap v -> Bool
== :: OrderedMap v -> OrderedMap v -> Bool
$c== :: forall v. Eq v => OrderedMap v -> OrderedMap v -> Bool
Eq)

instance Functor OrderedMap where
    fmap :: (a -> b) -> OrderedMap a -> OrderedMap b
fmap a -> b
f (OrderedMap Vector Text
vector HashMap Text a
hashMap) = Vector Text -> HashMap Text b -> OrderedMap b
forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap Vector Text
vector (HashMap Text b -> OrderedMap b) -> HashMap Text b -> OrderedMap b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> HashMap Text a -> HashMap Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f HashMap Text a
hashMap

instance Foldable OrderedMap where
    foldr :: (a -> b -> b) -> b -> OrderedMap a -> b
foldr a -> b -> b
f = (Text -> a -> b -> b) -> b -> OrderedMap a -> b
forall v a. (Text -> v -> a -> a) -> a -> OrderedMap v -> a
foldrWithKey ((Text -> a -> b -> b) -> b -> OrderedMap a -> b)
-> (Text -> a -> b -> b) -> b -> OrderedMap a -> b
forall a b. (a -> b) -> a -> b
$ (a -> b -> b) -> Text -> a -> b -> b
forall a b. a -> b -> a
const a -> b -> b
f
    null :: OrderedMap a -> Bool
null (OrderedMap Vector Text
vector HashMap Text a
_) = Vector Text -> Bool
forall a. Vector a -> Bool
Vector.null Vector Text
vector

instance Semigroup v => Semigroup (OrderedMap v) where
    <> :: OrderedMap v -> OrderedMap v -> OrderedMap v
(<>) = (OrderedMap v -> Text -> v -> OrderedMap v)
-> OrderedMap v -> OrderedMap v -> OrderedMap v
forall v a. (a -> Text -> v -> a) -> a -> OrderedMap v -> a
foldlWithKey'
        ((OrderedMap v -> Text -> v -> OrderedMap v)
 -> OrderedMap v -> OrderedMap v -> OrderedMap v)
-> (OrderedMap v -> Text -> v -> OrderedMap v)
-> OrderedMap v
-> OrderedMap v
-> OrderedMap v
forall a b. (a -> b) -> a -> b
$ \OrderedMap v
accumulator Text
key v
value -> Text -> v -> OrderedMap v -> OrderedMap v
forall v. Semigroup v => Text -> v -> OrderedMap v -> OrderedMap v
insert Text
key v
value OrderedMap v
accumulator

instance Semigroup v => Monoid (OrderedMap v) where
    mempty :: OrderedMap v
mempty = OrderedMap v
forall v. OrderedMap v
empty

instance Traversable OrderedMap where
    traverse :: (a -> f b) -> OrderedMap a -> f (OrderedMap b)
traverse a -> f b
f (OrderedMap Vector Text
vector HashMap Text a
hashMap) = Vector Text -> HashMap Text b -> OrderedMap b
forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap Vector Text
vector
        (HashMap Text b -> OrderedMap b)
-> f (HashMap Text b) -> f (OrderedMap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> HashMap Text a -> f (HashMap Text b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f HashMap Text a
hashMap

instance Show v => Show (OrderedMap v) where
    showsPrec :: Int -> OrderedMap v -> ShowS
showsPrec Int
precedence OrderedMap v
map' = Bool -> ShowS -> ShowS
showParen (Int
precedence Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, v)] -> ShowS
forall a. Show a => a -> ShowS
shows (OrderedMap v -> [(Text, v)]
forall v. OrderedMap v -> [(Text, v)]
toList OrderedMap v
map')

-- * Construction

-- | Constructs a map with a single element.
singleton :: forall v. Text -> v -> OrderedMap v
singleton :: Text -> v -> OrderedMap v
singleton Text
key v
value = Vector Text -> HashMap Text v -> OrderedMap v
forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap (Text -> Vector Text
forall a. a -> Vector a
Vector.singleton Text
key)
    (HashMap Text v -> OrderedMap v) -> HashMap Text v -> OrderedMap v
forall a b. (a -> b) -> a -> b
$ Text -> v -> HashMap Text v
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
key v
value

-- | Constructs an empty map.
empty :: forall v. OrderedMap v
empty :: OrderedMap v
empty = Vector Text -> HashMap Text v -> OrderedMap v
forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap Vector Text
forall a. Monoid a => a
mempty HashMap Text v
forall a. Monoid a => a
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 :: (Text -> v -> a -> a) -> a -> OrderedMap v -> a
foldrWithKey Text -> v -> a -> a
f a
initial (OrderedMap Vector Text
vector HashMap Text v
hashMap) = (Text -> a -> a) -> a -> Vector Text -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> a -> a
go a
initial Vector Text
vector
  where
    go :: Text -> a -> a
go Text
key = Text -> v -> a -> a
f Text
key (HashMap Text v
hashMap HashMap Text v -> Text -> v
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
! Text
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' :: (a -> Text -> v -> a) -> a -> OrderedMap v -> a
foldlWithKey' a -> Text -> v -> a
f a
initial (OrderedMap Vector Text
vector HashMap Text v
hashMap) =
    (a -> Text -> a) -> a -> Vector Text -> a
forall a b. (a -> b -> a) -> a -> Vector b -> a
Vector.foldl' a -> Text -> a
go a
initial Vector Text
vector
  where
    go :: a -> Text -> a
go a
accumulator Text
key = a -> Text -> v -> a
f a
accumulator Text
key (HashMap Text v
hashMap HashMap Text v -> Text -> v
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
! Text
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 :: forall a. (a -> f (Maybe b)) -> OrderedMap a -> f (OrderedMap b)
traverseMaybe a -> f (Maybe b)
f OrderedMap a
orderedMap = (OrderedMap b -> Text -> Maybe b -> OrderedMap b)
-> OrderedMap b -> OrderedMap (Maybe b) -> OrderedMap b
forall v a. (a -> Text -> v -> a) -> a -> OrderedMap v -> a
foldlWithKey' OrderedMap b -> Text -> Maybe b -> OrderedMap b
forall v. OrderedMap v -> Text -> Maybe v -> OrderedMap v
filter OrderedMap b
forall v. OrderedMap v
empty
    (OrderedMap (Maybe b) -> OrderedMap b)
-> f (OrderedMap (Maybe b)) -> f (OrderedMap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f (Maybe b)) -> OrderedMap a -> f (OrderedMap (Maybe b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f (Maybe b)
f OrderedMap a
orderedMap
  where
    filter :: OrderedMap v -> Text -> Maybe v -> OrderedMap v
filter OrderedMap v
accumulator Text
key (Just v
value) = Text -> v -> OrderedMap v -> OrderedMap v
forall v. Text -> v -> OrderedMap v -> OrderedMap v
replace Text
key v
value OrderedMap v
accumulator
    filter OrderedMap v
accumulator Text
_ Maybe v
Nothing = OrderedMap v
accumulator

-- * Lists

-- | Converts this map to the list of key-value pairs.
toList :: forall v. OrderedMap v -> [(Text, v)]
toList :: OrderedMap v -> [(Text, v)]
toList = (Text -> v -> [(Text, v)] -> [(Text, v)])
-> [(Text, v)] -> OrderedMap v -> [(Text, v)]
forall v a. (Text -> v -> a -> a) -> a -> OrderedMap v -> a
foldrWithKey (((Text, v) -> [(Text, v)] -> [(Text, v)])
-> (v -> (Text, v)) -> v -> [(Text, v)] -> [(Text, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (:) ((v -> (Text, v)) -> v -> [(Text, v)] -> [(Text, v)])
-> (Text -> v -> (Text, v))
-> Text
-> v
-> [(Text, v)]
-> [(Text, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,)) []

-- | Returns a list with all keys in this map.
keys :: forall v. OrderedMap v -> [Text]
keys :: OrderedMap v -> [Text]
keys (OrderedMap Vector Text
vector HashMap Text v
_) = Vector Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Vector Text
vector

-- | Returns a list with all elements in this map.
elems :: forall v. OrderedMap v -> [v]
elems :: OrderedMap v -> [v]
elems = ((Text, v) -> v) -> [(Text, v)] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, v) -> v
forall a b. (a, b) -> b
snd ([(Text, v)] -> [v])
-> (OrderedMap v -> [(Text, v)]) -> OrderedMap v -> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrderedMap v -> [(Text, v)]
forall v. OrderedMap v -> [(Text, v)]
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 :: Text -> v -> OrderedMap v -> OrderedMap v
insert Text
key v
value (OrderedMap Vector Text
vector HashMap Text v
hashMap)
    | Just v
available <- Text -> HashMap Text v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
key HashMap Text v
hashMap = Vector Text -> HashMap Text v -> OrderedMap v
forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap Vector Text
vector
        (HashMap Text v -> OrderedMap v) -> HashMap Text v -> OrderedMap v
forall a b. (a -> b) -> a -> b
$ Text -> v -> HashMap Text v -> HashMap Text v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
key (v
available v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
value) HashMap Text v
hashMap
    | Bool
otherwise = Vector Text -> HashMap Text v -> OrderedMap v
forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap (Vector Text -> Text -> Vector Text
forall a. Vector a -> a -> Vector a
Vector.snoc Vector Text
vector Text
key)
        (HashMap Text v -> OrderedMap v) -> HashMap Text v -> OrderedMap v
forall a b. (a -> b) -> a -> b
$ Text -> v -> HashMap Text v -> HashMap Text v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
key v
value HashMap Text v
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 :: Text -> v -> OrderedMap v -> OrderedMap v
replace Text
key v
value (OrderedMap Vector Text
vector HashMap Text v
hashMap)
    | Text -> HashMap Text v -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
key HashMap Text v
hashMap = Vector Text -> HashMap Text v -> OrderedMap v
forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap Vector Text
vector
        (HashMap Text v -> OrderedMap v) -> HashMap Text v -> OrderedMap v
forall a b. (a -> b) -> a -> b
$ Text -> v -> HashMap Text v -> HashMap Text v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
key v
value HashMap Text v
hashMap
    | Bool
otherwise = Vector Text -> HashMap Text v -> OrderedMap v
forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap (Vector Text -> Text -> Vector Text
forall a. Vector a -> a -> Vector a
Vector.snoc Vector Text
vector Text
key)
        (HashMap Text v -> OrderedMap v) -> HashMap Text v -> OrderedMap v
forall a b. (a -> b) -> a -> b
$ Text -> v -> HashMap Text v -> HashMap Text v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
key v
value HashMap Text v
hashMap

-- | Gives the size of this map, i.e. number of elements in it.
size :: forall v. OrderedMap v -> Int
size :: OrderedMap v -> Int
size (OrderedMap Vector Text
vector HashMap Text v
_) = Vector Text -> Int
forall a. Vector a -> Int
Vector.length Vector Text
vector

-- | Looks up a value in this map by key.
lookup :: forall v. Text -> OrderedMap v -> Maybe v
lookup :: Text -> OrderedMap v -> Maybe v
lookup Text
key (OrderedMap Vector Text
_ HashMap Text v
hashMap) = Text -> HashMap Text v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
key HashMap Text v
hashMap