{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# LANGUAGE Safe, CPP, BangPatterns, ConstraintKinds, DefaultSignatures #-}

#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE QuantifiedConstraints, RankNTypes #-}
#endif

{- |
    Module      :  SDP.Map
    Copyright   :  (c) Andrey Mulik 2019-2021
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC extensions)
    
    "SDP.Map" provides 'Map' - class of immutable associative arrays.
-}
module SDP.Map
(
  -- * Exports
  module SDP.Set,
  
  -- * Map
  Map (..), Map1, Map2,
  
#if __GLASGOW_HASKELL__ >= 806
  -- ** Rank 2 quantified constraints
  -- | GHC 8.6.1+ only
  Map', Map''
#endif
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.Linear
import SDP.Set

import Data.List ( findIndex, findIndices )

import Control.Exception.SDP

default ()

infixl 9 .!, !, !?

--------------------------------------------------------------------------------

{- |
  @since 0.2
  
  'Map' is a class of dictionaries (associative arrays).
  
  'Map' provides a set of operations on associative arrays that aren't specific
  to 'Linear' data structures and aren't limited by the 'Bordered' context
  (doesn't restrict key type).
-}
class (Nullable map) => Map map key e | map -> key, map -> e
  where
    {-# MINIMAL toMap', ((.!) | (!?)) #-}
    
    -- | Returns list of associations @(index, element)@.
    default assocs :: (Bordered map key, Linear map e) => map -> [(key, e)]
    assocs :: map -> [(key, e)]
    assocs map
es = map -> [key]
forall b i. Bordered b i => b -> [i]
indices map
es [key] -> [e] -> [(key, e)]
forall (z :: * -> *) a b. Zip z => z a -> z b -> z (a, b)
`zip` map -> [e]
forall l e. Linear l e => l -> [e]
listL map
es
    
    {- |
      A less specific version of "SDP.Indexed.Indexed.assoc" that creates a new
      associative array. For 'Linear' structures without gaps, it may be less
      effective.
      
      > Z // ascs = toMap -- forall ascs
    -}
    toMap :: [(key, e)] -> map
    toMap =  e -> [(key, e)] -> map
forall map key e. Map map key e => e -> [(key, e)] -> map
toMap' (String -> e
forall a. String -> a
undEx String
"toMap {default}")
    
    {- |
      Strict version of 'toMap' with default value.
      
      Note that the default value is set only for elements included in the range
      of the created structure and will not be set for values outside its range
      (when expanding, concatenating, etc.) for most structures since they don't
      store it.
    -}
    toMap' :: e -> [(key, e)] -> map
    
    {- |
      @'insert'' key e map@ inserts @e@ with @key@ to @map@. If @map@ already
      contains an element with @key@, the element will be overwritten.
      
      If @map@ doesn't allow gaps, then the missing elements should be filled
      with default values.
    -}
    insert' :: key -> e -> map -> map
    insert' key
k e
e map
es = [(key, e)] -> map
forall map key e. Map map key e => [(key, e)] -> map
toMap ([(key, e)] -> map) -> [(key, e)] -> map
forall a b. (a -> b) -> a -> b
$ map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs map
es [(key, e)] -> (key, e) -> [(key, e)]
forall l e. Linear l e => l -> e -> l
:< (key
k, e
e)
    
    {- |
      'delete'' removes element with given key.
      
      If the structure has boundaries, when removed from the beginning (end),
      they should change accordingly. If the structure doesn't allow gaps, then
      when removed from the middle, the actual value should be replaced with the
      default value.
    -}
    delete' :: key -> map -> map
    default delete' :: (Eq key) => key -> map -> map
    delete' key
k = [(key, e)] -> map
forall map key e. Map map key e => [(key, e)] -> map
toMap ([(key, e)] -> map) -> (map -> [(key, e)]) -> map -> map
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((key, e) -> Bool) -> [(key, e)] -> [(key, e)]
forall l e. Linear l e => (e -> Bool) -> l -> l
except ((key -> key -> Bool
forall a. Eq a => a -> a -> Bool
== key
k) (key -> Bool) -> ((key, e) -> key) -> (key, e) -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (key, e) -> key
forall a b. (a, b) -> a
fst) ([(key, e)] -> [(key, e)])
-> (map -> [(key, e)]) -> map -> [(key, e)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs
    
    -- | @'member'' key map@ checks if @key@ in @map@.
    default member' :: (Bordered map key) => key -> map -> Bool
    member' :: key -> map -> Bool
    member' =  (map -> key -> Bool) -> key -> map -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip map -> key -> Bool
forall b i. Bordered b i => b -> i -> Bool
indexIn
    
    -- | Update elements of immutable structure (by copying).
    (//) :: map -> [(key, e)] -> map
    (//) =  [(key, e)] -> map
forall map key e. Map map key e => [(key, e)] -> map
toMap ([(key, e)] -> map)
-> (map -> [(key, e)] -> [(key, e)]) -> map -> [(key, e)] -> map
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... [(key, e)] -> [(key, e)] -> [(key, e)]
forall l e. Linear l e => l -> l -> l
(++) ([(key, e)] -> [(key, e)] -> [(key, e)])
-> (map -> [(key, e)]) -> map -> [(key, e)] -> [(key, e)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs
    
    -- | @('.!')@ is unsafe reader, can be faster @('!')@ by skipping checks.
    {-# INLINE (.!) #-}
    (.!) :: map -> key -> e
    (.!) =  (String -> e
forall a. String -> a
undEx String
"(.!)" e -> Maybe e -> e
forall a. a -> Maybe a -> a
+?) (Maybe e -> e) -> (map -> key -> Maybe e) -> map -> key -> e
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... map -> key -> Maybe e
forall map key e. Map map key e => map -> key -> Maybe e
(!?)
    
    -- | @('!')@ is well-safe reader, may 'throw' 'IndexException'.
    (!) :: map -> key -> e
    default (!) :: (Bordered map key) => map -> key -> e
    (!) map
es key
i = case (key, key) -> key -> InBounds
forall i. Index i => (i, i) -> i -> InBounds
inBounds (map -> (key, key)
forall b i. Bordered b i => b -> (i, i)
bounds map
es) key
i of
        InBounds
IN -> map
es map -> key -> e
forall map key e. Map map key e => map -> key -> e
.! key
i
        InBounds
ER -> String -> e
forall a. String -> a
empEx   String
msg
        InBounds
OR -> String -> e
forall a. String -> a
overEx  String
msg
        InBounds
UR -> String -> e
forall a. String -> a
underEx String
msg
      where
        msg :: String
msg = String
"(!) {default}"
    
    -- | @('!?')@ is completely safe, but very boring function.
    (!?) :: map -> key -> Maybe e
    (!?) map
es = (key -> map -> Bool) -> map -> key -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip key -> map -> Bool
forall map key e. Map map key e => key -> map -> Bool
member' map
es (key -> Bool) -> (key -> e) -> key -> Maybe e
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
?+ (map
es map -> key -> e
forall map key e. Map map key e => map -> key -> e
.!)
    
    -- | Filter with key.
    filter' :: (key -> e -> Bool) -> map -> map
    filter' key -> e -> Bool
f = [(key, e)] -> map
forall map key e. Map map key e => [(key, e)] -> map
toMap ([(key, e)] -> map) -> (map -> [(key, e)]) -> map -> map
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((key, e) -> Bool) -> [(key, e)] -> [(key, e)]
forall l e. Linear l e => (e -> Bool) -> l -> l
filter ((key -> e -> Bool) -> (key, e) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry key -> e -> Bool
f) ([(key, e)] -> [(key, e)])
-> (map -> [(key, e)]) -> map -> [(key, e)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs
    
    {- |
      'union'' is 'groupSetWith' for maps but works with real groups of
      elements, not with consequentive equal elements.
      
      'union'' merges/chooses elements with equal keys from two maps.
    -}
    union' :: (Ord key) => (e -> e -> e) -> map -> map -> map
    union' e -> e -> e
f = [(key, e)] -> map
forall map key e. Map map key e => [(key, e)] -> map
toMap ([(key, e)] -> map)
-> (map -> map -> [(key, e)]) -> map -> map -> map
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... ([(key, e)] -> [(key, e)] -> [(key, e)])
-> (map -> [(key, e)]) -> map -> map -> [(key, e)]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on [(key, e)] -> [(key, e)] -> [(key, e)]
forall a. Ord a => [(a, e)] -> [(a, e)] -> [(a, e)]
go map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs
      where
        go :: [(a, e)] -> [(a, e)] -> [(a, e)]
go xs' :: [(a, e)]
xs'@(x' :: (a, e)
x'@(a
i, e
x) : [(a, e)]
xs) ys' :: [(a, e)]
ys'@(y' :: (a, e)
y'@(a
j, e
y) : [(a, e)]
ys) = case a
i Compare a
forall o. Ord o => Compare o
<=> a
j of
          Ordering
LT -> (a, e)
x' (a, e) -> [(a, e)] -> [(a, e)]
forall a. a -> [a] -> [a]
: [(a, e)] -> [(a, e)] -> [(a, e)]
go [(a, e)]
xs [(a, e)]
ys'
          Ordering
EQ -> (a
i, e -> e -> e
f e
x e
y) (a, e) -> [(a, e)] -> [(a, e)]
forall a. a -> [a] -> [a]
: [(a, e)] -> [(a, e)] -> [(a, e)]
go [(a, e)]
xs [(a, e)]
ys
          Ordering
GT -> (a, e)
y' (a, e) -> [(a, e)] -> [(a, e)]
forall a. a -> [a] -> [a]
: [(a, e)] -> [(a, e)] -> [(a, e)]
go [(a, e)]
xs' [(a, e)]
ys
        go [(a, e)]
xs'   [(a, e)]
Z = [(a, e)]
xs'
        go [(a, e)]
Z   [(a, e)]
ys' = [(a, e)]
ys'
    
    {- |
      @'difference'' f mx my@ applies @comb@ to values with equal keys.
      If @f x y@ (where @(k1, x) <- mx@, @(k2, y) <- my@, @k1 == k2@) is
      'Nothing', element isn't included to result map.
      
      Note that 'difference'' is poorer than a similar functions in containers.
    -}
    difference' :: (Ord key) => (e -> e -> Maybe e) -> map -> map -> map
    difference' e -> e -> Maybe e
f = [(key, e)] -> map
forall map key e. Map map key e => [(key, e)] -> map
toMap ([(key, e)] -> map)
-> (map -> map -> [(key, e)]) -> map -> map -> map
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... ([(key, e)] -> [(key, e)] -> [(key, e)])
-> (map -> [(key, e)]) -> map -> map -> [(key, e)]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on [(key, e)] -> [(key, e)] -> [(key, e)]
forall a. Ord a => [(a, e)] -> [(a, e)] -> [(a, e)]
go map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs
      where
        go :: [(a, e)] -> [(a, e)] -> [(a, e)]
go xs' :: [(a, e)]
xs'@(x' :: (a, e)
x'@(a
i, e
x) : [(a, e)]
xs) ys' :: [(a, e)]
ys'@((a
j, e
y) : [(a, e)]
ys) = case a
i Compare a
forall o. Ord o => Compare o
<=> a
j of
          Ordering
GT -> [(a, e)] -> [(a, e)] -> [(a, e)]
go [(a, e)]
xs' [(a, e)]
ys
          Ordering
LT -> (a, e)
x' (a, e) -> [(a, e)] -> [(a, e)]
forall a. a -> [a] -> [a]
: [(a, e)] -> [(a, e)] -> [(a, e)]
go [(a, e)]
xs [(a, e)]
ys'
          Ordering
EQ -> case e -> e -> Maybe e
f e
x e
y of {(Just e
e) -> (a
i, e
e) (a, e) -> [(a, e)] -> [(a, e)]
forall a. a -> [a] -> [a]
: [(a, e)] -> [(a, e)] -> [(a, e)]
go [(a, e)]
xs [(a, e)]
ys; Maybe e
_ -> [(a, e)] -> [(a, e)] -> [(a, e)]
go [(a, e)]
xs [(a, e)]
ys}
        go [(a, e)]
xs' [(a, e)]
_ = [(a, e)]
xs'
    
    {- |
      @'intersection'' f mx my@ combines elements of 'intersection'' by @f@:
      if @isJust (f x y)@ (where @(k1, x) <- mx, (k2, y) <- my, k1 == k2@),
      then element is added to result map.
    -}
    intersection' :: (Ord key) => (e -> e -> e) -> map -> map -> map
    intersection' e -> e -> e
f = [(key, e)] -> map
forall map key e. Map map key e => [(key, e)] -> map
toMap ([(key, e)] -> map)
-> (map -> map -> [(key, e)]) -> map -> map -> map
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... ([(key, e)] -> [(key, e)] -> [(key, e)])
-> (map -> [(key, e)]) -> map -> map -> [(key, e)]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on [(key, e)] -> [(key, e)] -> [(key, e)]
forall a. Ord a => [(a, e)] -> [(a, e)] -> [(a, e)]
go map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs
      where
        go :: [(a, e)] -> [(a, e)] -> [(a, e)]
go xs' :: [(a, e)]
xs'@((a
i, e
x) : [(a, e)]
xs) ys' :: [(a, e)]
ys'@((a
j, e
y) : [(a, e)]
ys) = case a
i Compare a
forall o. Ord o => Compare o
<=> a
j of
          Ordering
LT -> [(a, e)] -> [(a, e)] -> [(a, e)]
go [(a, e)]
xs [(a, e)]
ys'
          Ordering
GT -> [(a, e)] -> [(a, e)] -> [(a, e)]
go [(a, e)]
xs' [(a, e)]
ys
          Ordering
EQ -> (a
i, e -> e -> e
f e
x e
y) (a, e) -> [(a, e)] -> [(a, e)]
forall a. a -> [a] -> [a]
: [(a, e)] -> [(a, e)] -> [(a, e)]
go [(a, e)]
xs [(a, e)]
ys
        go [(a, e)]
_ [(a, e)]
_ = []
    
    -- | Update function, by default uses ('//').
    update :: map -> (key -> e -> e) -> map
    update map
es key -> e -> e
f = map
es map -> [(key, e)] -> map
forall map key e. Map map key e => map -> [(key, e)] -> map
// [ (key
i, key -> e -> e
f key
i e
e) | (key
i, e
e) <- map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs map
es ]
    
    {- |
      @lookupLT' k map@ finds pair @(key, value)@ with smallest @key@, where
      @key < k@ (if any). @k@ may not be a @map@ element.
    -}
    lookupLT' :: (Ord key) => key -> map -> Maybe (key, e)
    lookupLT' key
k = Compare (key, e) -> (key, e) -> [(key, e)] -> Maybe (key, e)
forall s o. SetWith s o => Compare o -> o -> s -> Maybe o
lookupLTWith Compare (key, e)
forall o s. Ord o => Compare (o, s)
cmpfst (key
k, String -> e
forall a. String -> a
unreachEx String
"lookupLT'") ([(key, e)] -> Maybe (key, e))
-> (map -> [(key, e)]) -> map -> Maybe (key, e)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs
    
    {- |
      @lookupGT' k map@ finds pair @(key, value)@ with greatest @key@, where
      @key > k@ (if any). @k@ may not be a @map@ element.
    -}
    lookupGT' :: (Ord key) => key -> map -> Maybe (key, e)
    lookupGT' key
k = Compare (key, e) -> (key, e) -> [(key, e)] -> Maybe (key, e)
forall s o. SetWith s o => Compare o -> o -> s -> Maybe o
lookupGTWith Compare (key, e)
forall o s. Ord o => Compare (o, s)
cmpfst (key
k, String -> e
forall a. String -> a
unreachEx String
"lookupGT'") ([(key, e)] -> Maybe (key, e))
-> (map -> [(key, e)]) -> map -> Maybe (key, e)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs
    
    {- |
      @lookupLE' k map@ finds pair @(key, value)@ with smallest @key@, where
      @key <= k@ (if any). If @k@ is a @map@ element, returns @(k, e)@.
    -}
    lookupLE' :: (Ord key) => key -> map -> Maybe (key, e)
    lookupLE' key
k map
me = (,) key
k (e -> (key, e)) -> Maybe e -> Maybe (key, e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (map
me map -> key -> Maybe e
forall map key e. Map map key e => map -> key -> Maybe e
!? key
k) Maybe (key, e) -> Maybe (key, e) -> Maybe (key, e)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Compare (key, e) -> (key, e) -> [(key, e)] -> Maybe (key, e)
forall s o. SetWith s o => Compare o -> o -> s -> Maybe o
lookupLEWith Compare (key, e)
forall o s. Ord o => Compare (o, s)
cmpfst (key
k, String -> e
forall a. String -> a
unreachEx String
"lookupLE'") (map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs map
me)
    
    {- |
      @lookupGE' k map@ finds pair @(key, value)@ with  @key@, where
      @key >= k@ (if any).
    -}
    lookupGE' :: (Ord key) => key -> map -> Maybe (key, e)
    lookupGE' key
k map
me = (,) key
k (e -> (key, e)) -> Maybe e -> Maybe (key, e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (map
me map -> key -> Maybe e
forall map key e. Map map key e => map -> key -> Maybe e
!? key
k) Maybe (key, e) -> Maybe (key, e) -> Maybe (key, e)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Compare (key, e) -> (key, e) -> [(key, e)] -> Maybe (key, e)
forall s o. SetWith s o => Compare o -> o -> s -> Maybe o
lookupGEWith Compare (key, e)
forall o s. Ord o => Compare (o, s)
cmpfst (key
k, String -> e
forall a. String -> a
unreachEx String
"lookupGE'") (map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs map
me)
    
    -- | Returns list of map keys.
    keys :: map -> [key]
    keys =  [(key, e)] -> [key]
forall (f :: * -> *) a b. Functor f => f (a, b) -> f a
fsts ([(key, e)] -> [key]) -> (map -> [(key, e)]) -> map -> [key]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs
    
    -- | Searches the key of first matching element.
    (.$) :: (e -> Bool) -> map -> Maybe key
    (.$) =  [key] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([key] -> Bool) -> ([key] -> key) -> [key] -> Maybe key
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
?- [key] -> key
forall l e. Linear l e => l -> e
head ([key] -> Maybe key)
-> ((e -> Bool) -> map -> [key]) -> (e -> Bool) -> map -> Maybe key
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (e -> Bool) -> map -> [key]
forall map key e. Map map key e => (e -> Bool) -> map -> [key]
(*$)
    
    -- | Searches the keys of all matching elements.
    (*$) :: (e -> Bool) -> map -> [key]
    (*$) e -> Bool
f = ((key, e) -> Maybe key) -> [(key, e)] -> [key]
forall l e a. Linear l e => (e -> Maybe a) -> l -> [a]
select (e -> Bool
f (e -> Bool) -> ((key, e) -> e) -> (key, e) -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (key, e) -> e
forall a b. (a, b) -> b
snd ((key, e) -> Bool) -> ((key, e) -> key) -> (key, e) -> Maybe key
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
?+ (key, e) -> key
forall a b. (a, b) -> a
fst) ([(key, e)] -> [key]) -> (map -> [(key, e)]) -> map -> [key]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs
    
    {- Folds with key. -}
    
    -- | 'kfoldr' is 'foldr' with key.
    kfoldr :: (key -> e -> b -> b) -> b -> map -> b
    kfoldr key -> e -> b -> b
f b
base = ((key, e) -> b -> b) -> b -> [(key, e)] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((key -> e -> b -> b) -> (key, e) -> b -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry key -> e -> b -> b
f) b
base ([(key, e)] -> b) -> (map -> [(key, e)]) -> map -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs
    
    -- | 'kfoldl' is 'foldl' with key.
    kfoldl :: (key -> b -> e -> b) -> b -> map -> b
    kfoldl key -> b -> e -> b
f b
base = (b -> (key, e) -> b) -> b -> [(key, e)] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ b
acc (key
i, e
e) -> key -> b -> e -> b
f key
i b
acc e
e) b
base ([(key, e)] -> b) -> (map -> [(key, e)]) -> map -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. map -> [(key, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs
    
    -- | 'kfoldr'' is strict version of 'kfoldr'.
    kfoldr' :: (key -> e -> b -> b) -> b -> map -> b
    kfoldr' key -> e -> b -> b
f = (key -> e -> b -> b) -> b -> map -> b
forall map key e b.
Map map key e =>
(key -> e -> b -> b) -> b -> map -> b
kfoldr (\ !key
i e
e !b
b -> key -> e -> b -> b
f key
i e
e b
b)
    
    -- | 'kfoldl'' is strict version of 'kfoldl'.
    kfoldl' :: (key -> b -> e -> b) -> b -> map -> b
    kfoldl' key -> b -> e -> b
f = (key -> b -> e -> b) -> b -> map -> b
forall map key e b.
Map map key e =>
(key -> b -> e -> b) -> b -> map -> b
kfoldl (\ !key
i !b
b e
e -> key -> b -> e -> b
f key
i b
b e
e)

--------------------------------------------------------------------------------

-- | 'Map' contraint for @(Type -> Type)@-kind types.
type Map1 map key e = Map (map e) key e

-- | 'Map' contraint for @(Type -> Type -> Type)@-kind types.
type Map2 map key e = Map (map key e) key e

#if __GLASGOW_HASKELL__ >= 806
-- | 'Map' contraint for @(Type -> Type)@-kind types.
type Map' map key = forall e . Map (map e) key e

-- | 'Map' contraint for @(Type -> Type -> Type)@-kind types.
type Map'' map = forall key e . Map (map key e) key e
#endif

--------------------------------------------------------------------------------

instance Map [e] Int e
  where
    toMap' :: e -> [(Int, e)] -> [e]
toMap' e
e = [(Int, e)] -> [e]
forall (f :: * -> *) a b. Functor f => f (a, b) -> f b
snds ([(Int, e)] -> [e])
-> ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [e]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(Int, e)] -> [(Int, e)]
forall a. (Eq a, Num a) => [(a, e)] -> [(a, e)]
fill ([(Int, e)] -> [(Int, e)])
-> ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [(Int, e)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Compare (Int, e) -> [(Int, e)] -> [(Int, e)]
forall s o. SetWith s o => Compare o -> s -> s
setWith Compare (Int, e)
forall o s. Ord o => Compare (o, s)
cmpfst
      where
        fill :: [(a, e)] -> [(a, e)]
fill (ix :: (a, e)
ix@(a
i1, e
_) : iy :: (a, e)
iy@(a
i2, e
_) : [(a, e)]
ies) =
          let rest :: [(a, e)]
rest = a
i1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
i2 Bool -> [(a, e)] -> [(a, e)] -> [(a, e)]
forall a. Bool -> a -> a -> a
? (a, e)
iy (a, e) -> [(a, e)] -> [(a, e)]
forall a. a -> [a] -> [a]
: [(a, e)]
ies ([(a, e)] -> [(a, e)]) -> [(a, e)] -> [(a, e)]
forall a b. (a -> b) -> a -> b
$ (a
i1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, e
e) (a, e) -> [(a, e)] -> [(a, e)]
forall a. a -> [a] -> [a]
: (a, e)
iy (a, e) -> [(a, e)] -> [(a, e)]
forall a. a -> [a] -> [a]
: [(a, e)]
ies
          in  (a, e)
ix (a, e) -> [(a, e)] -> [(a, e)]
forall a. a -> [a] -> [a]
: [(a, e)] -> [(a, e)]
fill [(a, e)]
rest
        fill [(a, e)]
xs = [(a, e)]
xs
    
    assocs :: [e] -> [(Int, e)]
assocs = [Int] -> [e] -> [(Int, e)]
forall (z :: * -> *) a b. Zip z => z a -> z b -> z (a, b)
zip [Int
0 ..] ([e] -> [(Int, e)]) -> ([e] -> [e]) -> [e] -> [(Int, e)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [e] -> [e]
forall l e. Linear l e => l -> [e]
listL
    
    insert' :: Int -> e -> [e] -> [e]
insert' Int
k e
e [e]
es = Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> [e] -> [e] -> [e]
forall a. Bool -> a -> a -> a
? [e]
es ([e] -> [e]) -> [e] -> [e]
forall a b. (a -> b) -> a -> b
$ Int -> [e] -> [e]
forall a. (Num a, Eq a) => a -> [e] -> [e]
go Int
k [e]
es
      where
        go :: a -> [e] -> [e]
go a
0    [e]
xs    = [e] -> Bool
forall e. Nullable e => e -> Bool
isNull [e]
xs Bool -> [e] -> [e] -> [e]
forall a. Bool -> a -> a -> a
? [e
e] ([e] -> [e]) -> [e] -> [e]
forall a b. (a -> b) -> a -> b
$ e
e e -> [e] -> [e]
forall a. a -> [a] -> [a]
: [e] -> [e]
forall l e. Linear l e => l -> l
tail [e]
xs
        go a
i    []    = e
forall a. a
err e -> [e] -> [e]
forall a. a -> [a] -> [a]
: a -> [e] -> [e]
go (a
i a -> a -> a
forall a. Num a => a -> a -> a
- a
1) []
        go a
i (e
x : [e]
xs) = e
x e -> [e] -> [e]
forall a. a -> [a] -> [a]
: a -> [e] -> [e]
go (a
i a -> a -> a
forall a. Num a => a -> a -> a
- a
1) [e]
xs
        
        err :: a
err = String -> a
forall a. String -> a
undEx String
"insert'"
    
    (e
x : [e]
xs) .! :: [e] -> Int -> e
.! Int
n = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> e -> e -> e
forall a. Bool -> a -> a -> a
? e
x (e -> e) -> e -> e
forall a b. (a -> b) -> a -> b
$ [e]
xs [e] -> Int -> e
forall map key e. Map map key e => map -> key -> e
.! (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    [e]
_        .! Int
_ = String -> e
forall a. HasCallStack => String -> a
error String
"in SDP.Map.(.!)"
    
    (!) [] Int
_ = String -> e
forall a. String -> a
empEx String
"(!)"
    (!) [e]
es Int
n = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> e -> e -> e
forall a. Bool -> a -> a -> a
? [e]
es [e] -> Int -> e
forall t p. (Eq t, Num t) => [p] -> t -> p
!# Int
n (e -> e) -> e -> e
forall a b. (a -> b) -> a -> b
$ String -> e
forall a. String -> a
underEx String
"(!)"
      where
        []       !# :: [p] -> t -> p
!# t
_  = String -> p
forall a. String -> a
overEx String
"(!)"
        (p
x : [p]
xs) !# t
n' = t
n' t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 Bool -> p -> p -> p
forall a. Bool -> a -> a -> a
? p
x (p -> p) -> p -> p
forall a b. (a -> b) -> a -> b
$ [p]
xs [p] -> t -> p
!# (t
n' t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
    
    []       !? :: [e] -> Int -> Maybe e
!? Int
_ = Maybe e
forall a. Maybe a
Nothing
    (e
x : [e]
xs) !? Int
n = case Int
n Compare Int
forall o. Ord o => Compare o
<=> Int
0 of
      Ordering
GT -> [e]
xs [e] -> Int -> Maybe e
forall map key e. Map map key e => map -> key -> Maybe e
!? (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      Ordering
EQ -> e -> Maybe e
forall a. a -> Maybe a
Just e
x
      Ordering
LT -> Maybe e
forall a. Maybe a
Nothing
    
    [e]
xs // :: [e] -> [(Int, e)] -> [e]
// [(Int, e)]
es = [(Int, e)] -> [e]
forall (f :: * -> *) a b. Functor f => f (a, b) -> f b
snds ([(Int, e)] -> [e]) -> [(Int, e)] -> [e]
forall a b. (a -> b) -> a -> b
$ Compare (Int, e) -> [(Int, e)] -> [(Int, e)] -> [(Int, e)]
forall s o. SetWith s o => Compare o -> s -> s -> s
unionWith Compare (Int, e)
forall o s. Ord o => Compare (o, s)
cmpfst (Compare (Int, e) -> [(Int, e)] -> [(Int, e)]
forall s o. SetWith s o => Compare o -> s -> s
setWith Compare (Int, e)
forall o s. Ord o => Compare (o, s)
cmpfst [(Int, e)]
es) ([e] -> [(Int, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs [e]
xs)
    
    .$ :: (e -> Bool) -> [e] -> Maybe Int
(.$) = (e -> Bool) -> [e] -> Maybe Int
forall e. (e -> Bool) -> [e] -> Maybe Int
findIndex
    *$ :: (e -> Bool) -> [e] -> [Int]
(*$) = (e -> Bool) -> [e] -> [Int]
forall e. (e -> Bool) -> [e] -> [Int]
findIndices
    
    kfoldr :: (Int -> e -> b -> b) -> b -> [e] -> b
kfoldr Int -> e -> b -> b
f b
base =
      let go :: Int -> [e] -> b
go Int
i [e]
es = case [e]
es of {(e
x : [e]
xs) -> Int -> e -> b -> b
f Int
i e
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Int -> [e] -> b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [e]
xs; [e]
_ -> b
base}
      in  Int -> [e] -> b
go Int
0
    
    kfoldl :: (Int -> b -> e -> b) -> b -> [e] -> b
kfoldl Int -> b -> e -> b
f =
      let go :: Int -> b -> [e] -> b
go Int
i b
e [e]
es = case [e]
es of {(e
x : [e]
xs) -> Int -> b -> [e] -> b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> b -> e -> b
f Int
i b
e e
x) [e]
xs; [e]
_ -> b
e}
      in  Int -> b -> [e] -> b
go Int
0

--------------------------------------------------------------------------------

empEx :: String -> a
empEx :: String -> a
empEx =  IndexException -> a
forall a e. Exception e => e -> a
throw (IndexException -> a) -> (String -> IndexException) -> String -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IndexException
EmptyRange (String -> IndexException)
-> (String -> String) -> String -> IndexException
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
showString String
"in SDP.Map."

undEx :: String -> a
undEx :: String -> a
undEx =  IndexException -> a
forall a e. Exception e => e -> a
throw (IndexException -> a) -> (String -> IndexException) -> String -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IndexException
UndefinedValue (String -> IndexException)
-> (String -> String) -> String -> IndexException
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
showString String
"in SDP.Map."

overEx :: String -> a
overEx :: String -> a
overEx =  IndexException -> a
forall a e. Exception e => e -> a
throw (IndexException -> a) -> (String -> IndexException) -> String -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IndexException
IndexOverflow (String -> IndexException)
-> (String -> String) -> String -> IndexException
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
showString String
"in SDP.Map."

underEx :: String -> a
underEx :: String -> a
underEx =  IndexException -> a
forall a e. Exception e => e -> a
throw (IndexException -> a) -> (String -> IndexException) -> String -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IndexException
IndexUnderflow (String -> IndexException)
-> (String -> String) -> String -> IndexException
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
showString String
"in SDP.Map."

unreachEx :: String -> a
unreachEx :: String -> a
unreachEx =  UnreachableException -> a
forall a e. Exception e => e -> a
throw (UnreachableException -> a)
-> (String -> UnreachableException) -> String -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> UnreachableException
UnreachableException (String -> UnreachableException)
-> (String -> String) -> String -> UnreachableException
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
showString String
"in SDP.Map."