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

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

{- |
    Module      :  SDP.MapM
    Copyright   :  (c) Andrey Mulik 2020-2021
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  portable
    
    "SDP.MapM" provides 'MapM' - class of mutable associative arrays.
-}
module SDP.MapM
(
  -- * Mutable maps
  MapM (..), MapM1, MapM2,
  
#if __GLASGOW_HASKELL__ >= 806
  -- ** Rank 2 quantified constraints
  -- | GHC 8.6.1+ only
  MapM', MapM''
#endif
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.LinearM

import Data.Maybe ( listToMaybe )

import Control.Exception.SDP

default ()

infixl 5 >!, !>, !?>

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

-- | 'MapM' is class of mutable associative arrays.
class (Monad m) => MapM m map key e | map -> m, map -> key, map -> e
  where
    {-# MINIMAL newMap', overwrite, ((>!)|(!?>)), kfoldrM, kfoldlM #-}
    
    -- | Create new mutable map from list of @(key, element)@ associations.
    newMap :: [(key, e)] -> m map
    newMap =  e -> [(key, e)] -> m map
forall (m :: * -> *) map key e.
MapM m map key e =>
e -> [(key, e)] -> m map
newMap' (String -> e
forall a. String -> a
undEx String
"newMap {default}")
    
    -- | Create new mutable map from list of @(key, element)@ associations.
    newMap' :: e -> [(key, e)] -> m map
    
    -- | 'getAssocs' is version of 'SDP.Map.assocs' for mutable maps.
    default getAssocs :: (LinearM m map e) => map -> m [(key, e)]
    getAssocs :: map -> m [(key, e)]
    getAssocs map
es = ([key] -> [e] -> [(key, e)]) -> m [key] -> m [e] -> m [(key, e)]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [key] -> [e] -> [(key, e)]
forall (z :: * -> *) a b. Zip z => z a -> z b -> z (a, b)
zip (map -> m [key]
forall (m :: * -> *) map key e. MapM m map key e => map -> m [key]
getKeys map
es) (map -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft map
es)
    
    -- | @('>!')@ is unsafe monadic reader.
    {-# INLINE (>!) #-}
    (>!) :: map -> key -> m e
    (>!) =  (Maybe e -> e) -> m (Maybe e) -> m e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> e
forall a. String -> a
undEx String
"(!) {default}" e -> Maybe e -> e
forall a. a -> Maybe a -> a
+?) (m (Maybe e) -> m e)
-> (map -> key -> m (Maybe e)) -> map -> key -> m e
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... map -> key -> m (Maybe e)
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> key -> m (Maybe e)
(!?>)
    
    -- | @('!>')@ is well-safe monadic reader.
    {-# INLINE (!>) #-}
    default (!>) :: (BorderedM m map key) => map -> key -> m e
    (!>) :: map -> key -> m e
    map
es !> key
i = do
      let msg :: String
msg = String
"(!>) {default}"
      (key, key)
bnds <- map -> m (key, key)
forall (m :: * -> *) b i. BorderedM m b i => b -> m (i, i)
getBounds map
es
      case (key, key) -> key -> InBounds
forall i. Index i => (i, i) -> i -> InBounds
inBounds (key, key)
bnds key
i of
        InBounds
IN -> map
es map -> key -> m e
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> key -> m e
>! key
i
        InBounds
ER -> String -> m e
forall a. String -> a
empEx   String
msg
        InBounds
OR -> String -> m e
forall a. String -> a
overEx  String
msg
        InBounds
UR -> String -> m e
forall a. String -> a
underEx String
msg
    
    -- | @('!?>')@ is completely safe monadic reader.
    (!?>) :: map -> key -> m (Maybe e)
    map
es !?> key
i = do Bool
b <- map -> key -> m Bool
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> key -> m Bool
memberM' map
es key
i; Bool
b Bool -> m (Maybe e) -> m (Maybe e) -> m (Maybe e)
forall a. Bool -> a -> a -> a
? e -> Maybe e
forall a. a -> Maybe a
Just (e -> Maybe e) -> m e -> m (Maybe e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (map
es map -> key -> m e
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> key -> m e
>! key
i) (m (Maybe e) -> m (Maybe e)) -> m (Maybe e) -> m (Maybe e)
forall a b. (a -> b) -> a -> b
$ Maybe e -> m (Maybe e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe e
forall (f :: * -> *) a. Alternative f => f a
empty
    
    -- | Update elements by mapping with indices.
    updateM :: map -> (key -> e -> e) -> m map
    updateM map
es key -> e -> e
f = do [(key, e)]
ascs <- map -> m [(key, e)]
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> m [(key, e)]
getAssocs map
es; map
es map -> [(key, e)] -> m map
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> [(key, e)] -> m map
`overwrite` [ (key
i, key -> e -> e
f key
i e
e) | (key
i, e
e) <- [(key, e)]
ascs ]
    
    {- |
      This function designed to overwrite large enough fragments of the
      structure (unlike 'writeM' and 'SDP.IndexedM.writeM'')
      
      In addition to write operations, 'overwrite' can move and clean, optimize
      data presentation, etc. of a particular structure. Since the reference to
      the original structure may not be the same as reference to the result
      (which implementation is undesirable, but acceptable), the original
      reference (argument) shouldn't be used after 'overwrite'.
      
      All standard @sdp@ structures support safe in-place 'overwrite'.
      
      If the structure uses unmanaged memory, then all unused fragments in the
      resulting structure must be deallocated, regardless of reachability by
      original reference (argument).
      
      Please note that @overwrite@ require a list of associations with indices
      in the current structure bounds and ignore any other, therefore:
      
      > fromAssocs bnds ascs /= (fromAssocs bnds ascs >>= flip overwrite ascs)
    -}
    overwrite :: map -> [(key, e)] -> m map
    
    -- | Checks if key in map.
    default memberM' :: (BorderedM m map key) => map -> key -> m Bool
    memberM' :: map -> key -> m Bool
    memberM' =  map -> key -> m Bool
forall (m :: * -> *) b i. BorderedM m b i => b -> i -> m Bool
nowIndexIn
    
    -- | Returns list of map keys.
    default getKeys :: (BorderedM m map key) => map -> m [key]
    getKeys :: map -> m [key]
    getKeys =  map -> m [key]
forall (m :: * -> *) b i. BorderedM m b i => b -> m [i]
getIndices
    
    -- | (.?) is monadic version of (.$).
    (.?) :: (e -> Bool) -> map -> m (Maybe key)
    (.?) =  ([key] -> Maybe key) -> m [key] -> m (Maybe key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [key] -> Maybe key
forall a. [a] -> Maybe a
listToMaybe (m [key] -> m (Maybe key))
-> ((e -> Bool) -> map -> m [key])
-> (e -> Bool)
-> map
-> m (Maybe key)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (e -> Bool) -> map -> m [key]
forall (m :: * -> *) map key e.
MapM m map key e =>
(e -> Bool) -> map -> m [key]
(*?)
    
    -- | (*?) is monadic version of (*$).
    (*?) :: (e -> Bool) -> map -> m [key]
    (*?) e -> Bool
p = (((key, e) -> Maybe key) -> [(key, e)] -> [key]
forall l e a. Linear l e => (e -> Maybe a) -> l -> [a]
select (e -> Bool
p (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]) -> m [(key, e)] -> m [key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m [(key, e)] -> m [key])
-> (map -> m [(key, e)]) -> map -> m [key]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. map -> m [(key, e)]
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> m [(key, e)]
getAssocs
    
    -- | 'kfoldrM' is right monadic fold with key.
    kfoldrM :: (key -> e -> acc -> m acc) -> acc -> map -> m acc
    kfoldrM key -> e -> acc -> m acc
f acc
base = ((key, e) -> m acc -> m acc) -> m acc -> [(key, e)] -> m acc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((acc -> m acc) -> m acc -> m acc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) ((acc -> m acc) -> m acc -> m acc)
-> ((key, e) -> acc -> m acc) -> (key, e) -> m acc -> m acc
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (key -> e -> acc -> m acc) -> (key, e) -> acc -> m acc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry key -> e -> acc -> m acc
f) (acc -> m acc
forall (f :: * -> *) a. Applicative f => a -> f a
pure acc
base) ([(key, e)] -> m acc) -> (map -> m [(key, e)]) -> map -> m acc
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< map -> m [(key, e)]
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> m [(key, e)]
getAssocs
    
    -- | 'kfoldlM' is left monadic fold with key.
    kfoldlM :: (key -> acc -> e -> m acc) -> acc -> map -> m acc
    kfoldlM key -> acc -> e -> m acc
f acc
base = (m acc -> (key, e) -> m acc) -> m acc -> [(key, e)] -> m acc
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((key, e) -> m acc -> m acc) -> m acc -> (key, e) -> m acc
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((key, e) -> m acc -> m acc) -> m acc -> (key, e) -> m acc)
-> ((key, e) -> m acc -> m acc) -> m acc -> (key, e) -> m acc
forall a b. (a -> b) -> a -> b
$ \ (key
i, e
e) -> ((acc -> e -> m acc) -> e -> acc -> m acc
forall a b c. (a -> b -> c) -> b -> a -> c
flip (key -> acc -> e -> m acc
f key
i) e
e (acc -> m acc) -> m acc -> m acc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)) (acc -> m acc
forall (f :: * -> *) a. Applicative f => a -> f a
pure acc
base) ([(key, e)] -> m acc) -> (map -> m [(key, e)]) -> map -> m acc
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< map -> m [(key, e)]
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> m [(key, e)]
getAssocs
    
    -- | 'kfoldrM'' is strict version of 'kfoldrM'.
    kfoldrM' :: (key -> e -> acc -> m acc) -> acc -> map -> m acc
    kfoldrM' key -> e -> acc -> m acc
f = (key -> e -> acc -> m acc) -> acc -> map -> m acc
forall (m :: * -> *) map key e acc.
MapM m map key e =>
(key -> e -> acc -> m acc) -> acc -> map -> m acc
kfoldrM (\ !key
i e
e !acc
r -> key -> e -> acc -> m acc
f key
i e
e acc
r)
    
    -- | 'kfoldlM'' is strict version of 'kfoldlM'.
    kfoldlM' :: (key -> acc -> e -> m acc) -> acc -> map -> m acc
    kfoldlM' key -> acc -> e -> m acc
f = (key -> acc -> e -> m acc) -> acc -> map -> m acc
forall (m :: * -> *) map key e acc.
MapM m map key e =>
(key -> acc -> e -> m acc) -> acc -> map -> m acc
kfoldlM (\ !key
i !acc
r e
e -> key -> acc -> e -> m acc
f key
i acc
r e
e)

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

-- | 'MapM' contraint for @(Type -> Type)@-kind types.
type MapM1 m map key e = MapM m (map e) key e

-- | 'MapM' contraint for @(Type -> Type -> Type)@-kind types.
type MapM2 m map key e = MapM m (map key e) key e

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

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

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

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.MapM."

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.MapM."

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.MapM."

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.MapM."