{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# 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.Foldable.WithIndex (FoldableWithIndex (..))
import Data.Function
import Data.Functor.Alt
import Data.Functor.Classes
import Data.Functor.Invariant
import Data.Functor.WithIndex (FunctorWithIndex (..))
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 Data.Traversable.WithIndex (TraversableWithIndex (..))
import qualified GHC.Exts as Exts
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
  { nemK0 :: !k
  -- ^ invariant: must be smaller than smallest key in map
  , nemV0 :: a
  , nemMap :: !(Map k a)
  }
  deriving (Typeable)

instance (Eq k, Eq a) => Eq (NEMap k a) where
  t1 == t2 =
    M.size (nemMap t1) == M.size (nemMap t2)
      && toList t1 == toList t2

instance (Ord k, Ord a) => Ord (NEMap k a) where
  compare = compare `on` toList
  (<) = (<) `on` toList
  (>) = (>) `on` toList
  (<=) = (<=) `on` toList
  (>=) = (>=) `on` toList

instance Eq2 NEMap where
  liftEq2 eqk eqv m n =
    size m == size n && liftEq (liftEq2 eqk eqv) (toList m) (toList n)

instance Eq k => Eq1 (NEMap k) where
  liftEq = liftEq2 (==)

instance Ord2 NEMap where
  liftCompare2 cmpk cmpv m n =
    liftCompare (liftCompare2 cmpk cmpv) (toList m) (toList n)

instance Ord k => Ord1 (NEMap k) where
  liftCompare = liftCompare2 compare

instance Show2 NEMap where
  liftShowsPrec2 spk slk spv slv d m =
    showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m)
    where
      sp = liftShowsPrec2 spk slk spv slv
      sl = liftShowList2 spk slk spv slv

instance Show k => Show1 (NEMap k) where
  liftShowsPrec = liftShowsPrec2 showsPrec showList

instance (Ord k, Read k) => Read1 (NEMap k) where
  liftReadsPrec rp rl =
    readsData $
      readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList
    where
      rp' = liftReadsPrec rp rl
      rl' = liftReadList rp rl

instance (Ord k, Read k, Read e) => Read (NEMap k e) where
  readPrec = parens $ prec 10 $ do
    Ident "fromList" <- lexP
    xs <- parens . prec 10 $ readPrec
    return (fromList xs)
  readListPrec = readListPrecDefault

instance (Show k, Show a) => Show (NEMap k a) where
  showsPrec d m =
    showParen (d > 10) $
      showString "fromList (" . shows (toList m) . showString ")"

instance (NFData k, NFData a) => NFData (NEMap k a) where
  rnf (NEMap k v a) = rnf k `seq` rnf v `seq` rnf a

-- | @since 0.3.6.0
instance FunctorWithIndex k (NEMap k) where
  imap f (NEMap k v m) = NEMap k (f k v) (M.mapWithKey f m)

-- | @since 0.3.6.0
instance FoldableWithIndex k (NEMap k) where
  ifoldMap = foldMapWithKey

-- | @since 0.3.6.0
instance TraversableWithIndex k (NEMap k) where
  itraverse f (NEMap k v m) = NEMap k <$> f k v <*> M.traverseWithKey f m

-- | @since 0.3.6.0
instance Ord k => Exts.IsList (NEMap k a) where
  type Item (NEMap k a) = (k, a)

  fromList (a : as) = fromList (a :| as)
  fromList [] = errorWithoutStackTrace "Data.Map.NonEmpty.fromList: empty list"

  toList = F.toList . toList

-- 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 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 = 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 = mkConstr mapDataType "fromList" [] Prefix

mapDataType :: DataType
mapDataType = mkDataType "Data.Map.NonEmpty.NonEmpty.Internal.NEMap" [fromListConstr]

instance (A.ToJSONKey k, A.ToJSON a) => A.ToJSON (NEMap k a) where
  toJSON = A.toJSON . toMap
  toEncoding = A.toEncoding . toMap

instance (A.FromJSONKey k, Ord k, A.FromJSON a) => A.FromJSON (NEMap k a) where
  parseJSON =
    withNonEmpty (fail err) pure
      <=< A.parseJSON
    where
      err = "NEMap: Non-empty map expected, but empty map found"

-- | @since 0.3.4.4
instance Ord k => Alt (NEMap k) where
  (<!>) = 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 f z (NEMap _ v m) = v `f` M.foldr f z 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' f z (NEMap _ v m) = v `f` y
  where
    !y = M.foldr' f z 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 f (NEMap _ v m) =
  maybe v (f v . uncurry (M.foldr f))
    . M.maxView
    $ 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 f z (NEMap _ v m) = M.foldl f (f z v) 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' f z (NEMap _ v m) = M.foldl' f x m
  where
    !x = f z 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 f (NEMap _ v m) = M.foldl f v 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 f (NEMap k0 v m) = maybe (f k0 v) (f k0 v <>)
                                . M.foldMapWithKey (\k -> Just . f k)
                                $ 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 f (NEMap k0 v m) = NEMap k0 (f v) (M.map f 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 n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of
  LT -> NEMap k1 v1 . M.union m1 . toMap $ n2
  EQ -> NEMap k1 v1 . M.union m1 $ m2
  GT -> NEMap k2 v2 . M.union (toMap n1) $ 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 (F1.toNonEmpty -> (m :| ms)) = F.foldl' union m 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 (NEMap _ v m) = v :| M.elems 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 (NEMap _ _ m) = 1 + M.size 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 (NEMap k v m) = insertMinMap k v 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 f (NEMap k v m0) = NEMap k <$> f k v <*> M.traverseWithKey f 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 f (NEMap k0 v m0) = case runMaybeApply m1 of
  Left m2 -> NEMap k0 <$> f k0 v <.> m2
  Right m2 -> flip (NEMap k0) m2 <$> f k0 v
  where
    m1 = M.traverseWithKey (\k -> MaybeApply . Left . f k) 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 (NEMap k v m) = (k, v) :| M.toList 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 = (fmap . uncurry . uncurry) NEMap . 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 def f = maybe def f . 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 ((k, v) :| xs) =
  withNonEmpty (singleton k v) (insertWith (const id) k v)
    . M.fromList
    $ 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 k v = NEMap k v 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 f k v n@(NEMap k0 v0 m) = case compare k k0 of
  LT -> NEMap k v . toMap $ n
  EQ -> NEMap k (f v v0) m
  GT -> NEMap k0 v0 $ M.insertWith f k v m
{-# INLINE insertWith #-}

-- | Left-biased union
instance Ord k => Semigroup (NEMap k a) where
  (<>) = union
  {-# INLINE (<>) #-}
  sconcat = unions
  {-# INLINE sconcat #-}

instance Functor (NEMap k) where
  fmap = map
  {-# INLINE fmap #-}
  x <$ NEMap k _ m = NEMap k x (x <$ m)
  {-# INLINE (<$) #-}

-- | @since 0.3.4.4
instance Invariant (NEMap k) where
  invmap f _ = fmap 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      (NEMap _ v m) = v <> F.fold m
    {-# INLINE fold #-}
    foldMap f (NEMap _ v m) = f v <> 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 #-}
#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 f (NEMap k v m) = NEMap k <$> f v <*> traverse f m
  {-# INLINE traverse #-}
  sequenceA (NEMap k v m) = NEMap k <$> v <*> sequenceA m
  {-# INLINE sequenceA #-}

-- | Traverses elements in order of ascending keys
#if MIN_VERSION_base(4,11,0)
instance Foldable1 (NEMap k) where
    fold1 (NEMap _ v m) = maybe v (v <>)
                        . F.foldMap Just
                        $ m
    {-# INLINE fold1 #-}
    foldMap1 f = foldMapWithKey (const f)
    {-# INLINE foldMap1 #-}
    toNonEmpty = 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 f = traverseWithKey1 (const f)
  {-# INLINE traverse1 #-}
  sequence1 (NEMap k v m0) = case runMaybeApply m1 of
    Left m2 -> NEMap k <$> v <.> m2
    Right m2 -> flip (NEMap k) m2 <$> v
    where
      m1 = traverse (MaybeApply . Left) 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 = nemV0
  {-# INLINE extract #-}
  duplicate n0@(NEMap k0 _ m0) =
    NEMap k0 n0
      . snd
      . M.mapAccumWithKey go m0
      $ m0
    where
      go m k v = (m', NEMap k v m')
        where
          !m' = M.deleteMin m
  {-# INLINE duplicate #-}

-- | /O(n)/. Test if the internal map structure is valid.
valid :: Ord k => NEMap k a -> Bool
valid (NEMap k _ m) =
  M.valid m
    && all ((k <) . fst . fst) (M.minViewWithKey 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 kx x = \case
  Tip -> M.singleton kx x
  Bin _ ky y l r -> M.balanceL ky y (insertMinMap kx x l) 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 kx x = \case
  Tip -> M.singleton kx x
  Bin _ ky y l r -> M.balanceR ky y l (insertMaxMap kx x r)
{-# INLINEABLE insertMaxMap #-}
