{- 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
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 :: forall a b. (a -> b) -> OrderedMap a -> OrderedMap b
fmap a -> b
f (OrderedMap Vector Text
vector HashMap Text a
hashMap) = forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap Vector Text
vector forall a b. (a -> b) -> a -> 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 :: forall a b. (a -> b -> b) -> b -> OrderedMap a -> b
foldr a -> b -> b
f = forall v a. (Text -> v -> a -> a) -> a -> OrderedMap v -> a
foldrWithKey forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const a -> b -> b
f
    null :: forall a. OrderedMap a -> Bool
null (OrderedMap Vector Text
vector HashMap Text a
_) = forall a. Vector a -> Bool
Vector.null Vector Text
vector

instance Semigroup v => Semigroup (OrderedMap v) where
    <> :: OrderedMap v -> OrderedMap v -> OrderedMap v
(<>) = forall v a. (a -> Text -> v -> a) -> a -> OrderedMap v -> a
foldlWithKey'
        forall a b. (a -> b) -> a -> b
$ \OrderedMap v
accumulator Text
key v
value -> 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 = forall v. OrderedMap v
empty

instance Traversable OrderedMap where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrderedMap a -> f (OrderedMap b)
traverse a -> f b
f (OrderedMap Vector Text
vector HashMap Text a
hashMap) = forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap Vector Text
vector
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 forall a. Ord a => a -> a -> Bool
> Int
10)
        forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (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 :: forall v. Text -> v -> OrderedMap v
singleton Text
key v
value = forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap (forall a. a -> Vector a
Vector.singleton Text
key)
    forall a b. (a -> b) -> a -> b
$ 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 :: forall v. OrderedMap v
empty = forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap forall a. Monoid a => a
mempty 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 :: forall v a. (Text -> v -> a -> a) -> a -> OrderedMap v -> a
foldrWithKey Text -> v -> a -> a
f a
initial (OrderedMap Vector Text
vector HashMap Text v
hashMap) = 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 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' :: forall v a. (a -> Text -> v -> a) -> a -> OrderedMap v -> a
foldlWithKey' a -> Text -> v -> a
f a
initial (OrderedMap Vector Text
vector HashMap Text v
hashMap) =
    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 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 (f :: * -> *) b a.
Applicative f =>
(a -> f (Maybe b)) -> OrderedMap a -> f (OrderedMap b)
traverseMaybe a -> f (Maybe b)
f OrderedMap a
orderedMap = forall v a. (a -> Text -> v -> a) -> a -> OrderedMap v -> a
foldlWithKey' forall {v}. OrderedMap v -> Text -> Maybe v -> OrderedMap v
filter forall v. OrderedMap v
empty
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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) = 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 :: forall v. OrderedMap v -> [(Text, v)]
toList = forall v a. (Text -> v -> a -> a) -> a -> OrderedMap v -> a
foldrWithKey (forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (:) 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 :: forall v. OrderedMap v -> [Text]
keys (OrderedMap Vector Text
vector HashMap Text v
_) = 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 :: forall a. OrderedMap a -> [a]
elems = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall v. Semigroup v => Text -> v -> OrderedMap v -> OrderedMap v
insert Text
key v
value (OrderedMap Vector Text
vector HashMap Text v
hashMap)
    | Just v
available <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
key HashMap Text v
hashMap = forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap Vector Text
vector
        forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
key (v
available forall a. Semigroup a => a -> a -> a
<> v
value) HashMap Text v
hashMap
    | Bool
otherwise = forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap (forall a. Vector a -> a -> Vector a
Vector.snoc Vector Text
vector Text
key)
        forall a b. (a -> b) -> a -> b
$ 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 :: forall v. Text -> v -> OrderedMap v -> OrderedMap v
replace Text
key v
value (OrderedMap Vector Text
vector HashMap Text v
hashMap)
    | forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
key HashMap Text v
hashMap = forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap Vector Text
vector
        forall a b. (a -> b) -> a -> b
$ 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 = forall v. Vector Text -> HashMap Text v -> OrderedMap v
OrderedMap (forall a. Vector a -> a -> Vector a
Vector.snoc Vector Text
vector Text
key)
        forall a b. (a -> b) -> a -> b
$ 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 :: forall a. OrderedMap a -> Int
size (OrderedMap Vector Text
vector HashMap Text v
_) = 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 :: forall v. Text -> OrderedMap v -> Maybe v
lookup Text
key (OrderedMap Vector Text
_ HashMap Text v
hashMap) = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
key HashMap Text v
hashMap