{-# 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 qualified Data.Aeson as A
import Data.Coerce
import Data.Data
import qualified Data.Foldable as F
import Data.Function
import Data.Functor.Alt
import Data.Functor.Classes
import Data.Functor.Invariant
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map as M
import Data.Map.Internal (Map (..))
import qualified Data.Map.Internal as M
import Data.Maybe
import Data.Semigroup
import Data.Semigroup.Foldable (Foldable1 (fold1))
import qualified Data.Semigroup.Foldable as F1
import Data.Semigroup.Traversable (Traversable1 (..))
import Text.Read
import Prelude hiding (Foldable (..), map)

-- | 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 =
    Map k a -> Int
forall k a. Map k a -> Int
M.size (NEMap k a -> Map k a
forall k a. NEMap k a -> Map k a
nemMap NEMap k a
t1) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Map k a -> Int
forall k a. Map k a -> Int
M.size (NEMap k a -> Map k a
forall k a. NEMap k a -> Map k a
nemMap NEMap k a
t2)
      Bool -> Bool -> Bool
&& NEMap k a -> NonEmpty (k, a)
forall k a. NEMap k a -> NonEmpty (k, a)
toList NEMap k a
t1 NonEmpty (k, a) -> NonEmpty (k, a) -> Bool
forall a. Eq a => a -> a -> Bool
== NEMap k a -> NonEmpty (k, a)
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 = NonEmpty (k, a) -> NonEmpty (k, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (NonEmpty (k, a) -> NonEmpty (k, a) -> Ordering)
-> (NEMap k a -> NonEmpty (k, a))
-> NEMap k a
-> NEMap k a
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEMap k a -> NonEmpty (k, a)
forall k a. NEMap k a -> NonEmpty (k, a)
toList
  < :: NEMap k a -> NEMap k a -> Bool
(<) = NonEmpty (k, a) -> NonEmpty (k, a) -> Bool
forall a. Ord a => a -> a -> Bool
(<) (NonEmpty (k, a) -> NonEmpty (k, a) -> Bool)
-> (NEMap k a -> NonEmpty (k, a)) -> NEMap k a -> NEMap k a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEMap k a -> NonEmpty (k, a)
forall k a. NEMap k a -> NonEmpty (k, a)
toList
  > :: NEMap k a -> NEMap k a -> Bool
(>) = NonEmpty (k, a) -> NonEmpty (k, a) -> Bool
forall a. Ord a => a -> a -> Bool
(>) (NonEmpty (k, a) -> NonEmpty (k, a) -> Bool)
-> (NEMap k a -> NonEmpty (k, a)) -> NEMap k a -> NEMap k a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEMap k a -> NonEmpty (k, a)
forall k a. NEMap k a -> NonEmpty (k, a)
toList
  <= :: NEMap k a -> NEMap k a -> Bool
(<=) = NonEmpty (k, a) -> NonEmpty (k, a) -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (NonEmpty (k, a) -> NonEmpty (k, a) -> Bool)
-> (NEMap k a -> NonEmpty (k, a)) -> NEMap k a -> NEMap k a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEMap k a -> NonEmpty (k, a)
forall k a. NEMap k a -> NonEmpty (k, a)
toList
  >= :: NEMap k a -> NEMap k a -> Bool
(>=) = NonEmpty (k, a) -> NonEmpty (k, a) -> Bool
forall a. Ord a => a -> a -> Bool
(>=) (NonEmpty (k, a) -> NonEmpty (k, a) -> Bool)
-> (NEMap k a -> NonEmpty (k, a)) -> NEMap k a -> NEMap k a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEMap k a -> NonEmpty (k, a)
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 =
    NEMap a c -> Int
forall k a. NEMap k a -> Int
size NEMap a c
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== NEMap b d -> Int
forall k a. NEMap k a -> Int
size NEMap b d
n Bool -> Bool -> Bool
&& ((a, c) -> (b, d) -> Bool)
-> NonEmpty (a, c) -> NonEmpty (b, d) -> Bool
forall a b. (a -> b -> Bool) -> NonEmpty a -> NonEmpty b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> b -> Bool) -> (c -> d -> Bool) -> (a, c) -> (b, d) -> Bool
forall a b c d.
(a -> b -> Bool) -> (c -> d -> Bool) -> (a, c) -> (b, d) -> Bool
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) (NEMap a c -> NonEmpty (a, c)
forall k a. NEMap k a -> NonEmpty (k, a)
toList NEMap a c
m) (NEMap b d -> NonEmpty (b, d)
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 = (k -> k -> Bool)
-> (a -> b -> Bool) -> NEMap k a -> NEMap k b -> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> NEMap a c -> NEMap b d -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 k -> k -> Bool
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 =
    ((a, c) -> (b, d) -> Ordering)
-> NonEmpty (a, c) -> NonEmpty (b, d) -> Ordering
forall a b.
(a -> b -> Ordering) -> NonEmpty a -> NonEmpty b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering)
-> (c -> d -> Ordering) -> (a, c) -> (b, d) -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> (a, c) -> (b, d) -> Ordering
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) (NEMap a c -> NonEmpty (a, c)
forall k a. NEMap k a -> NonEmpty (k, a)
toList NEMap a c
m) (NEMap b d -> NonEmpty (b, d)
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 = (k -> k -> Ordering)
-> (a -> b -> Ordering) -> NEMap k a -> NEMap k b -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> NEMap a c -> NEMap b d -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 k -> k -> Ordering
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 =
    (Int -> NonEmpty (a, b) -> ShowS)
-> String -> Int -> NonEmpty (a, b) -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> (a, b) -> ShowS)
-> ([(a, b)] -> ShowS) -> Int -> NonEmpty (a, b) -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NonEmpty a -> ShowS
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 (NEMap a b -> NonEmpty (a, b)
forall k a. NEMap k a -> NonEmpty (k, a)
toList NEMap a b
m)
    where
      sp :: Int -> (a, b) -> ShowS
sp = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, b)
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, b)
-> ShowS
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 = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [(a, b)]
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [(a, b)]
-> ShowS
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 = (Int -> k -> ShowS)
-> ([k] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> NEMap k a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> NEMap a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> k -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [k] -> ShowS
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 =
    (String -> ReadS (NEMap k a)) -> Int -> ReadS (NEMap k a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (NEMap k a)) -> Int -> ReadS (NEMap k a))
-> (String -> ReadS (NEMap k a)) -> Int -> ReadS (NEMap k a)
forall a b. (a -> b) -> a -> b
$
      (Int -> ReadS (NonEmpty (k, a)))
-> String
-> (NonEmpty (k, a) -> NEMap k a)
-> String
-> ReadS (NEMap k a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith ((Int -> ReadS (k, a))
-> ReadS [(k, a)] -> Int -> ReadS (NonEmpty (k, a))
forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NonEmpty a)
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" NonEmpty (k, a) -> NEMap k a
forall k a. Ord k => NonEmpty (k, a) -> NEMap k a
fromList
    where
      rp' :: Int -> ReadS (k, a)
rp' = (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (k, a)
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (k, a)
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' = (Int -> ReadS a) -> ReadS [a] -> ReadS [(k, a)]
forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [(k, a)]
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 = ReadPrec (NEMap k e) -> ReadPrec (NEMap k e)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (NEMap k e) -> ReadPrec (NEMap k e))
-> ReadPrec (NEMap k e) -> ReadPrec (NEMap k e)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (NEMap k e) -> ReadPrec (NEMap k e)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (NEMap k e) -> ReadPrec (NEMap k e))
-> ReadPrec (NEMap k e) -> ReadPrec (NEMap k e)
forall a b. (a -> b) -> a -> b
$ do
    Ident String
"fromList" <- ReadPrec Lexeme
lexP
    NonEmpty (k, e)
xs <- ReadPrec (NonEmpty (k, e)) -> ReadPrec (NonEmpty (k, e))
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (NonEmpty (k, e)) -> ReadPrec (NonEmpty (k, e)))
-> (ReadPrec (NonEmpty (k, e)) -> ReadPrec (NonEmpty (k, e)))
-> ReadPrec (NonEmpty (k, e))
-> ReadPrec (NonEmpty (k, e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReadPrec (NonEmpty (k, e)) -> ReadPrec (NonEmpty (k, e))
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (NonEmpty (k, e)) -> ReadPrec (NonEmpty (k, e)))
-> ReadPrec (NonEmpty (k, e)) -> ReadPrec (NonEmpty (k, e))
forall a b. (a -> b) -> a -> b
$ ReadPrec (NonEmpty (k, e))
forall a. Read a => ReadPrec a
readPrec
    NEMap k e -> ReadPrec (NEMap k e)
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (k, e) -> NEMap k e
forall k a. Ord k => NonEmpty (k, a) -> NEMap k a
fromList NonEmpty (k, e)
xs)
  readListPrec :: ReadPrec [NEMap k e]
readListPrec = ReadPrec [NEMap k e]
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 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
. NonEmpty (k, a) -> ShowS
forall a. Show a => a -> ShowS
shows (NEMap k a -> NonEmpty (k, a)
forall k a. NEMap k a -> NonEmpty (k, a)
toList NEMap k a
m) ShowS -> ShowS -> ShowS
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) = k -> ()
forall a. NFData a => a -> ()
rnf k
k () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
v () -> () -> ()
forall a b. a -> b -> b
`seq` Map k a -> ()
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
#if MIN_VERSION_base(4,16,0)
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 = (NonEmpty (k, a) -> NEMap k a) -> c (NonEmpty (k, a) -> NEMap k a)
forall g. g -> c g
z NonEmpty (k, a) -> NEMap k a
forall k a. Ord k => NonEmpty (k, a) -> NEMap k a
fromList c (NonEmpty (k, a) -> NEMap k a)
-> NonEmpty (k, a) -> c (NEMap k a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` NEMap k a -> NonEmpty (k, a)
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 -> c (NonEmpty (k, a) -> NEMap k a) -> c (NEMap k a)
forall b r. Data b => c (b -> r) -> c r
k ((NonEmpty (k, a) -> NEMap k a) -> c (NonEmpty (k, a) -> NEMap k a)
forall r. r -> c r
z NonEmpty (k, a) -> NEMap k a
forall k a. Ord k => NonEmpty (k, a) -> NEMap k a
fromList)
    Int
_ -> String -> c (NEMap k a)
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 = c (t k a) -> Maybe (c (NEMap k a))
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (NEMap k a))
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
#else
#ifndef __HLINT__
instance (Data k, Data a, Ord k) => Data (NEMap k a) where
  gfoldl f z m = z fromList `f` toList m
  toConstr _ = fromListConstr
  gunfold k z c = case constrIndex c of
    1 -> k (z fromList)
    _ -> error "gunfold"
  dataTypeOf _ = mapDataType
  dataCast2 f = gcast2 f
#endif
#endif

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 = Map k a -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Map k a -> Value) -> (NEMap k a -> Map k a) -> NEMap k a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEMap k a -> Map k a
forall k a. NEMap k a -> Map k a
toMap
  toEncoding :: NEMap k a -> Encoding
toEncoding = Map k a -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding (Map k a -> Encoding)
-> (NEMap k a -> Map k a) -> NEMap k a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEMap k a -> Map k a
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 =
    Parser (NEMap k a)
-> (NEMap k a -> Parser (NEMap k a))
-> Map k a
-> Parser (NEMap k a)
forall r k a. r -> (NEMap k a -> r) -> Map k a -> r
withNonEmpty (String -> Parser (NEMap k a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err) NEMap k a -> Parser (NEMap k a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Map k a -> Parser (NEMap k a))
-> (Value -> Parser (Map k a)) -> Value -> Parser (NEMap k a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Parser (Map k a)
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
(<!>) = 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` (a -> b -> b) -> b -> Map k a -> b
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 = (a -> b -> b) -> b -> Map k a -> b
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) =
  a -> ((a, Map k a) -> a) -> Maybe (a, Map k a) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
v (a -> a -> a
f a
v (a -> a) -> ((a, Map k a) -> a) -> (a, Map k a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Map k a -> a) -> (a, Map k a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> a -> a) -> a -> Map k a -> a
forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr a -> a -> a
f))
    (Maybe (a, Map k a) -> a)
-> (Map k a -> Maybe (a, Map k a)) -> Map k a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> Maybe (a, Map k a)
forall k a. Map k a -> Maybe (a, Map k a)
M.maxView
    (Map k a -> a) -> Map k a -> a
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) = (a -> b -> a) -> a -> Map k b -> a
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) = (a -> b -> a) -> a -> Map k b -> a
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) = (a -> a -> a) -> a -> Map k a -> a
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) = m -> (m -> m) -> Maybe m -> 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 m -> m -> m
forall a. Semigroup a => a -> a -> a
<>)
                                (Maybe m -> m) -> (Map k a -> Maybe m) -> Map k a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> a -> Maybe m) -> Map k a -> Maybe m
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
M.foldMapWithKey (\k
k -> m -> Maybe m
forall a. a -> Maybe a
Just (m -> Maybe m) -> (a -> m) -> a -> Maybe m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> a -> m
f k
k)
                                (Map k a -> m) -> Map k a -> m
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) = k -> b -> Map k b -> NEMap k b
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k0 (a -> b
f a
v) ((a -> b) -> Map k a -> Map k b
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 k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k1 k
k2 of
  Ordering
LT -> k -> a -> Map k a -> NEMap k a
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k1 a
v1 (Map k a -> NEMap k a)
-> (NEMap k a -> Map k a) -> NEMap k a -> NEMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map k a
m1 (Map k a -> Map k a)
-> (NEMap k a -> Map k a) -> NEMap k a -> Map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEMap k a -> Map k a
forall k a. NEMap k a -> Map k a
toMap (NEMap k a -> NEMap k a) -> NEMap k a -> NEMap k a
forall a b. (a -> b) -> a -> b
$ NEMap k a
n2
  Ordering
EQ -> k -> a -> Map k a -> NEMap k a
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k1 a
v1 (Map k a -> NEMap k a)
-> (Map k a -> Map k a) -> Map k a -> NEMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map k a
m1 (Map k a -> NEMap k a) -> Map k a -> NEMap k a
forall a b. (a -> b) -> a -> b
$ Map k a
m2
  Ordering
GT -> k -> a -> Map k a -> NEMap k a
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k2 a
v2 (Map k a -> NEMap k a)
-> (Map k a -> Map k a) -> Map k a -> NEMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (NEMap k a -> Map k a
forall k a. NEMap k a -> Map k a
toMap NEMap k a
n1) (Map k a -> NEMap k a) -> Map k a -> NEMap k a
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 (f (NEMap k a) -> NonEmpty (NEMap k a)
forall a. f a -> NonEmpty a
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
F1.toNonEmpty -> (NEMap k a
m :| [NEMap k a]
ms)) = (NEMap k a -> NEMap k a -> NEMap k a)
-> NEMap k a -> [NEMap k a] -> NEMap k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' NEMap k a -> NEMap k a -> NEMap k a
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 a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Map k a -> [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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map k a -> Int
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) = k -> a -> Map k a -> Map k a
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) = k -> b -> Map k b -> NEMap k b
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k (b -> Map k b -> NEMap k b) -> t b -> t (Map k b -> NEMap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> t b
f k
k a
v t (Map k b -> NEMap k b) -> t (Map k b) -> t (NEMap k b)
forall a b. t (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (k -> a -> t b) -> Map k a -> t (Map k 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 MaybeApply t (Map k b) -> Either (t (Map k b)) (Map k b)
forall (f :: * -> *) a. MaybeApply f a -> Either (f a) a
runMaybeApply MaybeApply t (Map k b)
m1 of
  Left t (Map k b)
m2 -> k -> b -> Map k b -> NEMap k b
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k0 (b -> Map k b -> NEMap k b) -> t b -> t (Map k b -> NEMap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> t b
f k
k0 a
v t (Map k b -> NEMap k b) -> t (Map k b) -> t (NEMap k b)
forall a b. t (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> t (Map k b)
m2
  Right Map k b
m2 -> (b -> Map k b -> NEMap k b) -> Map k b -> b -> NEMap k b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> b -> Map k b -> NEMap k b
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k0) Map k b
m2 (b -> NEMap k b) -> t b -> t (NEMap k b)
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 = (k -> a -> MaybeApply t b) -> Map k a -> MaybeApply t (Map k b)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey (\k
k -> Either (t b) b -> MaybeApply t b
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (Either (t b) b -> MaybeApply t b)
-> (a -> Either (t b) b) -> a -> MaybeApply t b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> Either (t b) b
forall a b. a -> Either a b
Left (t b -> Either (t b) b) -> (a -> t b) -> a -> Either (t b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> a -> t b
f k
k) Map k a
m0
{-# INLINEABLE 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) (k, a) -> [(k, a)] -> NonEmpty (k, a)
forall a. a -> [a] -> NonEmpty a
:| Map k a -> [(k, 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 = ((((k, a), Map k a) -> NEMap k a)
-> Maybe ((k, a), Map k a) -> Maybe (NEMap k a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((((k, a), Map k a) -> NEMap k a)
 -> Maybe ((k, a), Map k a) -> Maybe (NEMap k a))
-> ((k -> a -> Map k a -> NEMap k a)
    -> ((k, a), Map k a) -> NEMap k a)
-> (k -> a -> Map k a -> NEMap k a)
-> Maybe ((k, a), Map k a)
-> Maybe (NEMap k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, a) -> Map k a -> NEMap k a) -> ((k, a), Map k a) -> NEMap k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (((k, a) -> Map k a -> NEMap k a)
 -> ((k, a), Map k a) -> NEMap k a)
-> ((k -> a -> Map k a -> NEMap k a)
    -> (k, a) -> Map k a -> NEMap k a)
-> (k -> a -> Map k a -> NEMap k a)
-> ((k, a), Map k a)
-> NEMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> a -> Map k a -> NEMap k a) -> (k, a) -> Map k a -> NEMap k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry) k -> a -> Map k a -> NEMap k a
forall k a. k -> a -> Map k a -> NEMap k a
NEMap (Maybe ((k, a), Map k a) -> Maybe (NEMap k a))
-> (Map k a -> Maybe ((k, a), Map k a))
-> Map k a
-> Maybe (NEMap 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)
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 ::
  -- | value to return if map is empty
  r ->
  -- | function to apply if map is not empty
  (NEMap k a -> r) ->
  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 = r -> (NEMap k a -> r) -> Maybe (NEMap k a) -> r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe r
def NEMap k a -> r
f (Maybe (NEMap k a) -> r)
-> (Map k a -> Maybe (NEMap k a)) -> Map k a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> Maybe (NEMap k a)
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) =
  NEMap k a -> (NEMap k a -> NEMap k a) -> Map k a -> NEMap k a
forall r k a. r -> (NEMap k a -> r) -> Map k a -> r
withNonEmpty (k -> a -> NEMap k a
forall k a. k -> a -> NEMap k a
singleton k
k a
v) ((a -> a -> a) -> k -> a -> NEMap k a -> NEMap k a
forall k a.
Ord k =>
(a -> a -> a) -> k -> a -> NEMap k a -> NEMap k a
insertWith ((a -> a) -> a -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id) k
k a
v)
    (Map k a -> NEMap k a)
-> ([(k, a)] -> Map k a) -> [(k, a)] -> NEMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    ([(k, a)] -> NEMap k a) -> [(k, a)] -> NEMap k a
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 = k -> a -> Map k a -> NEMap k a
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k a
v Map k a
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 k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
k0 of
  Ordering
LT -> k -> a -> Map k a -> NEMap k a
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k a
v (Map k a -> NEMap k a)
-> (NEMap k a -> Map k a) -> NEMap k a -> NEMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEMap k a -> Map k a
forall k a. NEMap k a -> Map k a
toMap (NEMap k a -> NEMap k a) -> NEMap k a -> NEMap k a
forall a b. (a -> b) -> a -> b
$ NEMap k a
n
  Ordering
EQ -> k -> a -> Map k a -> NEMap k a
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 -> k -> a -> Map k a -> NEMap k a
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k0 a
v0 (Map k a -> NEMap k a) -> Map k a -> NEMap k a
forall a b. (a -> b) -> a -> b
$ (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
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
(<>) = 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 = NonEmpty (NEMap k a) -> NEMap k a
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 = (a -> b) -> NEMap k a -> NEMap k b
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 = k -> a -> Map k a -> NEMap k a
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k a
x (a
x a -> Map k b -> Map k a
forall a b. a -> Map k b -> Map k a
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
_ = (a -> b) -> NEMap k a -> NEMap k b
forall a b. (a -> b) -> NEMap k a -> NEMap k b
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.
#if MIN_VERSION_base(4,11,0)
instance F.Foldable (NEMap k) where
    fold :: forall m. Monoid m => NEMap k m -> m
fold      (NEMap k
_ m
v Map k m
m) = m
v m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Map k m -> m
forall m. Monoid m => Map k m -> m
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 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Map k a -> m
forall m a. Monoid m => (a -> m) -> Map k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f Map k a
m
    {-# INLINE foldMap #-}
    foldr :: forall a b. (a -> b -> b) -> b -> NEMap k a -> b
foldr   = (a -> b -> b) -> b -> NEMap k a -> b
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'  = (a -> b -> b) -> b -> NEMap k a -> b
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  = (a -> a -> a) -> NEMap k a -> a
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   = (b -> a -> b) -> b -> NEMap k a -> b
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'  = (b -> a -> b) -> b -> NEMap k a -> b
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  = (a -> a -> a) -> NEMap k a -> a
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  = NEMap k a -> Int
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) = a -> Map k a -> Bool
forall a. Eq a => a -> Map k a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
F.elem a
x Map k a
m
                        Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v
    {-# INLINE elem #-}
    -- TODO: use build
    toList :: forall a. NEMap k a -> [a]
toList  = NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (NonEmpty a -> [a])
-> (NEMap k a -> NonEmpty a) -> NEMap k a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEMap k a -> NonEmpty a
forall k a. NEMap k a -> NonEmpty a
elems
    {-# INLINE toList #-}
#else
instance F.Foldable (NEMap k) where
    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 #-}
    foldr   = foldr
    {-# INLINE foldr #-}
    foldr'  = foldr'
    {-# INLINE foldr' #-}
    foldr1  = foldr1
    {-# INLINE foldr1 #-}
    foldl   = foldl
    {-# INLINE foldl #-}
    foldl'  = foldl'
    {-# INLINE foldl' #-}
    foldl1  = foldl1
    {-# INLINE foldl1 #-}
    null _  = False
    {-# INLINE null #-}
    length  = size
    {-# INLINE length #-}
    elem x (NEMap _ v m) = F.elem x m
                        || x == v
    {-# INLINE elem #-}
    -- TODO: use build
    toList  = F.toList . elems
    {-# INLINE toList #-}
#endif

-- | 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) = k -> b -> Map k b -> NEMap k b
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k (b -> Map k b -> NEMap k b) -> f b -> f (Map k b -> NEMap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v f (Map k b -> NEMap k b) -> f (Map k b) -> f (NEMap k b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map k a -> f (Map k 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) = k -> a -> Map k a -> NEMap k a
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k (a -> Map k a -> NEMap k a) -> f a -> f (Map k a -> NEMap k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
v f (Map k a -> NEMap k a) -> f (Map k a) -> f (NEMap k a)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map k (f a) -> f (Map k a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => Map k (f a) -> f (Map k a)
sequenceA Map k (f a)
m
  {-# INLINE sequenceA #-}

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

-- | 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 = (k -> a -> f b) -> NEMap k a -> f (NEMap k b)
forall (t :: * -> *) k a b.
Apply t =>
(k -> a -> t b) -> NEMap k a -> t (NEMap k b)
traverseWithKey1 ((a -> f b) -> k -> a -> f b
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 MaybeApply f (Map k b) -> Either (f (Map k b)) (Map k b)
forall (f :: * -> *) a. MaybeApply f a -> Either (f a) a
runMaybeApply MaybeApply f (Map k b)
m1 of
    Left f (Map k b)
m2 -> k -> b -> Map k b -> NEMap k b
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k (b -> Map k b -> NEMap k b) -> f b -> f (Map k b -> NEMap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
v f (Map k b -> NEMap k b) -> f (Map k b) -> f (NEMap k b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (Map k b)
m2
    Right Map k b
m2 -> (b -> Map k b -> NEMap k b) -> Map k b -> b -> NEMap k b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> b -> Map k b -> NEMap k b
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k) Map k b
m2 (b -> NEMap k b) -> f b -> f (NEMap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
v
    where
      m1 :: MaybeApply f (Map k b)
m1 = (f b -> MaybeApply f b) -> Map k (f b) -> MaybeApply f (Map k b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map k a -> f (Map k b)
traverse (Either (f b) b -> MaybeApply f b
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (Either (f b) b -> MaybeApply f b)
-> (f b -> Either (f b) b) -> f b -> MaybeApply f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> Either (f b) b
forall a b. a -> Either a b
Left) Map k (f b)
m0
  {-# INLINEABLE 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 = NEMap k a -> a
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) =
    k -> NEMap k a -> Map k (NEMap k a) -> NEMap k (NEMap k a)
forall k a. k -> a -> Map k a -> NEMap k a
NEMap k
k0 NEMap k a
n0
      (Map k (NEMap k a) -> NEMap k (NEMap k a))
-> (Map k a -> Map k (NEMap k a)) -> Map k a -> NEMap k (NEMap k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map k a, Map k (NEMap k a)) -> Map k (NEMap k a)
forall a b. (a, b) -> b
snd
      ((Map k a, Map k (NEMap k a)) -> Map k (NEMap k a))
-> (Map k a -> (Map k a, Map k (NEMap k a)))
-> Map k a
-> Map k (NEMap k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map k a -> k -> a -> (Map k a, NEMap k a))
-> Map k a -> Map k a -> (Map k a, Map k (NEMap k a))
forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
M.mapAccumWithKey Map k a -> k -> a -> (Map k a, NEMap k a)
forall {k} {a}. Map k a -> k -> a -> (Map k a, NEMap k a)
go Map k a
m0
      (Map k a -> NEMap k (NEMap k a)) -> Map k a -> NEMap k (NEMap k a)
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', k -> a -> Map k a -> NEMap k a
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' = Map k a -> Map k a
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) =
  Map k a -> Bool
forall k a. Ord k => Map k a -> Bool
M.valid Map k a
m
    Bool -> Bool -> Bool
&& (((k, a), Map k a) -> Bool) -> Maybe ((k, a), Map k a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<) (k -> Bool)
-> (((k, a), Map k a) -> k) -> ((k, a), Map k a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, a) -> k
forall a b. (a, b) -> a
fst ((k, a) -> k)
-> (((k, a), Map k a) -> (k, a)) -> ((k, a), Map k a) -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, a), Map k a) -> (k, a)
forall a b. (a, b) -> a
fst) (Map k a -> Maybe ((k, a), Map k a)
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 -> k -> a -> Map k a
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 -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
M.balanceL k
ky a
y (k -> a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a
insertMinMap k
kx a
x Map k a
l) Map k a
r
{-# INLINEABLE 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 -> k -> a -> Map k a
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 -> k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
M.balanceR k
ky a
y Map k a
l (k -> a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a
insertMaxMap k
kx a
x Map k a
r)
{-# INLINEABLE insertMaxMap #-}