{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE ViewPatterns       #-}
{-# OPTIONS_HADDOCK not-home    #-}

-- |
-- Module      : Data.Map.NonEmpty.Internal
-- Copyright   : (c) Justin Le 2018
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Unsafe internal-use functions used in the implementation of
-- "Data.Map.NonEmpty".  These functions can potentially be used to break
-- the abstraction of 'NEMap' and produce unsound maps, so be wary!
module Data.Map.NonEmpty.Internal (
  -- * Non-Empty Map type
    NEMap(..)
  , singleton
  , nonEmptyMap
  , withNonEmpty
  , fromList
  , toList
  , map
  , insertWith
  , union
  , unions
  , elems
  , size
  , toMap
  -- * Folds
  , foldr
  , foldr'
  , foldr1
  , foldl
  , foldl'
  , foldl1
  -- * Traversals
  , traverseWithKey
  , traverseWithKey1
  , foldMapWithKey
  -- * Unsafe Map Functions
  , insertMinMap
  , insertMaxMap
  -- * Debug
  , valid
  ) where

import           Control.Applicative
import           Control.Comonad
import           Control.DeepSeq
import           Control.Monad
import           Data.Coerce
import           Data.Data
import           Data.Function
import           Data.Functor.Alt
import           Data.Functor.Classes
import           Data.Functor.Invariant
import           Data.List.NonEmpty         (NonEmpty(..))
import           Data.Map.Internal          (Map(..))
import           Data.Maybe
import           Data.Semigroup
import           Data.Semigroup.Foldable    (Foldable1(fold1))
import           Data.Semigroup.Traversable (Traversable1(..))
import           Prelude hiding             (Foldable(..), map)
import           Text.Read
import qualified Data.Aeson                 as A
import qualified Data.Foldable              as F
import qualified Data.Map                   as M
import qualified Data.Map.Internal          as M
import qualified Data.Semigroup.Foldable    as F1

-- | A non-empty (by construction) map from keys @k@ to values @a@.  At
-- least one key-value pair exists in an @'NEMap' k v@ at all times.
--
-- Functions that /take/ an 'NEMap' can safely operate on it with the
-- assumption that it has at least one key-value pair.
--
-- Functions that /return/ an 'NEMap' provide an assurance that the result
-- has at least one key-value pair.
--
-- "Data.Map.NonEmpty" re-exports the API of "Data.Map", faithfully
-- reproducing asymptotics, typeclass constraints, and semantics.
-- Functions that ensure that input and output maps are both non-empty
-- (like 'Data.Map.NonEmpty.insert') return 'NEMap', but functions that
-- might potentially return an empty map (like 'Data.Map.NonEmpty.delete')
-- return a 'Map' instead.
--
-- You can directly construct an 'NEMap' with the API from
-- "Data.Map.NonEmpty"; it's more or less the same as constructing a normal
-- 'Map', except you don't have access to 'Data.Map.empty'.  There are also
-- a few ways to construct an 'NEMap' from a 'Map':
--
-- 1.  The 'nonEmptyMap' smart constructor will convert a @'Map' k a@ into
--     a @'Maybe' ('NEMap' k a)@, returning 'Nothing' if the original 'Map'
--     was empty.
-- 2.  You can use the 'Data.Map.NonEmpty.insertMap' family of functions to
--     insert a value into a 'Map' to create a guaranteed 'NEMap'.
-- 3.  You can use the 'Data.Map.NonEmpty.IsNonEmpty' and
--     'Data.Map.NonEmpty.IsEmpty' patterns to "pattern match" on a 'Map'
--     to reveal it as either containing a 'NEMap' or an empty map.
-- 4.  'withNonEmpty' offers a continuation-based interface for
--     deconstructing a 'Map' and treating it as if it were an 'NEMap'.
--
-- You can convert an 'NEMap' into a 'Map' with 'toMap' or
-- 'Data.Map.NonEmpty.IsNonEmpty', essentially "obscuring" the non-empty
-- property from the type.
data NEMap k a =
    NEMap { forall k a. NEMap k a -> k
nemK0  :: !k   -- ^ invariant: must be smaller than smallest key in map
          , forall k a. NEMap k a -> a
nemV0  :: a
          , forall k a. NEMap k a -> Map k a
nemMap :: !(Map k a)
          }
  deriving (Typeable)

instance (Eq k, Eq a) => Eq (NEMap k a) where
    NEMap k a
t1 == :: NEMap k a -> NEMap k a -> Bool
== NEMap k a
t2 = forall k a. Map k a -> Int
M.size (forall k a. NEMap k a -> Map k a
nemMap NEMap k a
t1) forall a. Eq a => a -> a -> Bool
== forall k a. Map k a -> Int
M.size (forall k a. NEMap k a -> Map k a
nemMap NEMap k a
t2)
            Bool -> Bool -> Bool
&& forall k a. NEMap k a -> NonEmpty (k, a)
toList NEMap k a
t1 forall a. Eq a => a -> a -> Bool
== forall k a. NEMap k a -> NonEmpty (k, a)
toList NEMap k a
t2

instance (Ord k, Ord a) => Ord (NEMap k a) where
    compare :: NEMap k a -> NEMap k a -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall k a. NEMap k a -> NonEmpty (k, a)
toList
    < :: NEMap k a -> NEMap k a -> Bool
(<)     = forall a. Ord a => a -> a -> Bool
(<) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall k a. NEMap k a -> NonEmpty (k, a)
toList
    > :: NEMap k a -> NEMap k a -> Bool
(>)     = forall a. Ord a => a -> a -> Bool
(>) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall k a. NEMap k a -> NonEmpty (k, a)
toList
    <= :: NEMap k a -> NEMap k a -> Bool
(<=)    = forall a. Ord a => a -> a -> Bool
(<=) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall k a. NEMap k a -> NonEmpty (k, a)
toList
    >= :: NEMap k a -> NEMap k a -> Bool
(>=)    = forall a. Ord a => a -> a -> Bool
(>=) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall k a. NEMap k a -> NonEmpty (k, a)
toList

instance Eq2 NEMap where
    liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> NEMap a c -> NEMap b d -> Bool
liftEq2 a -> b -> Bool
eqk c -> d -> Bool
eqv NEMap a c
m NEMap b d
n =
        forall k a. NEMap k a -> Int
size NEMap a c
m forall a. Eq a => a -> a -> Bool
== forall k a. NEMap k a -> Int
size NEMap b d
n Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq (forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> b -> Bool
eqk c -> d -> Bool
eqv) (forall k a. NEMap k a -> NonEmpty (k, a)
toList NEMap a c
m) (forall k a. NEMap k a -> NonEmpty (k, a)
toList NEMap b d
n)

instance Eq k => Eq1 (NEMap k) where
    liftEq :: forall a b. (a -> b -> Bool) -> NEMap k a -> NEMap k b -> Bool
liftEq = forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 forall a. Eq a => a -> a -> Bool
(==)

instance Ord2 NEMap where
    liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> NEMap a c -> NEMap b d -> Ordering
liftCompare2 a -> b -> Ordering
cmpk c -> d -> Ordering
cmpv NEMap a c
m NEMap b d
n =
        forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> b -> Ordering
cmpk c -> d -> Ordering
cmpv) (forall k a. NEMap k a -> NonEmpty (k, a)
toList NEMap a c
m) (forall k a. NEMap k a -> NonEmpty (k, a)
toList NEMap b d
n)

instance Ord k => Ord1 (NEMap k) where
    liftCompare :: forall a b.
(a -> b -> Ordering) -> NEMap k a -> NEMap k b -> Ordering
liftCompare = forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 forall a. Ord a => a -> a -> Ordering
compare

instance Show2 NEMap where
    liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> NEMap a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv Int
d NEMap a b
m =
        forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> (a, b) -> ShowS
sp [(a, b)] -> ShowS
sl) String
"fromList" Int
d (forall k a. NEMap k a -> NonEmpty (k, a)
toList NEMap a b
m)
      where
        sp :: Int -> (a, b) -> ShowS
sp = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv
        sl :: [(a, b)] -> ShowS
sl = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv

instance Show k => Show1 (NEMap k) where
    liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NEMap k a -> ShowS
liftShowsPrec = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList

instance (Ord k, Read k) => Read1 (NEMap k) where
    liftReadsPrec :: forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NEMap k a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = forall a. (String -> ReadS a) -> Int -> ReadS a
readsData forall a b. (a -> b) -> a -> b
$
        forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith (forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS (k, a)
rp' ReadS [(k, a)]
rl') String
"fromList" forall k a. Ord k => NonEmpty (k, a) -> NEMap k a
fromList
      where
        rp' :: Int -> ReadS (k, a)
rp' = forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl
        rl' :: ReadS [(k, a)]
rl' = forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
rp ReadS [a]
rl

instance (Ord k, Read k, Read e) => Read (NEMap k e) where
    readPrec :: ReadPrec (NEMap k e)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
      Ident String
"fromList" <- ReadPrec Lexeme
lexP
      NonEmpty (k, e)
xs <- forall a. ReadPrec a -> ReadPrec a
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ forall a. Read a => ReadPrec a
readPrec
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Ord k => NonEmpty (k, a) -> NEMap k a
fromList NonEmpty (k, e)
xs)
    readListPrec :: ReadPrec [NEMap k e]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault

instance (Show k, Show a) => Show (NEMap k a) where
    showsPrec :: Int -> NEMap k a -> ShowS
showsPrec Int
d NEMap k a
m  = Bool -> ShowS -> ShowS
showParen (Int
d 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 k a. NEMap k a -> NonEmpty (k, a)
toList NEMap k a
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"

instance (NFData k, NFData a) => NFData (NEMap k a) where
    rnf :: NEMap k a -> ()
rnf (NEMap k
k a
v Map k a
a) = forall a. NFData a => a -> ()
rnf k
k seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
v seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Map k a
a

-- Data instance code from Data.Map.Internal
--
-- Copyright   :  (c) Daan Leijen 2002
--                (c) Andriy Palamarchuk 2008
instance (Data k, Data a, Ord k) => Data (NEMap k a) where
    gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NEMap k a -> c (NEMap k a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z NEMap k a
m   = forall g. g -> c g
z forall k a. Ord k => NonEmpty (k, a) -> NEMap k a
fromList forall d b. Data d => c (d -> b) -> d -> c b
`f` forall k a. NEMap k a -> NonEmpty (k, a)
toList NEMap k a
m
    toConstr :: NEMap k a -> Constr
toConstr NEMap k a
_     = Constr
fromListConstr
    gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (NEMap k a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c  = case Constr -> Int
constrIndex Constr
c of
      Int
1 -> forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall k a. Ord k => NonEmpty (k, a) -> NEMap k a
fromList)
      Int
_ -> forall a. HasCallStack => String -> a
error String
"gunfold"
    dataTypeOf :: NEMap k a -> DataType
dataTypeOf NEMap k a
_   = DataType
mapDataType
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (NEMap k a))
dataCast2 forall d e. (Data d, Data e) => c (t d e)
f    = forall {k1} {k2} {k3} (c :: k1 -> *) (t :: k2 -> k3 -> k1)
       (t' :: k2 -> k3 -> k1) (a :: k2) (b :: k3).
(Typeable t, Typeable t') =>
c (t a b) -> Maybe (c (t' a b))
gcast2 forall d e. (Data d, Data e) => c (t d e)
f

fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
mapDataType String
"fromList" [] Fixity
Prefix

mapDataType :: DataType
mapDataType :: DataType
mapDataType = String -> [Constr] -> DataType
mkDataType String
"Data.Map.NonEmpty.NonEmpty.Internal.NEMap" [Constr
fromListConstr]

instance (A.ToJSONKey k, A.ToJSON a) => A.ToJSON (NEMap k a) where
    toJSON :: NEMap k a -> Value
toJSON     = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. NEMap k a -> Map k a
toMap
    toEncoding :: NEMap k a -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
A.toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. NEMap k a -> Map k a
toMap

instance (A.FromJSONKey k, Ord k, A.FromJSON a) => A.FromJSON (NEMap k a) where
    parseJSON :: Value -> Parser (NEMap k a)
parseJSON = forall r k a. r -> (NEMap k a -> r) -> Map k a -> r
withNonEmpty (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err) forall (f :: * -> *) a. Applicative f => a -> f a
pure
            forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. FromJSON a => Value -> Parser a
A.parseJSON
      where
        err :: String
err = String
"NEMap: Non-empty map expected, but empty map found"

-- | @since 0.3.4.4
instance Ord k => Alt (NEMap k) where
    <!> :: forall a. NEMap k a -> NEMap k a -> NEMap k a
(<!>) = forall k a. Ord k => NEMap k a -> NEMap k a -> NEMap k a
union
    {-# INLINE (<!>) #-}

-- | /O(n)/. Fold the values in the map using the given right-associative
-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.
--
-- > elemsList map = foldr (:) [] map
--
-- > let f a len = len + (length a)
-- > foldr f 0 (fromList ((5,"a") :| [(3,"bbb")])) == 4
foldr :: (a -> b -> b) -> b -> NEMap k a -> b
foldr :: forall a b k. (a -> b -> b) -> b -> NEMap k a -> b
foldr a -> b -> b
f b
z (NEMap k
_ a
v Map k a
m) = a
v a -> b -> b
`f` forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr a -> b -> b
f b
z Map k a
m
{-# INLINE foldr #-}

-- | /O(n)/. A strict version of 'foldr'. Each application of the operator
-- is evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldr' :: (a -> b -> b) -> b -> NEMap k a -> b
foldr' :: forall a b k. (a -> b -> b) -> b -> NEMap k a -> b
foldr' a -> b -> b
f b
z (NEMap k
_ a
v Map k a
m) = a
v a -> b -> b
`f` b
y
  where
    !y :: b
y = forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr' a -> b -> b
f b
z Map k a
m
{-# INLINE foldr' #-}

-- | /O(n)/. A version of 'foldr' that uses the value at the maximal key in
-- the map as the starting value.
--
-- Note that, unlike 'Data.Foldable.foldr1' for 'Map', this function is
-- total if the input function is total.
foldr1 :: (a -> a -> a) -> NEMap k a -> a
foldr1 :: forall a k. (a -> a -> a) -> NEMap k a -> a
foldr1 a -> a -> a
f (NEMap k
_ a
v Map k a
m) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
v (a -> a -> a
f a
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr a -> a -> a
f))
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> Maybe (a, Map k a)
M.maxView
                       forall a b. (a -> b) -> a -> b
$ Map k a
m
{-# INLINE foldr1 #-}

-- | /O(n)/. Fold the values in the map using the given left-associative
-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.
--
-- > elemsList = reverse . foldl (flip (:)) []
--
-- > let f len a = len + (length a)
-- > foldl f 0 (fromList ((5,"a") :| [(3,"bbb")])) == 4
foldl :: (a -> b -> a) -> a -> NEMap k b -> a
foldl :: forall a b k. (a -> b -> a) -> a -> NEMap k b -> a
foldl a -> b -> a
f a
z (NEMap k
_ b
v Map k b
m) = forall a b k. (a -> b -> a) -> a -> Map k b -> a
M.foldl a -> b -> a
f (a -> b -> a
f a
z b
v) Map k b
m
{-# INLINE foldl #-}

-- | /O(n)/. A strict version of 'foldl'. Each application of the operator
-- is evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldl' :: (a -> b -> a) -> a -> NEMap k b -> a
foldl' :: forall a b k. (a -> b -> a) -> a -> NEMap k b -> a
foldl' a -> b -> a
f a
z (NEMap k
_ b
v Map k b
m) = forall a b k. (a -> b -> a) -> a -> Map k b -> a
M.foldl' a -> b -> a
f a
x Map k b
m
  where
    !x :: a
x = a -> b -> a
f a
z b
v
{-# INLINE foldl' #-}

-- | /O(n)/. A version of 'foldl' that uses the value at the minimal key in
-- the map as the starting value.
--
-- Note that, unlike 'Data.Foldable.foldl1' for 'Map', this function is
-- total if the input function is total.
foldl1 :: (a -> a -> a) -> NEMap k a -> a
foldl1 :: forall a k. (a -> a -> a) -> NEMap k a -> a
foldl1 a -> a -> a
f (NEMap k
_ a
v Map k a
m) = forall a b k. (a -> b -> a) -> a -> Map k b -> a
M.foldl a -> a -> a
f a
v Map k a
m
{-# INLINE foldl1 #-}

-- | /O(n)/. Fold the keys and values in the map using the given semigroup,
-- such that
--
-- @'foldMapWithKey' f = 'Data.Semigroup.Foldable.fold1' . 'Data.Map.NonEmpty.mapWithKey' f@
--
-- This can be an asymptotically faster than
-- 'Data.Map.NonEmpty.foldrWithKey' or 'Data.Map.NonEmpty.foldlWithKey' for
-- some monoids.

-- TODO: benchmark against maxView method
foldMapWithKey
    :: Semigroup m
    => (k -> a -> m)
    -> NEMap k a
    -> m
#if MIN_VERSION_base(4,11,0)
foldMapWithKey :: forall m k a. Semigroup m => (k -> a -> m) -> NEMap k a -> m
foldMapWithKey k -> a -> m
f (NEMap k
k0 a
v Map k a
m) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (k -> a -> m
f k
k0 a
v) (k -> a -> m
f k
k0 a
v forall a. Semigroup a => a -> a -> a
<>)
                                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
M.foldMapWithKey (\k
k -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> a -> m
f k
k)
                                forall a b. (a -> b) -> a -> b
$ Map k a
m
#else
foldMapWithKey f (NEMap k0 v m) = option (f k0 v) (f k0 v <>)
                                . M.foldMapWithKey (\k -> Option . Just . f k)
                                $ m
#endif
{-# INLINE foldMapWithKey #-}

-- | /O(n)/. Map a function over all values in the map.
--
-- > map (++ "x") (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "bx") :| [(5, "ax")])
map :: (a -> b) -> NEMap k a -> NEMap k b
map :: forall a b k. (a -> b) -> NEMap k a -> NEMap k b
map a -> b
f (NEMap k
k0 a
v Map k a
m) = forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k0 (a -> b
f a
v) (forall a b k. (a -> b) -> Map k a -> Map k b
M.map a -> b
f Map k a
m)
{-# NOINLINE [1] map #-}
{-# RULES
"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
 #-}
{-# RULES
"map/coerce" map coerce = coerce
 #-}

-- | /O(m*log(n\/m + 1)), m <= n/.
-- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and
-- @t2@. It prefers @t1@ when duplicate keys are encountered, i.e.
-- (@'union' == 'Data.Map.NonEmpty.unionWith' 'const'@).
--
-- > union (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "a"), (7, "C")])
union
    :: Ord k
    => NEMap k a
    -> NEMap k a
    -> NEMap k a
union :: forall k a. Ord k => NEMap k a -> NEMap k a -> NEMap k a
union n1 :: NEMap k a
n1@(NEMap k
k1 a
v1 Map k a
m1) n2 :: NEMap k a
n2@(NEMap k
k2 a
v2 Map k a
m2) = case forall a. Ord a => a -> a -> Ordering
compare k
k1 k
k2 of
    Ordering
LT -> forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k1 a
v1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map k a
m1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. NEMap k a -> Map k a
toMap forall a b. (a -> b) -> a -> b
$ NEMap k a
n2
    Ordering
EQ -> forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k1 a
v1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map k a
m1         forall a b. (a -> b) -> a -> b
$ Map k a
m2
    Ordering
GT -> forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k2 a
v2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (forall k a. NEMap k a -> Map k a
toMap NEMap k a
n1) forall a b. (a -> b) -> a -> b
$ Map k a
m2
{-# INLINE union #-}

-- | The left-biased union of a non-empty list of maps.
--
-- > unions (fromList ((5, "a") :| [(3, "b")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "A3") :| [(3, "B3")])])
-- >     == fromList [(3, "b"), (5, "a"), (7, "C")]
-- > unions (fromList ((5, "A3") :| [(3, "B3")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "a") :| [(3, "b")])])
-- >     == fromList ((3, "B3") :| [(5, "A3"), (7, "C")])
unions
    :: (Foldable1 f, Ord k)
    => f (NEMap k a)
    -> NEMap k a
unions :: forall (f :: * -> *) k a.
(Foldable1 f, Ord k) =>
f (NEMap k a) -> NEMap k a
unions (forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
F1.toNonEmpty->(NEMap k a
m :| [NEMap k a]
ms)) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall k a. Ord k => NEMap k a -> NEMap k a -> NEMap k a
union NEMap k a
m [NEMap k a]
ms
{-# INLINE unions #-}

-- | /O(n)/.
-- Return all elements of the map in the ascending order of their keys.
--
-- > elems (fromList ((5,"a") :| [(3,"b")])) == ("b" :| ["a"])
elems :: NEMap k a -> NonEmpty a
elems :: forall k a. NEMap k a -> NonEmpty a
elems (NEMap k
_ a
v Map k a
m) = a
v forall a. a -> [a] -> NonEmpty a
:| forall k a. Map k a -> [a]
M.elems Map k a
m
{-# INLINE elems #-}

-- | /O(1)/. The number of elements in the map.  Guaranteed to be greater
-- than zero.
--
-- > size (singleton 1 'a')                          == 1
-- > size (fromList ((1,'a') :| [(2,'c'), (3,'b')])) == 3
size :: NEMap k a -> Int
size :: forall k a. NEMap k a -> Int
size (NEMap k
_ a
_ Map k a
m) = Int
1 forall a. Num a => a -> a -> a
+ forall k a. Map k a -> Int
M.size Map k a
m
{-# INLINE size #-}

-- | /O(log n)/.
-- Convert a non-empty map back into a normal possibly-empty map, for usage
-- with functions that expect 'Map'.
--
-- Can be thought of as "obscuring" the non-emptiness of the map in its
-- type.  See the 'Data.Map.NonEmpty.IsNotEmpty' pattern.
--
-- 'nonEmptyMap' and @'maybe' 'Data.Map.empty' 'toMap'@ form an isomorphism: they
-- are perfect structure-preserving inverses of eachother.
--
-- > toMap (fromList ((3,"a") :| [(5,"b")])) == Data.Map.fromList [(3,"a"), (5,"b")]
toMap :: NEMap k a -> Map k a
toMap :: forall k a. NEMap k a -> Map k a
toMap (NEMap k
k a
v Map k a
m) = forall k a. k -> a -> Map k a -> Map k a
insertMinMap k
k a
v Map k a
m
{-# INLINE toMap #-}

-- | /O(n)/.
-- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@
-- That is, behaves exactly like a regular 'traverse' except that the traversing
-- function also has access to the key associated with a value.
--
-- /Use 'traverseWithKey1'/ whenever possible (if your 'Applicative'
-- also has 'Apply' instance).  This version is provided only for types
-- that do not have 'Apply' instance, since 'Apply' is not at the moment
-- (and might not ever be) an official superclass of 'Applicative'.
--
-- @
-- 'traverseWithKey' f = 'unwrapApplicative' . 'traverseWithKey1' (\\k -> WrapApplicative . f k)
-- @
traverseWithKey
    :: Applicative t
    => (k -> a -> t b)
    -> NEMap k a
    -> t (NEMap k b)
traverseWithKey :: forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> NEMap k a -> t (NEMap k b)
traverseWithKey k -> a -> t b
f (NEMap k
k a
v Map k a
m0) = forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> t b
f k
k a
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey k -> a -> t b
f Map k a
m0
{-# INLINE traverseWithKey #-}

-- | /O(n)/.
-- @'traverseWithKey1' f m == 'fromList' <$> 'traverse1' (\(k, v) -> (,) k <$> f k v) ('toList' m)@
--
-- That is, behaves exactly like a regular 'traverse1' except that the traversing
-- function also has access to the key associated with a value.
--
-- Is more general than 'traverseWithKey', since works with all 'Apply',
-- and not just 'Applicative'.

-- TODO: benchmark against maxView-based methods
traverseWithKey1
    :: Apply t
    => (k -> a -> t b)
    -> NEMap k a
    -> t (NEMap k b)
traverseWithKey1 :: forall (t :: * -> *) k a b.
Apply t =>
(k -> a -> t b) -> NEMap k a -> t (NEMap k b)
traverseWithKey1 k -> a -> t b
f (NEMap k
k0 a
v Map k a
m0) = case forall (f :: * -> *) a. MaybeApply f a -> Either (f a) a
runMaybeApply MaybeApply t (Map k b)
m1 of
    Left  t (Map k b)
m2 -> forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> t b
f k
k0 a
v forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> t (Map k b)
m2
    Right Map k b
m2 -> forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k0) Map k b
m2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> t b
f k
k0 a
v
  where
    m1 :: MaybeApply t (Map k b)
m1 = forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey (\k
k -> forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> a -> t b
f k
k) Map k a
m0
{-# INLINABLE traverseWithKey1 #-}

-- | /O(n)/. Convert the map to a non-empty list of key\/value pairs.
--
-- > toList (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")])
toList :: NEMap k a -> NonEmpty (k, a)
toList :: forall k a. NEMap k a -> NonEmpty (k, a)
toList (NEMap k
k a
v Map k a
m) = (k
k,a
v) forall a. a -> [a] -> NonEmpty a
:| forall k a. Map k a -> [(k, a)]
M.toList Map k a
m
{-# INLINE toList #-}

-- | /O(log n)/. Smart constructor for an 'NEMap' from a 'Map'.  Returns
-- 'Nothing' if the 'Map' was originally actually empty, and @'Just' n@
-- with an 'NEMap', if the 'Map' was not empty.
--
-- 'nonEmptyMap' and @'maybe' 'Data.Map.empty' 'toMap'@ form an
-- isomorphism: they are perfect structure-preserving inverses of
-- eachother.
--
-- See 'Data.Map.NonEmpty.IsNonEmpty' for a pattern synonym that lets you
-- "match on" the possiblity of a 'Map' being an 'NEMap'.
--
-- > nonEmptyMap (Data.Map.fromList [(3,"a"), (5,"b")]) == Just (fromList ((3,"a") :| [(5,"b")]))
nonEmptyMap :: Map k a -> Maybe (NEMap k a)
nonEmptyMap :: forall k a. Map k a -> Maybe (NEMap k a)
nonEmptyMap = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry) forall k a. k -> a -> Map k a -> NEMap k a
NEMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> Maybe ((k, a), Map k a)
M.minViewWithKey
{-# INLINE nonEmptyMap #-}

-- | /O(log n)/. A general continuation-based way to consume a 'Map' as if
-- it were an 'NEMap'. @'withNonEmpty' def f@ will take a 'Map'.  If map is
-- empty, it will evaluate to @def@.  Otherwise, a non-empty map 'NEMap'
-- will be fed to the function @f@ instead.
--
-- @'nonEmptyMap' == 'withNonEmpty' 'Nothing' 'Just'@
withNonEmpty
    :: r                    -- ^ value to return if map is empty
    -> (NEMap k a -> r)     -- ^ function to apply if map is not empty
    -> Map k a
    -> r
withNonEmpty :: forall r k a. r -> (NEMap k a -> r) -> Map k a -> r
withNonEmpty r
def NEMap k a -> r
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe r
def NEMap k a -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> Maybe (NEMap k a)
nonEmptyMap
{-# INLINE withNonEmpty #-}

-- | /O(n*log n)/. Build a non-empty map from a non-empty list of
-- key\/value pairs. See also 'Data.Map.NonEmpty.fromAscList'. If the list
-- contains more than one value for the same key, the last value for the
-- key is retained.
--
-- > fromList ((5,"a") :| [(3,"b"), (5, "c")]) == fromList ((5,"c") :| [(3,"b")])
-- > fromList ((5,"c") :| [(3,"b"), (5, "a")]) == fromList ((5,"a") :| [(3,"b")])

-- TODO: write manually and optimize to be equivalent to
-- 'fromDistinctAscList' if items are ordered, just like the actual
-- 'M.fromList'.
fromList :: Ord k => NonEmpty (k, a) -> NEMap k a
fromList :: forall k a. Ord k => NonEmpty (k, a) -> NEMap k a
fromList ((k
k, a
v) :| [(k, a)]
xs) = forall r k a. r -> (NEMap k a -> r) -> Map k a -> r
withNonEmpty (forall k a. k -> a -> NEMap k a
singleton k
k a
v) (forall k a.
Ord k =>
(a -> a -> a) -> k -> a -> NEMap k a -> NEMap k a
insertWith (forall a b. a -> b -> a
const forall a. a -> a
id) k
k a
v)
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                        forall a b. (a -> b) -> a -> b
$ [(k, a)]
xs
{-# INLINE fromList #-}

-- | /O(1)/. A map with a single element.
--
-- > singleton 1 'a'        == fromList ((1, 'a') :| [])
-- > size (singleton 1 'a') == 1
singleton :: k -> a -> NEMap k a
singleton :: forall k a. k -> a -> NEMap k a
singleton k
k a
v = forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k a
v forall k a. Map k a
M.empty
{-# INLINE singleton #-}

-- | /O(log n)/. Insert with a function, combining new value and old value.
-- @'insertWith' f key value mp@ will insert the pair (key, value) into
-- @mp@ if key does not exist in the map. If the key does exist, the
-- function will insert the pair @(key, f new_value old_value)@.
--
-- See 'Data.Map.NonEmpty.insertMapWith' for a version where the first
-- argument is a 'Map'.
--
-- > insertWith (++) 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "xxxa")])
-- > insertWith (++) 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")])
insertWith
    :: Ord k
    => (a -> a -> a)
    -> k
    -> a
    -> NEMap k a
    -> NEMap k a
insertWith :: forall k a.
Ord k =>
(a -> a -> a) -> k -> a -> NEMap k a -> NEMap k a
insertWith a -> a -> a
f k
k a
v n :: NEMap k a
n@(NEMap k
k0 a
v0 Map k a
m) = case forall a. Ord a => a -> a -> Ordering
compare k
k k
k0 of
    Ordering
LT -> forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k  a
v        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. NEMap k a -> Map k a
toMap            forall a b. (a -> b) -> a -> b
$ NEMap k a
n
    Ordering
EQ -> forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k  (a -> a -> a
f a
v a
v0) Map k a
m
    Ordering
GT -> forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k0 a
v0       forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith a -> a -> a
f k
k a
v Map k a
m
{-# INLINE insertWith #-}


-- | Left-biased union
instance Ord k => Semigroup (NEMap k a) where
    <> :: NEMap k a -> NEMap k a -> NEMap k a
(<>) = forall k a. Ord k => NEMap k a -> NEMap k a -> NEMap k a
union
    {-# INLINE (<>) #-}
    sconcat :: NonEmpty (NEMap k a) -> NEMap k a
sconcat = forall (f :: * -> *) k a.
(Foldable1 f, Ord k) =>
f (NEMap k a) -> NEMap k a
unions
    {-# INLINE sconcat #-}

instance Functor (NEMap k) where
    fmap :: forall a b. (a -> b) -> NEMap k a -> NEMap k b
fmap = forall a b k. (a -> b) -> NEMap k a -> NEMap k b
map
    {-# INLINE fmap #-}
    a
x <$ :: forall a b. a -> NEMap k b -> NEMap k a
<$ NEMap k
k b
_ Map k b
m = forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k a
x (a
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Map k b
m)
    {-# INLINE (<$) #-}

-- | @since 0.3.4.4
instance Invariant (NEMap k) where
    invmap :: forall a b. (a -> b) -> (b -> a) -> NEMap k a -> NEMap k b
invmap a -> b
f b -> a
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f
    {-# INLINE invmap #-}

-- | Traverses elements in order of ascending keys
--
-- 'Data.Foldable.foldr1', 'Data.Foldable.foldl1', 'Data.Foldable.minimum',
-- 'Data.Foldable.maximum' are all total.
instance F.Foldable (NEMap k) where
#if MIN_VERSION_base(4,11,0)
    fold :: forall m. Monoid m => NEMap k m -> m
fold      (NEMap k
_ m
v Map k m
m) = m
v forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold Map k m
m
    {-# INLINE fold #-}
    foldMap :: forall m a. Monoid m => (a -> m) -> NEMap k a -> m
foldMap a -> m
f (NEMap k
_ a
v Map k a
m) = a -> m
f a
v forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f Map k a
m
    {-# INLINE foldMap #-}
#else
    fold      (NEMap _ v m) = v `mappend` F.fold m
    {-# INLINE fold #-}
    foldMap f (NEMap _ v m) = f v `mappend` F.foldMap f m
    {-# INLINE foldMap #-}
#endif
    foldr :: forall a b. (a -> b -> b) -> b -> NEMap k a -> b
foldr   = forall a b k. (a -> b -> b) -> b -> NEMap k a -> b
foldr
    {-# INLINE foldr #-}
    foldr' :: forall a b. (a -> b -> b) -> b -> NEMap k a -> b
foldr'  = forall a b k. (a -> b -> b) -> b -> NEMap k a -> b
foldr'
    {-# INLINE foldr' #-}
    foldr1 :: forall a. (a -> a -> a) -> NEMap k a -> a
foldr1  = forall a k. (a -> a -> a) -> NEMap k a -> a
foldr1
    {-# INLINE foldr1 #-}
    foldl :: forall b a. (b -> a -> b) -> b -> NEMap k a -> b
foldl   = forall a b k. (a -> b -> a) -> a -> NEMap k b -> a
foldl
    {-# INLINE foldl #-}
    foldl' :: forall b a. (b -> a -> b) -> b -> NEMap k a -> b
foldl'  = forall a b k. (a -> b -> a) -> a -> NEMap k b -> a
foldl'
    {-# INLINE foldl' #-}
    foldl1 :: forall a. (a -> a -> a) -> NEMap k a -> a
foldl1  = forall a k. (a -> a -> a) -> NEMap k a -> a
foldl1
    {-# INLINE foldl1 #-}
    null :: forall a. NEMap k a -> Bool
null NEMap k a
_  = Bool
False
    {-# INLINE null #-}
    length :: forall a. NEMap k a -> Int
length  = forall k a. NEMap k a -> Int
size
    {-# INLINE length #-}
    elem :: forall a. Eq a => a -> NEMap k a -> Bool
elem a
x (NEMap k
_ a
v Map k a
m) = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
F.elem a
x Map k a
m
                        Bool -> Bool -> Bool
|| a
x forall a. Eq a => a -> a -> Bool
== a
v
    {-# INLINE elem #-}
    -- TODO: use build
    toList :: forall a. NEMap k a -> [a]
toList  = forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. NEMap k a -> NonEmpty a
elems
    {-# INLINE toList #-}

-- | Traverses elements in order of ascending keys
instance Traversable (NEMap k) where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NEMap k a -> f (NEMap k b)
traverse a -> f b
f (NEMap k
k a
v Map k a
m) = forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v forall (f :: * -> *) a b. Applicative f => 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 Map k a
m
    {-# INLINE traverse #-}
    sequenceA :: forall (f :: * -> *) a.
Applicative f =>
NEMap k (f a) -> f (NEMap k a)
sequenceA (NEMap k
k f a
v Map k (f a)
m)  = forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA Map k (f a)
m
    {-# INLINE sequenceA #-}

-- | Traverses elements in order of ascending keys
instance Foldable1 (NEMap k) where
#if MIN_VERSION_base(4,11,0)
    fold1 :: forall m. Semigroup m => NEMap k m -> m
fold1 (NEMap k
_ m
v Map k m
m) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe m
v (m
v forall a. Semigroup a => a -> a -> a
<>)
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap forall a. a -> Maybe a
Just
                        forall a b. (a -> b) -> a -> b
$ Map k m
m
#else
    fold1 (NEMap _ v m) = option v (v <>)
                        . F.foldMap (Option . Just)
                        $ m
#endif
    {-# INLINE fold1 #-}
    foldMap1 :: forall m a. Semigroup m => (a -> m) -> NEMap k a -> m
foldMap1 a -> m
f = forall m k a. Semigroup m => (k -> a -> m) -> NEMap k a -> m
foldMapWithKey (forall a b. a -> b -> a
const a -> m
f)
    {-# INLINE foldMap1 #-}
    toNonEmpty :: forall a. NEMap k a -> NonEmpty a
toNonEmpty = forall k a. NEMap k a -> NonEmpty a
elems
    {-# INLINE toNonEmpty #-}

-- | Traverses elements in order of ascending keys
instance Traversable1 (NEMap k) where
    traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> NEMap k a -> f (NEMap k b)
traverse1 a -> f b
f = forall (t :: * -> *) k a b.
Apply t =>
(k -> a -> t b) -> NEMap k a -> t (NEMap k b)
traverseWithKey1 (forall a b. a -> b -> a
const a -> f b
f)
    {-# INLINE traverse1 #-}
    sequence1 :: forall (f :: * -> *) b. Apply f => NEMap k (f b) -> f (NEMap k b)
sequence1 (NEMap k
k f b
v Map k (f b)
m0) = case forall (f :: * -> *) a. MaybeApply f a -> Either (f a) a
runMaybeApply MaybeApply f (Map k b)
m1 of
        Left  f (Map k b)
m2 -> forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
v forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (Map k b)
m2
        Right Map k b
m2 -> forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k) Map k b
m2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
v
      where
        m1 :: MaybeApply f (Map k b)
m1 = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) Map k (f b)
m0
    {-# INLINABLE sequence1 #-}

-- | 'extract' gets the value at the minimal key, and 'duplicate' produces
-- a map of maps comprised of all keys from the original map greater than
-- or equal to the current key.
--
-- @since 0.1.1.0
instance Comonad (NEMap k) where
    extract :: forall a. NEMap k a -> a
extract = forall k a. NEMap k a -> a
nemV0
    {-# INLINE extract #-}
    duplicate :: forall a. NEMap k a -> NEMap k (NEMap k a)
duplicate n0 :: NEMap k a
n0@(NEMap k
k0 a
_ Map k a
m0) = forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k0 NEMap k a
n0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
                                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
M.mapAccumWithKey forall {k} {a}. Map k a -> k -> a -> (Map k a, NEMap k a)
go Map k a
m0
                                 forall a b. (a -> b) -> a -> b
$ Map k a
m0
      where
        go :: Map k a -> k -> a -> (Map k a, NEMap k a)
go Map k a
m k
k a
v = (Map k a
m', forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k a
v Map k a
m')
          where
            !m' :: Map k a
m' = forall k a. Map k a -> Map k a
M.deleteMin Map k a
m
    {-# INLINE duplicate #-}

-- | /O(n)/. Test if the internal map structure is valid.
valid :: Ord k => NEMap k a -> Bool
valid :: forall k a. Ord k => NEMap k a -> Bool
valid (NEMap k
k a
_ Map k a
m) = forall k a. Ord k => Map k a -> Bool
M.valid Map k a
m
                   Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((k
k forall a. Ord a => a -> a -> Bool
<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall k a. Map k a -> Maybe ((k, a), Map k a)
M.minViewWithKey Map k a
m)





-- | /O(log n)/. Insert new key and value into a map where keys are
-- /strictly greater than/ the new key.  That is, the new key must be
-- /strictly less than/ all keys present in the 'Map'.  /The precondition
-- is not checked./
--
-- While this has the same asymptotics as @Data.Map.insert@, it saves
-- a constant factor for key comparison (so may be helpful if comparison is
-- expensive) and also does not require an 'Ord' instance for the key type.
insertMinMap :: k -> a -> Map k a -> Map k a
insertMinMap :: forall k a. k -> a -> Map k a -> Map k a
insertMinMap k
kx a
x = \case
    Map k a
Tip            -> forall k a. k -> a -> Map k a
M.singleton k
kx a
x
    Bin Int
_ k
ky a
y Map k a
l Map k a
r -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
M.balanceL k
ky a
y (forall k a. k -> a -> Map k a -> Map k a
insertMinMap k
kx a
x Map k a
l) Map k a
r
{-# INLINABLE insertMinMap #-}

-- | /O(log n)/. Insert new key and value into a map where keys are
-- /strictly less than/ the new key.  That is, the new key must be
-- /strictly greater than/ all keys present in the 'Map'.  /The
-- precondition is not checked./
--
-- While this has the same asymptotics as @Data.Map.insert@, it saves
-- a constant factor for key comparison (so may be helpful if comparison is
-- expensive) and also does not require an 'Ord' instance for the key type.
insertMaxMap :: k -> a -> Map k a -> Map k a
insertMaxMap :: forall k a. k -> a -> Map k a -> Map k a
insertMaxMap k
kx a
x = \case
    Map k a
Tip            -> forall k a. k -> a -> Map k a
M.singleton k
kx a
x
    Bin Int
_ k
ky a
y Map k a
l Map k a
r -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
M.balanceR k
ky a
y Map k a
l (forall k a. k -> a -> Map k a -> Map k a
insertMaxMap k
kx a
x Map k a
r)
{-# INLINABLE insertMaxMap #-}