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

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

{- |
    Module      :  SDP.IndexedM
    Copyright   :  (c) Andrey Mulik 2019-2021
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC extensions)
    
    "SDP.IndexedM" provides 'IndexedM' and 'Thaw' classes.
-}
module SDP.IndexedM
(
  -- * Exports
  module SDP.LinearM,
  module SDP.Indexed,
  module SDP.MapM,
  
  -- * IndexedM
  IndexedM (..), IndexedM1, IndexedM2,
  
  -- * Thaw
  Thaw (..), Thaw1, Thaw2,
  
#if __GLASGOW_HASKELL__ >= 806
  -- ** Rank 2 quantified constraints
  -- | GHC 8.6.1+ only
  IndexedM', IndexedM'', Thaw', Thaw''
#endif
)
where

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

import Control.Exception.SDP

default ()

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

{-# WARNING updateM' "will be moved to SDP.MapM.MapM class in sdp-0.3" #-}
{-# WARNING writeM'  "will be moved to SDP.MapM.MapM class in sdp-0.3" #-}

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

-- | Class for work with mutable indexed structures.
class (LinearM m v e, BorderedM m v i, MapM m v i e) => IndexedM m v i e
  where
    {-# MINIMAL fromIndexed', fromIndexedM #-}
    
    {- |
      @fromAssocs bnds ascs@ creates new structure from list of associations,
      without default element. Note that @bnds@ is @ascs@ bounds and may not
      match with the result bounds (not always possible).
    -}
    fromAssocs :: (i, i) -> [(i, e)] -> m v
    fromAssocs =
      let err :: a
err = IndexException -> a
forall a e. Exception e => e -> a
throw (IndexException -> a) -> IndexException -> a
forall a b. (a -> b) -> a -> b
$ String -> IndexException
UndefinedValue String
"in SDP.IndexedM.fromAssocs {default}"
      in  ((i, i) -> e -> [(i, e)] -> m v) -> e -> (i, i) -> [(i, e)] -> m v
forall a b c. (a -> b -> c) -> b -> a -> c
flip (i, i) -> e -> [(i, e)] -> m v
forall (m :: * -> *) v i e.
IndexedM m v i e =>
(i, i) -> e -> [(i, e)] -> m v
fromAssocs' e
forall a. a
err
    
    {- |
      @fromAssocs' bnds defvalue ascs@ creates new structure from list of
      associations, with default element. Note that @bnds@ is @ascs@ bounds and
      may not match with the result bounds (not always possible).
    -}
    fromAssocs' :: (i, i) -> e -> [(i, e)] -> m v
    fromAssocs' (i, i)
bnds e
defvalue = e -> [(i, e)] -> m v
forall (m :: * -> *) map key e.
MapM m map key e =>
e -> [(key, e)] -> m map
newMap' e
defvalue ([(i, e)] -> m v) -> ([(i, e)] -> [(i, e)]) -> [(i, e)] -> m v
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((i, e) -> Bool) -> [(i, e)] -> [(i, e)]
forall l e. Linear l e => (e -> Bool) -> l -> l
filter ((i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
inRange (i, i)
bnds (i -> Bool) -> ((i, e) -> i) -> (i, e) -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (i, e) -> i
forall a b. (a, b) -> a
fst)
    
    {- |
      @'writeM' map key e@ writes element @e@ to @key@ position safely (if @key@
      is out of @map@ range, do nothing). The 'writeM' function is intended to
      overwrite only existing values, so its behavior is identical for
      structures with both static and dynamic boundaries.
    -}
    writeM' :: v -> i -> e -> m ()
    writeM' v
es i
i e
e = do (i, i)
bnds <- v -> m (i, i)
forall (m :: * -> *) b i. BorderedM m b i => b -> m (i, i)
getBounds v
es; v -> Int -> e -> m ()
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> e -> m ()
writeM v
es ((i, i) -> i -> Int
forall i. Index i => (i, i) -> i -> Int
offset (i, i)
bnds i
i) e
e
    
    -- | Just swap two elements.
    swapM' :: v -> i -> i -> m ()
    swapM' v
es i
i i
j = do e
ei <- v
es v -> i -> m e
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> key -> m e
>! i
i; v -> i -> e -> m ()
forall (m :: * -> *) v i e. IndexedM m v i e => v -> i -> e -> m ()
writeM' v
es i
i (e -> m ()) -> m e -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< v
es v -> i -> m e
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> key -> m e
>! i
j; v -> i -> e -> m ()
forall (m :: * -> *) v i e. IndexedM m v i e => v -> i -> e -> m ()
writeM' v
es i
j e
ei
    
    -- | fromIndexed' is overloaded version of thaw.
    fromIndexed' :: (Indexed v' j e) => v' -> m v
    
    -- | fromIndexed converts one mutable structure to other.
    fromIndexedM :: (IndexedM m v' j e) => v' -> m v
    
    -- | reshaped creates new indexed structure from old with reshaping function.
    reshaped :: (IndexedM m v' j e) => (i, i) -> v' -> (i -> j) -> m v
    reshaped (i, i)
bnds v'
es i -> j
f = (i, i) -> [(i, e)] -> m v
forall (m :: * -> *) v i e.
IndexedM m v i e =>
(i, i) -> [(i, e)] -> m v
fromAssocs (i, i)
bnds ([(i, e)] -> m v) -> m [(i, e)] -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (i, i) -> [i]
forall i. Index i => (i, i) -> [i]
range (i, i)
bnds [i] -> (i -> m (i, e)) -> m [(i, e)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
`forM` \ i
i -> (,) i
i (e -> (i, e)) -> m e -> m (i, e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v'
es v' -> j -> m e
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> key -> m e
!> i -> j
f i
i
    
    {- |
      @'fromAccum' f es ies@ create a new structure from @es@ elements
      selectively updated by function @f@ and @ies@ associations list.
    -}
    fromAccum :: (e -> e' -> e) -> v -> [(i, e')] -> m v
    fromAccum e -> e' -> e
f v
es [(i, e')]
ascs = v -> m (i, i)
forall (m :: * -> *) b i. BorderedM m b i => b -> m (i, i)
getBounds v
es m (i, i) -> m [(i, e)] -> ((i, i) -> [(i, e)] -> m v) -> m v
forall (m :: * -> *) a b c.
Monad m =>
m a -> m b -> (a -> b -> m c) -> m c
>>=<< m [(i, e)]
ies (((i, i) -> [(i, e)] -> m v) -> m v)
-> ((i, i) -> [(i, e)] -> m v) -> m v
forall a b. (a -> b) -> a -> b
$ (i, i) -> [(i, e)] -> m v
forall (m :: * -> *) v i e.
IndexedM m v i e =>
(i, i) -> [(i, e)] -> m v
fromAssocs
      where
        ies :: m [(i, e)]
ies = [m (i, e)] -> m [(i, e)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ do e
e <- v
es v -> i -> m e
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> key -> m e
!> i
i; (i, e) -> m (i, e)
forall (m :: * -> *) a. Monad m => a -> m a
return (i
i, e -> e' -> e
f e
e e'
e') | (i
i, e'
e') <- [(i, e')]
ascs ]
    
    -- | Update element by given function.
    updateM' :: v -> (e -> e) -> i -> m ()
    updateM' v
es e -> e
f i
i = v -> i -> e -> m ()
forall (m :: * -> *) v i e. IndexedM m v i e => v -> i -> e -> m ()
writeM' v
es i
i (e -> m ()) -> (e -> e) -> e -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> e
f (e -> m ()) -> m e -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< v
es v -> i -> m e
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> key -> m e
>! i
i

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

-- | Service class of immutable to mutable conversions.
class (Monad m) => Thaw m v v' | v' -> m
  where
    {- |
      @thaw@ is safe way to convert a immutable structure to a mutable. @thaw@
      should copy the old structure or ensure that it will not be used after the
      procedure calling.
    -}
    thaw :: v -> m v'
    
    {- |
      @unsafeThaw@ is unsafe version of 'thaw'. @unsafeThaw@ doesn't guarantee
      that the structure will be copied or locked. It only guarantees that if
      the old structure isn't used, no error will occur.
    -}
    unsafeThaw :: v -> m v'
    unsafeThaw =  v -> m v'
forall (m :: * -> *) v v'. Thaw m v v' => v -> m v'
thaw

-- | 'IndexedM' contraint for @(Type -> Type)@-kind types.
type IndexedM1 m v i e = IndexedM m (v e) i e

-- | 'IndexedM' contraint for @(Type -> Type -> Type)@-kind types.
type IndexedM2 m v i e = IndexedM m (v i e) i e

-- | 'Thaw' contraint for @(Type -> Type)@-kind types.
type Thaw1 m v v' e = Thaw m (v e) (v' e)

-- | 'Thaw' contraint for @(Type -> Type -> Type)@-kind types.
type Thaw2 m v v' i e = Thaw m (v i e) (v' i e)

#if __GLASGOW_HASKELL__ >= 806
-- | 'IndexedM' contraint for @(Type -> Type)@-kind types.
type IndexedM' m v i = forall e . IndexedM m (v e) i e

-- | 'IndexedM' contraint for @(Type -> Type -> Type)@-kind types.
type IndexedM'' m v = forall i e . IndexedM m (v i e) i e

-- | 'Thaw' contraint for @(Type -> Type)@-kind types.
type Thaw' m v v' = forall e . Thaw m (v e) (v' e)

-- | 'Thaw' contraint for @(Type -> Type -> Type)@-kind types.
type Thaw'' m v v' = forall i e . Thaw m (v i e) (v' i e)
#endif