{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_HADDOCK not-home #-}
module GraphQL.Internal.OrderedMap
( OrderedMap
, empty
, singleton
, orderedMap
, lookup
, GraphQL.Internal.OrderedMap.catMaybes
, unions
, unionWith
, unionsWith
, unionWithM
, unionsWithM
, toList
, toMap
, keys
, values
, genOrderedMap
) where
import Protolude hiding (empty, toList)
import qualified Data.Map as Map
import Test.QuickCheck (Arbitrary(..), Gen, listOf)
data OrderedMap key value
= OrderedMap
{
keys :: [key]
, toMap :: Map key value
}
deriving (Eq, Ord, Show)
toList :: forall key value. Ord key => OrderedMap key value -> [(key, value)]
toList (OrderedMap keys entries) = Protolude.catMaybes (foreach keys $ \k -> (,) k <$> Map.lookup k entries)
instance Foldable (OrderedMap key) where
foldr f z (OrderedMap _ entries) = foldr f z entries
instance Traversable (OrderedMap key) where
traverse f (OrderedMap keys entries) = OrderedMap keys <$> traverse f entries
instance Functor (OrderedMap key) where
fmap f (OrderedMap keys entries) = OrderedMap keys (map f entries)
instance (Arbitrary key, Arbitrary value, Ord key) => Arbitrary (OrderedMap key value) where
arbitrary = genOrderedMap arbitrary arbitrary
genOrderedMap :: forall key value. Ord key => Gen key -> Gen value -> Gen (OrderedMap key value)
genOrderedMap genKey genValue = do
entries <- Map.fromList <$> (zip <$> listOf genKey <*> listOf genValue)
pure (OrderedMap (Map.keys entries) entries)
empty :: forall key value. OrderedMap key value
empty = OrderedMap [] Map.empty
singleton :: forall key value. key -> value -> OrderedMap key value
singleton key value = OrderedMap [key] (Map.singleton key value)
lookup :: forall key value. Ord key => key -> OrderedMap key value -> Maybe value
lookup key (OrderedMap _ entries) = Map.lookup key entries
values :: forall key value. Ord key => OrderedMap key value -> [value]
values = map snd . toList
unions :: forall key value. Ord key => [OrderedMap key value] -> Maybe (OrderedMap key value)
unions orderedMaps = orderedMap (orderedMaps >>= toList)
unionWith :: Ord key
=> (value -> value -> value)
-> OrderedMap key value
-> OrderedMap key value
-> OrderedMap key value
unionWith f x y =
OrderedMap
{ toMap = Map.unionWith f (toMap x) (toMap y)
, keys = keys x <> [k | k <- keys y, k `Map.notMember` toMap x]
}
unionsWith :: Ord key
=> (value -> value -> value)
-> [OrderedMap key value]
-> OrderedMap key value
unionsWith f = foldl' (unionWith f) empty
unionWithM :: (Monad m, Ord key)
=> (value -> value -> m value)
-> OrderedMap key value
-> OrderedMap key value
-> m (OrderedMap key value)
unionWithM f x y = sequenceA (unionWith (liftMM f) (map pure x) (map pure y))
unionsWithM :: (Monad m, Ord key)
=> (value -> value -> m value)
-> [OrderedMap key value]
-> m (OrderedMap key value)
unionsWithM f xs = sequenceA (unionsWith (liftMM f) (map (map pure) xs))
liftMM :: Monad m => (a -> b -> m c) -> m a -> m b -> m c
liftMM f a' b' = do
(a, b) <- (,) <$> a' <*> b'
f a b
catMaybes :: Ord key => OrderedMap key (Maybe value) -> OrderedMap key value
catMaybes xs =
OrderedMap
{ keys = [ k | k <- keys xs, k `Map.member` newMap ]
, toMap = newMap
}
where
newMap = Map.mapMaybe identity (toMap xs)
orderedMap :: forall key value. Ord key => [(key, value)] -> Maybe (OrderedMap key value)
orderedMap entries
| ks == ordNub ks = Just (OrderedMap ks (Map.fromList entries))
| otherwise = Nothing
where
ks = map fst entries