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

{- |
    Module      :  SDP.MapM
    Copyright   :  (c) Andrey Mulik 2020
    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
)
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 b c a. (b -> c) -> (a -> b) -> 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 b c a. (b -> c) -> (a -> b) -> 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 b c a. (b -> c) -> (a -> b) -> 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)

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

-- | Rank @(* -> *)@ 'MapM'.
type MapM1 m map key e = MapM m (map e) key e

-- | Rank @(* -> * -> *)@ 'MapM'.
type MapM2 m map key e = MapM m (map key e) key e

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

empEx :: String -> a
empEx :: String -> a
empEx =  IndexException -> a
forall a e. Exception e => e -> a
throw (IndexException -> a) -> (String -> IndexException) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IndexException
EmptyRange (String -> IndexException)
-> (String -> String) -> String -> IndexException
forall b c a. (b -> c) -> (a -> b) -> 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 b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IndexException
UndefinedValue (String -> IndexException)
-> (String -> String) -> String -> IndexException
forall b c a. (b -> c) -> (a -> b) -> 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 b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IndexException
IndexOverflow (String -> IndexException)
-> (String -> String) -> String -> IndexException
forall b c a. (b -> c) -> (a -> b) -> 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 b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IndexException
IndexUnderflow (String -> IndexException)
-> (String -> String) -> String -> IndexException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"in SDP.MapM."