module Data.NonEmpty.Map (
   T,
   insert,
   insertWith,
   singleton,
   member,
   size,
   elems,
   keys,
   keysSet,
   lookup,
   delete,
   minViewWithKey,
   maxViewWithKey,
   fromList,
   fromListWith,
   fromAscList,
   toAscList,
   fetch,
   flatten,
   union,
   unionLeft,
   unionRight,
   unionWith,
   unionLeftWith,
   unionRightWith,
   map,
   mapWithKey,
   ) where

import qualified Data.NonEmpty.Set as NonEmptySet
import qualified Data.NonEmpty.Class as C
import qualified Data.NonEmpty as NonEmpty

import qualified Data.Map as Map
import Data.Map (Map, )

import Control.Monad (mzero, )
import Control.Applicative (liftA2, liftA3)
import Control.DeepSeq (NFData, rnf, )
import Data.Traversable (Traversable, traverse, )
import Data.Foldable (Foldable, foldMap, )
import Data.Monoid (mappend, )
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Tuple.HT (forcePair, mapSnd, )
import Data.Ord.HT (comparing, )

import qualified Test.QuickCheck as QC

import Prelude hiding (map, lookup, )


{- $setup
>>> import qualified Data.NonEmpty.Map as NonEmptyMap
>>> import qualified Data.NonEmpty as NonEmpty
>>> import qualified Data.Map as Map
>>> import qualified Test.QuickCheck as QC
>>>
>>> forAllMap :: (QC.Testable test) => (Map.Map Int String -> test) -> QC.Property
>>> forAllMap = QC.forAll (fmap Map.fromList QC.arbitrary)
>>>
>>> forAllNonEmptyMap :: (QC.Testable test) => (NonEmptyMap.T Int String -> test) -> QC.Property
>>> forAllNonEmptyMap = QC.forAll (fmap NonEmptyMap.fromList QC.arbitrary)
-}

{-
The first field will always contain the smallest element.
-}
data T k a = Cons (k, a) (Map k a)
   deriving (T k a -> T k a -> Bool
(T k a -> T k a -> Bool) -> (T k a -> T k a -> Bool) -> Eq (T k a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k a. (Eq k, Eq a) => T k a -> T k a -> Bool
/= :: T k a -> T k a -> Bool
$c/= :: forall k a. (Eq k, Eq a) => T k a -> T k a -> Bool
== :: T k a -> T k a -> Bool
$c== :: forall k a. (Eq k, Eq a) => T k a -> T k a -> Bool
Eq, Eq (T k a)
Eq (T k a)
-> (T k a -> T k a -> Ordering)
-> (T k a -> T k a -> Bool)
-> (T k a -> T k a -> Bool)
-> (T k a -> T k a -> Bool)
-> (T k a -> T k a -> Bool)
-> (T k a -> T k a -> T k a)
-> (T k a -> T k a -> T k a)
-> Ord (T k a)
T k a -> T k a -> Bool
T k a -> T k a -> Ordering
T k a -> T k a -> T k a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k a. (Ord k, Ord a) => Eq (T k a)
forall k a. (Ord k, Ord a) => T k a -> T k a -> Bool
forall k a. (Ord k, Ord a) => T k a -> T k a -> Ordering
forall k a. (Ord k, Ord a) => T k a -> T k a -> T k a
min :: T k a -> T k a -> T k a
$cmin :: forall k a. (Ord k, Ord a) => T k a -> T k a -> T k a
max :: T k a -> T k a -> T k a
$cmax :: forall k a. (Ord k, Ord a) => T k a -> T k a -> T k a
>= :: T k a -> T k a -> Bool
$c>= :: forall k a. (Ord k, Ord a) => T k a -> T k a -> Bool
> :: T k a -> T k a -> Bool
$c> :: forall k a. (Ord k, Ord a) => T k a -> T k a -> Bool
<= :: T k a -> T k a -> Bool
$c<= :: forall k a. (Ord k, Ord a) => T k a -> T k a -> Bool
< :: T k a -> T k a -> Bool
$c< :: forall k a. (Ord k, Ord a) => T k a -> T k a -> Bool
compare :: T k a -> T k a -> Ordering
$ccompare :: forall k a. (Ord k, Ord a) => T k a -> T k a -> Ordering
$cp1Ord :: forall k a. (Ord k, Ord a) => Eq (T k a)
Ord)

instance (Show k, Show a) => Show (T k a) where
   showsPrec :: Int -> T k a -> ShowS
showsPrec Int
p T k a
xs =
      Bool -> ShowS -> ShowS
showParen (Int
pInt -> 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
"NonEmptyMap.fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         Int -> T [] (k, a) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (T k a -> T [] (k, a)
forall k a. T k a -> T [] (k, a)
toAscList T k a
xs)

instance (Ord k) => Functor (T k) where
   fmap :: (a -> b) -> T k a -> T k b
fmap = (a -> b) -> T k a -> T k b
forall k a b. Ord k => (a -> b) -> T k a -> T k b
map

instance (Ord k) => Foldable (T k) where
   foldMap :: (a -> m) -> T k a -> m
foldMap a -> m
f (Cons (k, a)
x Map k a
xs) = m -> m -> m
forall a. Monoid a => a -> a -> a
mappend (a -> m
f ((k, a) -> a
forall a b. (a, b) -> b
snd (k, a)
x)) ((a -> m) -> Map k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Map k a
xs)

instance (Ord k) => Traversable (T k) where
   traverse :: (a -> f b) -> T k a -> f (T k b)
traverse a -> f b
f (Cons (k, a)
x Map k a
xs) =
      ((k, b) -> Map k b -> T k b)
-> f (k, b) -> f (Map k b) -> f (T k b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (k, b) -> Map k b -> T k b
forall k a. (k, a) -> Map k a -> T k a
Cons ((b -> (k, b)) -> f b -> f (k, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) ((k, a) -> k
forall a b. (a, b) -> a
fst (k, a)
x)) (f b -> f (k, b)) -> f b -> f (k, b)
forall a b. (a -> b) -> a -> b
$ a -> f b
f ((k, a) -> a
forall a b. (a, b) -> b
snd (k, a)
x)) ((a -> f b) -> Map k a -> f (Map k b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Map k a
xs)

instance (NFData k, NFData a) => NFData (T k a) where
   rnf :: T k a -> ()
rnf = T k a -> ()
forall (f :: * -> *) a. (NFData f, NFData a) => f a -> ()
C.rnf

instance (NFData k) => C.NFData (T k) where
   rnf :: T k a -> ()
rnf (Cons (k, a)
x Map k a
xs) = ((k, a), ()) -> ()
forall a. NFData a => a -> ()
rnf ((k, a)
x, Map k a -> ()
forall (f :: * -> *) a. (NFData f, NFData a) => f a -> ()
C.rnf Map k a
xs)

instance (QC.Arbitrary k, Ord k, QC.Arbitrary a) => QC.Arbitrary (T k a) where
   arbitrary :: Gen (T k a)
arbitrary = Gen (T k a)
forall (f :: * -> *) a. (Arbitrary f, Arbitrary a) => Gen (f a)
C.arbitrary
   shrink :: T k a -> [T k a]
shrink = T k a -> [T k a]
forall (f :: * -> *) a. (Arbitrary f, Arbitrary a) => f a -> [f a]
C.shrink

instance (QC.Arbitrary k, Ord k) => C.Arbitrary (T k) where
   arbitrary :: Gen (T k a)
arbitrary = (k -> a -> Map k a -> T k a)
-> Gen k -> Gen a -> Gen (Map k a) -> Gen (T k a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 k -> a -> Map k a -> T k a
forall k a. Ord k => k -> a -> Map k a -> T k a
insert Gen k
forall a. Arbitrary a => Gen a
QC.arbitrary Gen a
forall a. Arbitrary a => Gen a
QC.arbitrary Gen (Map k a)
forall a. Arbitrary a => Gen a
QC.arbitrary
   shrink :: T k a -> [T k a]
shrink = (Map k a -> Maybe (T k a)) -> [Map k a] -> [T k a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Map k a -> Maybe (T k a)
forall k a. Ord k => Map k a -> Maybe (T k a)
fetch ([Map k a] -> [T k a]) -> (T k a -> [Map k a]) -> T k a -> [T k a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> [Map k a]
forall a. Arbitrary a => a -> [a]
QC.shrink (Map k a -> [Map k a]) -> (T k a -> Map k a) -> T k a -> [Map k a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T k a -> Map k a
forall k a. Ord k => T k a -> Map k a
flatten

instance (QC.Arbitrary k, Ord k) => C.Gen (T k) where
   genOf :: Gen a -> Gen (T k a)
genOf Gen a
gen = (k -> a -> Map k a -> T k a)
-> Gen k -> Gen a -> Gen (Map k a) -> Gen (T k a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 k -> a -> Map k a -> T k a
forall k a. Ord k => k -> a -> Map k a -> T k a
insert Gen k
forall a. Arbitrary a => Gen a
QC.arbitrary Gen a
gen (Gen (Map k a) -> Gen (T k a)) -> Gen (Map k a) -> Gen (T k a)
forall a b. (a -> b) -> a -> b
$ Gen a -> Gen (Map k a)
forall (f :: * -> *) a. Gen f => Gen a -> Gen (f a)
C.genOf Gen a
gen


-- | prop> \k a -> forAllMap $ \m -> Map.insert k a m == NonEmptyMap.flatten (NonEmptyMap.insert k a m)
insert :: Ord k => k -> a -> Map k a -> T k a
insert :: k -> a -> Map k a -> T k a
insert = ((k, a) -> Map k a -> T k a) -> k -> a -> Map k a -> T k a
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((k, a) -> Map k a -> T k a) -> k -> a -> Map k a -> T k a)
-> ((k, a) -> Map k a -> T k a) -> k -> a -> Map k a -> T k a
forall a b. (a -> b) -> a -> b
$ (k -> a -> Map k a -> Map k a)
-> (((k, a), (k, a)) -> (k, a)) -> (k, a) -> Map k a -> T k a
forall k a.
Ord k =>
(k -> a -> Map k a -> Map k a)
-> (((k, a), (k, a)) -> (k, a)) -> (k, a) -> Map k a -> T k a
insertGen k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ((k, a), (k, a)) -> (k, a)
forall a b. (a, b) -> a
fst

-- | prop> \k a -> forAllMap $ \m -> Map.insertWith (++) k a m == NonEmptyMap.flatten (NonEmptyMap.insertWith (++) k a m)
insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> T k a
insertWith :: (a -> a -> a) -> k -> a -> Map k a -> T k a
insertWith a -> a -> a
f = ((k, a) -> Map k a -> T k a) -> k -> a -> Map k a -> T k a
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((k, a) -> Map k a -> T k a) -> k -> a -> Map k a -> T k a)
-> ((k, a) -> Map k a -> T k a) -> k -> a -> Map k a -> T k a
forall a b. (a -> b) -> a -> b
$ (k -> a -> Map k a -> Map k a)
-> (((k, a), (k, a)) -> (k, a)) -> (k, a) -> Map k a -> T k a
forall k a.
Ord k =>
(k -> a -> Map k a -> Map k a)
-> (((k, a), (k, a)) -> (k, a)) -> (k, a) -> Map k a -> T k a
insertGen ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith a -> a -> a
f) ((a -> a -> a) -> ((k, a), (k, a)) -> (k, a)
forall a k. (a -> a -> a) -> ((k, a), (k, a)) -> (k, a)
applyFst a -> a -> a
f)

applyFst :: (a -> a -> a) -> ((k,a), (k,a)) -> (k,a)
applyFst :: (a -> a -> a) -> ((k, a), (k, a)) -> (k, a)
applyFst a -> a -> a
f ((k
k,a
a0),(k
_,a
a1)) = (k
k, a -> a -> a
f a
a0 a
a1)

insertRight :: Ord k => (k,a) -> Map k a -> T k a
insertRight :: (k, a) -> Map k a -> T k a
insertRight = (k -> a -> Map k a -> Map k a)
-> (((k, a), (k, a)) -> (k, a)) -> (k, a) -> Map k a -> T k a
forall k a.
Ord k =>
(k -> a -> Map k a -> Map k a)
-> (((k, a), (k, a)) -> (k, a)) -> (k, a) -> Map k a -> T k a
insertGen ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((a -> a -> a) -> k -> a -> Map k a -> Map k a)
-> (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a b. a -> b -> a
const) ((k, a), (k, a)) -> (k, a)
forall a b. (a, b) -> b
snd

insertRightWith :: Ord k => (a -> a -> a) -> (k,a) -> Map k a -> T k a
insertRightWith :: (a -> a -> a) -> (k, a) -> Map k a -> T k a
insertRightWith a -> a -> a
f =
   (k -> a -> Map k a -> Map k a)
-> (((k, a), (k, a)) -> (k, a)) -> (k, a) -> Map k a -> T k a
forall k a.
Ord k =>
(k -> a -> Map k a -> Map k a)
-> (((k, a), (k, a)) -> (k, a)) -> (k, a) -> Map k a -> T k a
insertGen ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((a -> a -> a) -> k -> a -> Map k a -> Map k a)
-> (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
f) ((((k, a), (k, a)) -> (k, a)) -> (k, a) -> Map k a -> T k a)
-> (((k, a), (k, a)) -> (k, a)) -> (k, a) -> Map k a -> T k a
forall a b. (a -> b) -> a -> b
$ \((k
_,a
a0),(k
k,a
a1)) -> (k
k, a -> a -> a
f a
a1 a
a0)

insertGen ::
   Ord k =>
   (k -> a -> Map k a -> Map k a) ->
   (((k,a),(k,a)) -> (k,a)) ->
   (k,a) -> Map k a -> T k a
insertGen :: (k -> a -> Map k a -> Map k a)
-> (((k, a), (k, a)) -> (k, a)) -> (k, a) -> Map k a -> T k a
insertGen k -> a -> Map k a -> Map k a
ins ((k, a), (k, a)) -> (k, a)
select (k, a)
y Map k a
xt =
   ((k, a) -> Map k a -> T k a) -> ((k, a), Map k a) -> T k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (k, a) -> Map k a -> T k a
forall k a. (k, a) -> Map k a -> T k a
Cons (((k, a), Map k a) -> T k a) -> ((k, a), Map k a) -> T k a
forall a b. (a -> b) -> a -> b
$
   ((k, a), Map k a) -> Maybe ((k, a), Map k a) -> ((k, a), Map k a)
forall a. a -> Maybe a -> a
fromMaybe ((k, a)
y, Map k a
xt) (Maybe ((k, a), Map k a) -> ((k, a), Map k a))
-> Maybe ((k, a), Map k a) -> ((k, a), Map k a)
forall a b. (a -> b) -> a -> b
$ do
      ((k, a)
x,Map k a
xs) <- Map k a -> Maybe ((k, a), Map k a)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map k a
xt
      case ((k, a) -> k) -> (k, a) -> (k, a) -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
comparing (k, a) -> k
forall a b. (a, b) -> a
fst (k, a)
y (k, a)
x of
         Ordering
GT -> ((k, a), Map k a) -> Maybe ((k, a), Map k a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((k, a)
x, (k -> a -> Map k a -> Map k a) -> (k, a) -> Map k a -> Map k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> a -> Map k a -> Map k a
ins (k, a)
y Map k a
xs)
         Ordering
EQ -> ((k, a), Map k a) -> Maybe ((k, a), Map k a)
forall (m :: * -> *) a. Monad m => a -> m a
return (((k, a), (k, a)) -> (k, a)
select ((k, a)
y,(k, a)
x), Map k a
xs)
         Ordering
LT -> Maybe ((k, a), Map k a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero

singleton :: k -> a -> T k a
singleton :: k -> a -> T k a
singleton k
k a
a = (k, a) -> Map k a -> T k a
forall k a. (k, a) -> Map k a -> T k a
Cons (k
k,a
a) Map k a
forall k a. Map k a
Map.empty

member :: (Ord k) => k -> T k a -> Bool
member :: k -> T k a -> Bool
member k
y (Cons (k, a)
x Map k a
xs) =
   k
y k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== (k, a) -> k
forall a b. (a, b) -> a
fst (k, a)
x Bool -> Bool -> Bool
|| k -> Map k a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member k
y Map k a
xs

size :: T k a -> Int
size :: T k a -> Int
size (Cons (k, a)
_ Map k a
xs) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map k a -> Int
forall k a. Map k a -> Int
Map.size Map k a
xs

elems :: T k a -> NonEmpty.T [] a
elems :: T k a -> T [] a
elems (Cons (k, a)
x Map k a
xs) = a -> [a] -> T [] a
forall a (f :: * -> *). a -> f a -> T f a
NonEmpty.cons ((k, a) -> a
forall a b. (a, b) -> b
snd (k, a)
x) (Map k a -> [a]
forall k a. Map k a -> [a]
Map.elems Map k a
xs)

keys :: T k a -> NonEmpty.T [] k
keys :: T k a -> T [] k
keys (Cons (k, a)
x Map k a
xs) = k -> [k] -> T [] k
forall a (f :: * -> *). a -> f a -> T f a
NonEmpty.cons ((k, a) -> k
forall a b. (a, b) -> a
fst (k, a)
x) (Map k a -> [k]
forall k a. Map k a -> [k]
Map.keys Map k a
xs)

-- 'insert' could be optimized to 'Cons'
keysSet :: (Ord k) => T k a -> NonEmptySet.T k
keysSet :: T k a -> T k
keysSet (Cons (k, a)
x Map k a
xs) = k -> Set k -> T k
forall a. Ord a => a -> Set a -> T a
NonEmptySet.insert ((k, a) -> k
forall a b. (a, b) -> a
fst (k, a)
x) (Map k a -> Set k
forall k a. Map k a -> Set k
Map.keysSet Map k a
xs)

lookup :: (Ord k) => k -> T k a -> Maybe a
lookup :: k -> T k a -> Maybe a
lookup k
y (Cons (k, a)
x Map k a
xs) =
   if k
y k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== (k, a) -> k
forall a b. (a, b) -> a
fst (k, a)
x
     then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (k, a) -> a
forall a b. (a, b) -> b
snd (k, a)
x
     else k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
y Map k a
xs

-- | prop> \k -> forAllNonEmptyMap $ \m -> Map.delete k (NonEmptyMap.flatten m) == NonEmptyMap.delete k m
delete :: (Ord k) => k -> T k a -> Map k a
delete :: k -> T k a -> Map k a
delete k
y (Cons (k, a)
x Map k a
xs) =
   if k
y k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== (k, a) -> k
forall a b. (a, b) -> a
fst (k, a)
x then Map k a
xs else (k -> a -> Map k a -> Map k a) -> (k, a) -> Map k a -> Map k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (k, a)
x (Map k a -> Map k a) -> Map k a -> Map k a
forall a b. (a -> b) -> a -> b
$ k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
y Map k a
xs

minViewWithKey :: T k a -> ((k,a), Map k a)
minViewWithKey :: T k a -> ((k, a), Map k a)
minViewWithKey (Cons (k, a)
x Map k a
xs) = ((k, a)
x,Map k a
xs)

maxViewWithKey :: (Ord k) => T k a -> ((k,a), Map k a)
maxViewWithKey :: T k a -> ((k, a), Map k a)
maxViewWithKey (Cons (k, a)
x Map k a
xs) =
   ((k, a), Map k a) -> ((k, a), Map k a)
forall a b. (a, b) -> (a, b)
forcePair (((k, a), Map k a) -> ((k, a), Map k a))
-> ((k, a), Map k a) -> ((k, a), Map k a)
forall a b. (a -> b) -> a -> b
$
   case Map k a -> Maybe ((k, a), Map k a)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map k a
xs of
      Maybe ((k, a), Map k a)
Nothing -> ((k, a)
x,Map k a
xs)
      Just ((k, a)
y,Map k a
ys) -> ((k, a)
y, (k -> a -> Map k a -> Map k a) -> (k, a) -> Map k a -> Map k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (k, a)
x Map k a
ys)

-- | prop> \xs -> Map.fromList (NonEmpty.flatten xs) == NonEmptyMap.flatten (NonEmptyMap.fromList (xs::NonEmpty.T [] (Int,Char)))
fromList :: (Ord k) => NonEmpty.T [] (k,a) -> T k a
fromList :: T [] (k, a) -> T k a
fromList (NonEmpty.Cons (k, a)
x [(k, a)]
xs) = (k, a) -> Map k a -> T k a
forall k a. Ord k => (k, a) -> Map k a -> T k a
insertRight (k, a)
x (Map k a -> T k a) -> Map k a -> T k a
forall a b. (a -> b) -> a -> b
$ [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(k, a)]
xs

-- | prop> \xs -> Map.fromListWith (++) (NonEmpty.flatten xs) == NonEmptyMap.flatten (NonEmptyMap.fromListWith (++) (xs::NonEmpty.T [] (Int,String)))
fromListWith :: (Ord k) => (a -> a -> a) -> NonEmpty.T [] (k,a) -> T k a
fromListWith :: (a -> a -> a) -> T [] (k, a) -> T k a
fromListWith a -> a -> a
f (NonEmpty.Cons (k, a)
x [(k, a)]
xs) =
   (a -> a -> a) -> (k, a) -> Map k a -> T k a
forall k a. Ord k => (a -> a -> a) -> (k, a) -> Map k a -> T k a
insertRightWith a -> a -> a
f (k, a)
x (Map k a -> T k a) -> Map k a -> T k a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [(k, a)] -> Map k a
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith a -> a -> a
f [(k, a)]
xs

-- | prop> forAllNonEmptyMap $ \m -> NonEmptyMap.fromAscList (NonEmptyMap.toAscList m) == m
fromAscList :: (Ord k) => NonEmpty.T [] (k,a) -> T k a
fromAscList :: T [] (k, a) -> T k a
fromAscList (NonEmpty.Cons (k, a)
x [(k, a)]
xs) = (k, a) -> Map k a -> T k a
forall k a. (k, a) -> Map k a -> T k a
Cons (k, a)
x (Map k a -> T k a) -> Map k a -> T k a
forall a b. (a -> b) -> a -> b
$ [(k, a)] -> Map k a
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [(k, a)]
xs

-- | prop> forAllNonEmptyMap $ \m -> NonEmpty.flatten (NonEmptyMap.toAscList m) == Map.toAscList (NonEmptyMap.flatten m)
toAscList :: T k a -> NonEmpty.T [] (k,a)
toAscList :: T k a -> T [] (k, a)
toAscList (Cons (k, a)
x Map k a
xs) = (k, a) -> [(k, a)] -> T [] (k, a)
forall a (f :: * -> *). a -> f a -> T f a
NonEmpty.cons (k, a)
x ([(k, a)] -> T [] (k, a)) -> [(k, a)] -> T [] (k, a)
forall a b. (a -> b) -> a -> b
$ Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map k a
xs

fetch :: (Ord k) => Map k a -> Maybe (T k a)
fetch :: Map k a -> Maybe (T k a)
fetch  =  (((k, a), Map k a) -> T k a)
-> Maybe ((k, a), Map k a) -> Maybe (T k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((k, a) -> Map k a -> T k a) -> ((k, a), Map k a) -> T k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (k, a) -> Map k a -> T k a
forall k a. (k, a) -> Map k a -> T k a
Cons) (Maybe ((k, a), Map k a) -> Maybe (T k a))
-> (Map k a -> Maybe ((k, a), Map k a)) -> Map k a -> Maybe (T k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> Maybe ((k, a), Map k a)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey

flatten :: (Ord k) => T k a -> Map k a
flatten :: T k a -> Map k a
flatten (Cons (k, a)
x Map k a
xs) = (k -> a -> Map k a -> Map k a) -> (k, a) -> Map k a -> Map k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (k, a)
x Map k a
xs


{-
Could be implemented in terms of unionRight
but that would require inspection of the plain Map using Map.minViewWithKey.
-}
-- | prop> forAllNonEmptyMap $ \xs -> forAllNonEmptyMap $ \ys -> Map.union (NonEmptyMap.flatten xs) (NonEmptyMap.flatten ys) == NonEmptyMap.flatten (NonEmptyMap.union xs ys)
union :: (Ord k) => T k a -> T k a -> T k a
union :: T k a -> T k a -> T k a
union (Cons (k, a)
x Map k a
xs) (Cons (k, a)
y Map k a
ys) =
   ((k, a) -> Map k a -> T k a) -> ((k, a), Map k a) -> T k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (k, a) -> Map k a -> T k a
forall k a. (k, a) -> Map k a -> T k a
Cons (((k, a), Map k a) -> T k a) -> ((k, a), Map k a) -> T k a
forall a b. (a -> b) -> a -> b
$
   case Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map k a
xs Map k a
ys of
      Map k a
zs ->
         case ((k, a) -> k) -> (k, a) -> (k, a) -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
comparing (k, a) -> k
forall a b. (a, b) -> a
fst (k, a)
x (k, a)
y of
            Ordering
LT -> ((k, a)
x, (k -> a -> Map k a -> Map k a) -> (k, a) -> Map k a -> Map k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a b. a -> b -> a
const)) (k, a)
y Map k a
zs)
            Ordering
GT -> ((k, a)
y, (k -> a -> Map k a -> Map k a) -> (k, a) -> Map k a -> Map k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (k, a)
x Map k a
zs)
            Ordering
EQ -> ((k, a)
x, Map k a
zs)

-- | prop> forAllMap $ \xm -> forAllNonEmptyMap $ \ym -> Map.union xm (NonEmptyMap.flatten ym) == NonEmptyMap.flatten (NonEmptyMap.unionLeft xm ym)
unionLeft :: (Ord k) => Map k a -> T k a -> T k a
unionLeft :: Map k a -> T k a -> T k a
unionLeft Map k a
xs (Cons (k, a)
y Map k a
ys) = (k, a) -> Map k a -> T k a
forall k a. Ord k => (k, a) -> Map k a -> T k a
insertRight (k, a)
y (Map k a -> T k a) -> Map k a -> T k a
forall a b. (a -> b) -> a -> b
$ Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map k a
xs Map k a
ys

-- | prop> forAllNonEmptyMap $ \xm -> forAllMap $ \ym -> Map.union (NonEmptyMap.flatten xm) ym == NonEmptyMap.flatten (NonEmptyMap.unionRight xm ym)
unionRight :: (Ord k) => T k a -> Map k a -> T k a
unionRight :: T k a -> Map k a -> T k a
unionRight (Cons (k, a)
x Map k a
xs) Map k a
ys = (k -> a -> Map k a -> T k a) -> (k, a) -> Map k a -> T k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> a -> Map k a -> T k a
forall k a. Ord k => k -> a -> Map k a -> T k a
insert (k, a)
x (Map k a -> T k a) -> Map k a -> T k a
forall a b. (a -> b) -> a -> b
$ Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map k a
xs Map k a
ys


-- | prop> forAllNonEmptyMap $ \xs -> forAllNonEmptyMap $ \ys -> Map.unionWith (++) (NonEmptyMap.flatten xs) (NonEmptyMap.flatten ys) == NonEmptyMap.flatten (NonEmptyMap.unionWith (++) xs ys)
unionWith :: (Ord k) => (a -> a -> a) -> T k a -> T k a -> T k a
unionWith :: (a -> a -> a) -> T k a -> T k a -> T k a
unionWith a -> a -> a
f (Cons (k, a)
x Map k a
xs) (Cons (k, a)
y Map k a
ys) =
   ((k, a) -> Map k a -> T k a) -> ((k, a), Map k a) -> T k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (k, a) -> Map k a -> T k a
forall k a. (k, a) -> Map k a -> T k a
Cons (((k, a), Map k a) -> T k a) -> ((k, a), Map k a) -> T k a
forall a b. (a -> b) -> a -> b
$
   case (a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith a -> a -> a
f Map k a
xs Map k a
ys of
      Map k a
zs ->
         case ((k, a) -> k) -> (k, a) -> (k, a) -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
comparing (k, a) -> k
forall a b. (a, b) -> a
fst (k, a)
x (k, a)
y of
            Ordering
LT -> ((k, a)
x, (k -> a -> Map k a -> Map k a) -> (k, a) -> Map k a -> Map k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
f)) (k, a)
y Map k a
zs)
            Ordering
GT -> ((k, a)
y, (k -> a -> Map k a -> Map k a) -> (k, a) -> Map k a -> Map k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith a -> a -> a
f) (k, a)
x Map k a
zs)
            Ordering
EQ -> ((a -> a -> a) -> ((k, a), (k, a)) -> (k, a)
forall a k. (a -> a -> a) -> ((k, a), (k, a)) -> (k, a)
applyFst a -> a -> a
f ((k, a)
x,(k, a)
y), Map k a
zs)

-- | prop> forAllMap $ \xm -> forAllNonEmptyMap $ \ym -> Map.unionWith (++) xm (NonEmptyMap.flatten ym) == NonEmptyMap.flatten (NonEmptyMap.unionLeftWith (++) xm ym)
unionLeftWith :: (Ord k) => (a -> a -> a) -> Map k a -> T k a -> T k a
unionLeftWith :: (a -> a -> a) -> Map k a -> T k a -> T k a
unionLeftWith a -> a -> a
f Map k a
xs (Cons (k, a)
y Map k a
ys) =
   (a -> a -> a) -> (k, a) -> Map k a -> T k a
forall k a. Ord k => (a -> a -> a) -> (k, a) -> Map k a -> T k a
insertRightWith a -> a -> a
f (k, a)
y (Map k a -> T k a) -> Map k a -> T k a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith a -> a -> a
f Map k a
xs Map k a
ys

-- | prop> forAllNonEmptyMap $ \xm -> forAllMap $ \ym -> Map.unionWith (++) (NonEmptyMap.flatten xm) ym == NonEmptyMap.flatten (NonEmptyMap.unionRightWith (++) xm ym)
unionRightWith :: (Ord k) => (a -> a -> a) -> T k a -> Map k a -> T k a
unionRightWith :: (a -> a -> a) -> T k a -> Map k a -> T k a
unionRightWith a -> a -> a
f (Cons (k, a)
x Map k a
xs) Map k a
ys =
   (k -> a -> Map k a -> T k a) -> (k, a) -> Map k a -> T k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> a -> a) -> k -> a -> Map k a -> T k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> T k a
insertWith a -> a -> a
f) (k, a)
x (Map k a -> T k a) -> Map k a -> T k a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith a -> a -> a
f Map k a
xs Map k a
ys


map :: (Ord k) => (a -> b) -> T k a -> T k b
map :: (a -> b) -> T k a -> T k b
map a -> b
f (Cons (k, a)
x Map k a
xs) = (k, b) -> Map k b -> T k b
forall k a. (k, a) -> Map k a -> T k a
Cons ((a -> b) -> (k, a) -> (k, b)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd a -> b
f (k, a)
x) ((a -> b) -> Map k a -> Map k b
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map a -> b
f Map k a
xs)

mapWithKey :: (Ord k) => (k -> a -> b) -> T k a -> T k b
mapWithKey :: (k -> a -> b) -> T k a -> T k b
mapWithKey k -> a -> b
f (Cons x :: (k, a)
x@(k
k,a
_a) Map k a
xs) = (k, b) -> Map k b -> T k b
forall k a. (k, a) -> Map k a -> T k a
Cons (k
k, (k -> a -> b) -> (k, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> a -> b
f (k, a)
x) ((k -> a -> b) -> Map k a -> Map k b
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey k -> a -> b
f Map k a
xs)