{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE DeriveFoldable         #-}
{-# LANGUAGE DeriveFunctor          #-}
{-# LANGUAGE DeriveGeneric          #-}
{-# LANGUAGE DeriveTraversable      #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeInType             #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}

-- |
-- Module      : Data.Mutable.Class
-- Copyright   : (c) Justin Le 2020
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Provides the 'Mutable' typeclass and various helpers.  See
-- 'Data.Mutable' for the main "entrypoint".
module Data.Mutable.Class (
    Mutable(..)
  , copyRefWhole, moveRefWhole, cloneRefWhole
  , modifyRef, modifyRef'
  , updateRef, updateRef'
  , modifyRefM, modifyRefM'
  , updateRefM, updateRefM'
  , RefFor(..)
  , DefaultMutable(..)
  -- * Providing and overwriting instances
  , VarMut(..)
  , CoerceMut(..)
  , TraverseMut(..)
  , Immutable(..)
  -- * Changing underlying monad
  , reMutable, reMutableConstraint
  -- * Util
  , MapRef
  ) where

import           Control.Monad
import           Control.Monad.Primitive
import           Data.Coerce
import           Data.Constraint
import           Data.Constraint.Unsafe
import           Data.Kind
import           Data.Mutable.Instances
import           Data.Mutable.Internal
import           Data.Primitive.MutVar
import           Data.Proxy
import           Data.Reflection
import           GHC.Generics
import qualified Data.Vinyl.XRec         as X

-- | Apply a pure function on an immutable value onto a value stored in
-- a mutable reference.
modifyRef  :: Mutable m a => Ref m a -> (a -> a) -> m ()
modifyRef :: Ref m a -> (a -> a) -> m ()
modifyRef v :: Ref m a
v f :: a -> a
f = Ref m a -> a -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> a -> m ()
copyRef Ref m a
v (a -> m ()) -> (a -> a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
freezeRef Ref m a
v
{-# INLINE modifyRef #-}

-- | 'modifyRef', but forces the result before storing it back in the
-- reference.
modifyRef' :: Mutable m a => Ref m a -> (a -> a) -> m ()
modifyRef' :: Ref m a -> (a -> a) -> m ()
modifyRef' v :: Ref m a
v f :: a -> a
f = (Ref m a -> a -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> a -> m ()
copyRef Ref m a
v (a -> m ()) -> a -> m ()
forall a b. (a -> b) -> a -> b
$!) (a -> m ()) -> (a -> a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
freezeRef Ref m a
v
{-# INLINE modifyRef' #-}

-- | Apply a monadic function on an immutable value onto a value stored in
-- a mutable reference.  Uses 'copyRef' into the reference after the
-- action is completed.
modifyRefM  :: Mutable m a => Ref m a -> (a -> m a) -> m ()
modifyRefM :: Ref m a -> (a -> m a) -> m ()
modifyRefM v :: Ref m a
v f :: a -> m a
f = Ref m a -> a -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> a -> m ()
copyRef Ref m a
v (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m a
f (a -> m a) -> m a -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
freezeRef Ref m a
v
{-# INLINE modifyRefM #-}

-- | 'modifyRefM', but forces the result before storing it back in the
-- reference.
modifyRefM' :: Mutable m a => Ref m a -> (a -> m a) -> m ()
modifyRefM' :: Ref m a -> (a -> m a) -> m ()
modifyRefM' v :: Ref m a
v f :: a -> m a
f = (Ref m a -> a -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> a -> m ()
copyRef Ref m a
v (a -> m ()) -> a -> m ()
forall a b. (a -> b) -> a -> b
$!) (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m a
f (a -> m a) -> m a -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
freezeRef Ref m a
v
{-# INLINE modifyRefM' #-}

-- | Apply a pure function on an immutable value onto a value stored in
-- a mutable reference, returning a result value from that function.
updateRef  :: Mutable m a => Ref m a -> (a -> (a, b)) -> m b
updateRef :: Ref m a -> (a -> (a, b)) -> m b
updateRef v :: Ref m a
v f :: a -> (a, b)
f = do
    (x :: a
x, y :: b
y) <- a -> (a, b)
f (a -> (a, b)) -> m a -> m (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
freezeRef Ref m a
v
    Ref m a -> a -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> a -> m ()
copyRef Ref m a
v a
x
    b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
y

-- | 'updateRef', but forces the updated value before storing it back in the
-- reference.
updateRef' :: Mutable m a => Ref m a -> (a -> (a, b)) -> m b
updateRef' :: Ref m a -> (a -> (a, b)) -> m b
updateRef' v :: Ref m a
v f :: a -> (a, b)
f = do
    (x :: a
x, y :: b
y) <- a -> (a, b)
f (a -> (a, b)) -> m a -> m (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
freezeRef Ref m a
v
    a
x a -> m () -> m ()
forall a b. a -> b -> b
`seq` Ref m a -> a -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> a -> m ()
copyRef Ref m a
v a
x
    b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
y

-- | Apply a monadic function on an immutable value onto a value stored in
-- a mutable reference, returning a result value from that function.  Uses
-- 'copyRef' into the reference after the action is completed.
updateRefM  :: Mutable m a => Ref m a -> (a -> m (a, b)) -> m b
updateRefM :: Ref m a -> (a -> m (a, b)) -> m b
updateRefM v :: Ref m a
v f :: a -> m (a, b)
f = do
    (x :: a
x, y :: b
y) <- a -> m (a, b)
f (a -> m (a, b)) -> m a -> m (a, b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
freezeRef Ref m a
v
    Ref m a -> a -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> a -> m ()
copyRef Ref m a
v a
x
    b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
y

-- | 'updateRefM', but forces the updated value before storing it back in the
-- reference.
updateRefM' :: Mutable m a => Ref m a -> (a -> m (a, b)) -> m b
updateRefM' :: Ref m a -> (a -> m (a, b)) -> m b
updateRefM' v :: Ref m a
v f :: a -> m (a, b)
f = do
    (x :: a
x, y :: b
y) <- a -> m (a, b)
f (a -> m (a, b)) -> m a -> m (a, b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
freezeRef Ref m a
v
    a
x a -> m () -> m ()
forall a b. a -> b -> b
`seq` Ref m a -> a -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> a -> m ()
copyRef Ref m a
v a
x
    b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
y

-- | A default implementation of 'copyRef' using 'thawRef' and 'moveRef'.
copyRefWhole
    :: Mutable m a
    => Ref m a          -- ^ destination to overwrite
    -> a                -- ^ pure value
    -> m ()
copyRefWhole :: Ref m a -> a -> m ()
copyRefWhole r :: Ref m a
r v :: a
v = Ref m a -> Ref m a -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> Ref m a -> m ()
moveRef Ref m a
r (Ref m a -> m ()) -> m (Ref m a) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m (Ref m a)
forall (m :: * -> *) a. Mutable m a => a -> m (Ref m a)
thawRef a
v
{-# INLINE copyRefWhole #-}

-- | A default implementation of 'moveRef' that round-trips through the
-- pure type, using 'freezeRef' and 'copyRef'.  It freezes the entire source
-- and then re-copies it into the destination.
moveRefWhole
    :: Mutable m a
    => Ref m a          -- ^ destination
    -> Ref m a          -- ^ source
    -> m ()
moveRefWhole :: Ref m a -> Ref m a -> m ()
moveRefWhole r :: Ref m a
r v :: Ref m a
v = Ref m a -> a -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> a -> m ()
copyRef Ref m a
r (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
freezeRef Ref m a
v
{-# INLINE moveRefWhole #-}

-- | A default implementation of 'moveRef' that round-trips through the
-- pure type, using 'freezeRef' and 'thawRef'.  It freezes the entire
-- source and then re-copies it into the destination.
cloneRefWhole
    :: Mutable m a
    => Ref m a
    -> m (Ref m a)
cloneRefWhole :: Ref m a -> m (Ref m a)
cloneRefWhole = a -> m (Ref m a)
forall (m :: * -> *) a. Mutable m a => a -> m (Ref m a)
thawRef (a -> m (Ref m a)) -> (Ref m a -> m a) -> Ref m a -> m (Ref m a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
freezeRef
{-# INLINE cloneRefWhole #-}

-- | Newtype wrapper that can provide any type with a 'Mutable' instance,
-- giving it a "non-piecewise" instance.  Can be useful for avoiding orphan
-- instances yet still utilizing auto-deriving features, or for overwriting
-- the 'Mutable' instance of other instances.
--
-- For example, let's say you want to auto-derive an instance for your data
-- type:
--
-- @
-- data MyType = MT Int Double OtherType
--   deriving Generic
-- @
--
-- This is possible if all of @MyType@s fields have 'Mutable' instances.
-- However, let's say @OtherType@ comes from an external library that you
-- don't have control over, and so you cannot give it a 'Mutable' instance
-- without incurring an orphan instance.
--
-- One solution is to wrap it in 'VarMut':
--
-- @
-- data MyType = MT Int Double ('VarMut' OtherType)
--   deriving Generic
-- @
--
-- This can then be auto-derived:
--
-- @
-- instance Mutable m MyType where
--     type Ref m MyType = GRef m MyType
-- @
--
-- It can also be used to /override/ a 'Mutable' instance.  For example,
-- even if the 'Mutable' instance of @SomeType@ is piecewise-mutable, the
-- 'Mutable' instance of @'VarMut' SomeType@ will be not be piecewise.
--
-- For example, the 'Mutable' instance for 'String' is a mutable linked
-- list, but it might be more efficient to treat it as an atomic value to
-- update all at once.  You can use @'VarMut' 'String'@ to get that
-- 'Mutable' instance.
newtype VarMut a = VarMut { VarMut a -> a
getVarMut :: a }

-- | Use a @'VarMut' a@ as if it were an @a@.
instance X.IsoHKD VarMut a where
    type HKD VarMut a = a
    unHKD :: HKD VarMut a -> VarMut a
unHKD = HKD VarMut a -> VarMut a
forall a. a -> VarMut a
VarMut
    toHKD :: VarMut a -> HKD VarMut a
toHKD = VarMut a -> HKD VarMut a
forall a. VarMut a -> a
getVarMut

instance PrimMonad m => Mutable m (VarMut a) where
    type Ref m (VarMut a) = MutVar (PrimState m) (VarMut a)


-- | Similar to 'VarMut', this allows you to overwrite the normal 'Mutable'
-- instance for a type to utilize its 'Traversable' instance instead of its
-- normal instance.  It's also useful to provide an instance for an
-- externally defined type without incurring orphan instances.
--
-- For example, the instance of @'Mutable' ('TraverseMut' [] a)@ is
-- a normal list of mutable references, instead of a full-on mutable linked
-- list.
newtype TraverseMut f a = TraverseMut { TraverseMut f a -> f a
getTraverseMut :: f a }
  deriving (Int -> TraverseMut f a -> ShowS
[TraverseMut f a] -> ShowS
TraverseMut f a -> String
(Int -> TraverseMut f a -> ShowS)
-> (TraverseMut f a -> String)
-> ([TraverseMut f a] -> ShowS)
-> Show (TraverseMut f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (f :: k -> *) (a :: k).
Show (f a) =>
Int -> TraverseMut f a -> ShowS
forall k (f :: k -> *) (a :: k).
Show (f a) =>
[TraverseMut f a] -> ShowS
forall k (f :: k -> *) (a :: k).
Show (f a) =>
TraverseMut f a -> String
showList :: [TraverseMut f a] -> ShowS
$cshowList :: forall k (f :: k -> *) (a :: k).
Show (f a) =>
[TraverseMut f a] -> ShowS
show :: TraverseMut f a -> String
$cshow :: forall k (f :: k -> *) (a :: k).
Show (f a) =>
TraverseMut f a -> String
showsPrec :: Int -> TraverseMut f a -> ShowS
$cshowsPrec :: forall k (f :: k -> *) (a :: k).
Show (f a) =>
Int -> TraverseMut f a -> ShowS
Show, TraverseMut f a -> TraverseMut f a -> Bool
(TraverseMut f a -> TraverseMut f a -> Bool)
-> (TraverseMut f a -> TraverseMut f a -> Bool)
-> Eq (TraverseMut f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (f :: k -> *) (a :: k).
Eq (f a) =>
TraverseMut f a -> TraverseMut f a -> Bool
/= :: TraverseMut f a -> TraverseMut f a -> Bool
$c/= :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
TraverseMut f a -> TraverseMut f a -> Bool
== :: TraverseMut f a -> TraverseMut f a -> Bool
$c== :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
TraverseMut f a -> TraverseMut f a -> Bool
Eq, Eq (TraverseMut f a)
Eq (TraverseMut f a) =>
(TraverseMut f a -> TraverseMut f a -> Ordering)
-> (TraverseMut f a -> TraverseMut f a -> Bool)
-> (TraverseMut f a -> TraverseMut f a -> Bool)
-> (TraverseMut f a -> TraverseMut f a -> Bool)
-> (TraverseMut f a -> TraverseMut f a -> Bool)
-> (TraverseMut f a -> TraverseMut f a -> TraverseMut f a)
-> (TraverseMut f a -> TraverseMut f a -> TraverseMut f a)
-> Ord (TraverseMut f a)
TraverseMut f a -> TraverseMut f a -> Bool
TraverseMut f a -> TraverseMut f a -> Ordering
TraverseMut f a -> TraverseMut f a -> TraverseMut f a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (f :: k -> *) (a :: k). Ord (f a) => Eq (TraverseMut f a)
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
TraverseMut f a -> TraverseMut f a -> Bool
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
TraverseMut f a -> TraverseMut f a -> Ordering
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
TraverseMut f a -> TraverseMut f a -> TraverseMut f a
min :: TraverseMut f a -> TraverseMut f a -> TraverseMut f a
$cmin :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
TraverseMut f a -> TraverseMut f a -> TraverseMut f a
max :: TraverseMut f a -> TraverseMut f a -> TraverseMut f a
$cmax :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
TraverseMut f a -> TraverseMut f a -> TraverseMut f a
>= :: TraverseMut f a -> TraverseMut f a -> Bool
$c>= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
TraverseMut f a -> TraverseMut f a -> Bool
> :: TraverseMut f a -> TraverseMut f a -> Bool
$c> :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
TraverseMut f a -> TraverseMut f a -> Bool
<= :: TraverseMut f a -> TraverseMut f a -> Bool
$c<= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
TraverseMut f a -> TraverseMut f a -> Bool
< :: TraverseMut f a -> TraverseMut f a -> Bool
$c< :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
TraverseMut f a -> TraverseMut f a -> Bool
compare :: TraverseMut f a -> TraverseMut f a -> Ordering
$ccompare :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
TraverseMut f a -> TraverseMut f a -> Ordering
$cp1Ord :: forall k (f :: k -> *) (a :: k). Ord (f a) => Eq (TraverseMut f a)
Ord, (forall x. TraverseMut f a -> Rep (TraverseMut f a) x)
-> (forall x. Rep (TraverseMut f a) x -> TraverseMut f a)
-> Generic (TraverseMut f a)
forall x. Rep (TraverseMut f a) x -> TraverseMut f a
forall x. TraverseMut f a -> Rep (TraverseMut f a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (f :: k -> *) (a :: k) x.
Rep (TraverseMut f a) x -> TraverseMut f a
forall k (f :: k -> *) (a :: k) x.
TraverseMut f a -> Rep (TraverseMut f a) x
$cto :: forall k (f :: k -> *) (a :: k) x.
Rep (TraverseMut f a) x -> TraverseMut f a
$cfrom :: forall k (f :: k -> *) (a :: k) x.
TraverseMut f a -> Rep (TraverseMut f a) x
Generic, a -> TraverseMut f b -> TraverseMut f a
(a -> b) -> TraverseMut f a -> TraverseMut f b
(forall a b. (a -> b) -> TraverseMut f a -> TraverseMut f b)
-> (forall a b. a -> TraverseMut f b -> TraverseMut f a)
-> Functor (TraverseMut f)
forall a b. a -> TraverseMut f b -> TraverseMut f a
forall a b. (a -> b) -> TraverseMut f a -> TraverseMut f b
forall (f :: * -> *) a b.
Functor f =>
a -> TraverseMut f b -> TraverseMut f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> TraverseMut f a -> TraverseMut f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TraverseMut f b -> TraverseMut f a
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> TraverseMut f b -> TraverseMut f a
fmap :: (a -> b) -> TraverseMut f a -> TraverseMut f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> TraverseMut f a -> TraverseMut f b
Functor, TraverseMut f a -> Bool
(a -> m) -> TraverseMut f a -> m
(a -> b -> b) -> b -> TraverseMut f a -> b
(forall m. Monoid m => TraverseMut f m -> m)
-> (forall m a. Monoid m => (a -> m) -> TraverseMut f a -> m)
-> (forall m a. Monoid m => (a -> m) -> TraverseMut f a -> m)
-> (forall a b. (a -> b -> b) -> b -> TraverseMut f a -> b)
-> (forall a b. (a -> b -> b) -> b -> TraverseMut f a -> b)
-> (forall b a. (b -> a -> b) -> b -> TraverseMut f a -> b)
-> (forall b a. (b -> a -> b) -> b -> TraverseMut f a -> b)
-> (forall a. (a -> a -> a) -> TraverseMut f a -> a)
-> (forall a. (a -> a -> a) -> TraverseMut f a -> a)
-> (forall a. TraverseMut f a -> [a])
-> (forall a. TraverseMut f a -> Bool)
-> (forall a. TraverseMut f a -> Int)
-> (forall a. Eq a => a -> TraverseMut f a -> Bool)
-> (forall a. Ord a => TraverseMut f a -> a)
-> (forall a. Ord a => TraverseMut f a -> a)
-> (forall a. Num a => TraverseMut f a -> a)
-> (forall a. Num a => TraverseMut f a -> a)
-> Foldable (TraverseMut f)
forall a. Eq a => a -> TraverseMut f a -> Bool
forall a. Num a => TraverseMut f a -> a
forall a. Ord a => TraverseMut f a -> a
forall m. Monoid m => TraverseMut f m -> m
forall a. TraverseMut f a -> Bool
forall a. TraverseMut f a -> Int
forall a. TraverseMut f a -> [a]
forall a. (a -> a -> a) -> TraverseMut f a -> a
forall m a. Monoid m => (a -> m) -> TraverseMut f a -> m
forall b a. (b -> a -> b) -> b -> TraverseMut f a -> b
forall a b. (a -> b -> b) -> b -> TraverseMut f a -> b
forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> TraverseMut f a -> Bool
forall (f :: * -> *) a. (Foldable f, Num a) => TraverseMut f a -> a
forall (f :: * -> *) a. (Foldable f, Ord a) => TraverseMut f a -> a
forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
TraverseMut f m -> m
forall (f :: * -> *) a. Foldable f => TraverseMut f a -> Bool
forall (f :: * -> *) a. Foldable f => TraverseMut f a -> Int
forall (f :: * -> *) a. Foldable f => TraverseMut f a -> [a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> TraverseMut f a -> a
forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> TraverseMut f a -> m
forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> TraverseMut f a -> b
forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> TraverseMut f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: TraverseMut f a -> a
$cproduct :: forall (f :: * -> *) a. (Foldable f, Num a) => TraverseMut f a -> a
sum :: TraverseMut f a -> a
$csum :: forall (f :: * -> *) a. (Foldable f, Num a) => TraverseMut f a -> a
minimum :: TraverseMut f a -> a
$cminimum :: forall (f :: * -> *) a. (Foldable f, Ord a) => TraverseMut f a -> a
maximum :: TraverseMut f a -> a
$cmaximum :: forall (f :: * -> *) a. (Foldable f, Ord a) => TraverseMut f a -> a
elem :: a -> TraverseMut f a -> Bool
$celem :: forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> TraverseMut f a -> Bool
length :: TraverseMut f a -> Int
$clength :: forall (f :: * -> *) a. Foldable f => TraverseMut f a -> Int
null :: TraverseMut f a -> Bool
$cnull :: forall (f :: * -> *) a. Foldable f => TraverseMut f a -> Bool
toList :: TraverseMut f a -> [a]
$ctoList :: forall (f :: * -> *) a. Foldable f => TraverseMut f a -> [a]
foldl1 :: (a -> a -> a) -> TraverseMut f a -> a
$cfoldl1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> TraverseMut f a -> a
foldr1 :: (a -> a -> a) -> TraverseMut f a -> a
$cfoldr1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> TraverseMut f a -> a
foldl' :: (b -> a -> b) -> b -> TraverseMut f a -> b
$cfoldl' :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> TraverseMut f a -> b
foldl :: (b -> a -> b) -> b -> TraverseMut f a -> b
$cfoldl :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> TraverseMut f a -> b
foldr' :: (a -> b -> b) -> b -> TraverseMut f a -> b
$cfoldr' :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> TraverseMut f a -> b
foldr :: (a -> b -> b) -> b -> TraverseMut f a -> b
$cfoldr :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> TraverseMut f a -> b
foldMap' :: (a -> m) -> TraverseMut f a -> m
$cfoldMap' :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> TraverseMut f a -> m
foldMap :: (a -> m) -> TraverseMut f a -> m
$cfoldMap :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> TraverseMut f a -> m
fold :: TraverseMut f m -> m
$cfold :: forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
TraverseMut f m -> m
Foldable, Functor (TraverseMut f)
Foldable (TraverseMut f)
(Functor (TraverseMut f), Foldable (TraverseMut f)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> TraverseMut f a -> f (TraverseMut f b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    TraverseMut f (f a) -> f (TraverseMut f a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> TraverseMut f a -> m (TraverseMut f b))
-> (forall (m :: * -> *) a.
    Monad m =>
    TraverseMut f (m a) -> m (TraverseMut f a))
-> Traversable (TraverseMut f)
(a -> f b) -> TraverseMut f a -> f (TraverseMut f b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *). Traversable f => Functor (TraverseMut f)
forall (f :: * -> *). Traversable f => Foldable (TraverseMut f)
forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
TraverseMut f (m a) -> m (TraverseMut f a)
forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
TraverseMut f (f a) -> f (TraverseMut f a)
forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> TraverseMut f a -> m (TraverseMut f b)
forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> TraverseMut f a -> f (TraverseMut f b)
forall (m :: * -> *) a.
Monad m =>
TraverseMut f (m a) -> m (TraverseMut f a)
forall (f :: * -> *) a.
Applicative f =>
TraverseMut f (f a) -> f (TraverseMut f a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TraverseMut f a -> m (TraverseMut f b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TraverseMut f a -> f (TraverseMut f b)
sequence :: TraverseMut f (m a) -> m (TraverseMut f a)
$csequence :: forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
TraverseMut f (m a) -> m (TraverseMut f a)
mapM :: (a -> m b) -> TraverseMut f a -> m (TraverseMut f b)
$cmapM :: forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> TraverseMut f a -> m (TraverseMut f b)
sequenceA :: TraverseMut f (f a) -> f (TraverseMut f a)
$csequenceA :: forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
TraverseMut f (f a) -> f (TraverseMut f a)
traverse :: (a -> f b) -> TraverseMut f a -> f (TraverseMut f b)
$ctraverse :: forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> TraverseMut f a -> f (TraverseMut f b)
$cp2Traversable :: forall (f :: * -> *). Traversable f => Foldable (TraverseMut f)
$cp1Traversable :: forall (f :: * -> *). Traversable f => Functor (TraverseMut f)
Traversable)

-- | Use a @'TraverseMut' f a@ as if it were an @f a@
instance X.IsoHKD (TraverseMut f) a where
    type HKD (TraverseMut f) a = f a
    unHKD :: HKD (TraverseMut f) a -> TraverseMut f a
unHKD = HKD (TraverseMut f) a -> TraverseMut f a
forall k (f :: k -> *) (a :: k). f a -> TraverseMut f a
TraverseMut
    toHKD :: TraverseMut f a -> HKD (TraverseMut f) a
toHKD = TraverseMut f a -> HKD (TraverseMut f) a
forall k (f :: k -> *) (a :: k). TraverseMut f a -> f a
getTraverseMut

instance (Traversable f, Mutable m a) => Mutable m (TraverseMut f a) where
    type Ref m (TraverseMut f a) = TraverseRef m (TraverseMut f) a

-- | Similar to 'VarMut', this allows you to overwrite the normal 'Mutable'
-- instance of a type to utilize a coercible type's 'Mutable' instance
-- instead of its normal instance.  It's also useful to provide an instance for
-- an externally defined type without incurring orphan instances.
--
-- For example, if an external library provides
--
-- @
-- newtype DoubleVec = DV (Vector Double)
-- @
--
-- and you want to use it following 'V.Vector's 'Mutable' instance (via
-- 'MV.MVector'), but you don't want to write an orphan instance like
--
-- @
-- instance Mutable m DoubleVec where
--     type 'Ref' m DoubleVec = 'CoerceRef' m DoubleVec (Vector Double)
-- @
--
-- then you can instead use @'CoerceMut' DoubleVec (Vector Double)@ as the
-- data type.  This wrapped type /does/ use the inderlying 'Mutable'
-- insatnce for 'V.Vector'.
newtype CoerceMut s a = CoerceMut { CoerceMut s a -> s
getCoerceMut :: s }

-- | Use a @'CoerceMut' s a@ as if it were an @s@
instance X.IsoHKD (CoerceMut s) a where
    type HKD (CoerceMut s) a = s
    unHKD :: HKD (CoerceMut s) a -> CoerceMut s a
unHKD = HKD (CoerceMut s) a -> CoerceMut s a
forall k s (a :: k). s -> CoerceMut s a
CoerceMut
    toHKD :: CoerceMut s a -> HKD (CoerceMut s) a
toHKD = CoerceMut s a -> HKD (CoerceMut s) a
forall s k (a :: k). CoerceMut s a -> s
getCoerceMut

instance (Mutable m a, Coercible s a) => Mutable m (CoerceMut s a) where
    type Ref m (CoerceMut s a) = CoerceRef m (CoerceMut s a) a

-- | Similar to 'VarMut', this allows you to overwrite the normal 'Mutable'
-- instance of a type to make it /immutable/.
--
-- For example, let's say you have a type, with the automatically derived
-- generic instance of 'Mutable':
--
-- @
-- data MyType = MT
--     { mtX :: Int
--     , mtY :: Vector Double
--     , mtZ :: String
--     }
--   deriving Generic
--
-- instance Mutable m MyType where
--     type Ref m MyType = GRef m MyType
-- @
--
-- This basically uses three mutable references: the 'Int', the @'V.Vector'
-- Double@, and the 'String'.  However, you might want the 'Mutable'
-- instance of @MyType@ to be /immutable/ 'String' field, and so it cannot
-- be updated at all even when thawed.  To do that, you can instead have:
--
-- @
-- data MyType = MT
--     { mtX :: Int
--     , mtY :: Vector Double
--     , mtZ :: 'Immutable' String
--     }
--   deriving Generic
--
-- instance Mutable m MyType where
--     type Ref m MyType = GRef m MyType
-- @
--
-- which has that behavior.  The 'Int' and the 'V.Vector' will be mutable
-- within @'Ref' m MyType@, but not the 'String'.
newtype Immutable a = Immutable { Immutable a -> a
getImmutable :: a }

-- | Use an @'Immutable' a@ as if it were an @a@
instance X.IsoHKD Immutable a where
    type HKD Immutable a = a
    unHKD :: HKD Immutable a -> Immutable a
unHKD = HKD Immutable a -> Immutable a
forall a. a -> Immutable a
Immutable
    toHKD :: Immutable a -> HKD Immutable a
toHKD = Immutable a -> HKD Immutable a
forall a. Immutable a -> a
getImmutable


instance Monad m => Mutable m (Immutable a) where
    type Ref m (Immutable a) = ImmutableRef (Immutable a)


newtype ReMutable (s :: Type) m a = ReMutable a
newtype ReMutableTrans m n = RMT { ReMutableTrans m n -> forall (x :: k). m x -> n x
runRMT :: forall x. m x -> n x }

instance (Monad n, Mutable m a, Reifies s (ReMutableTrans m n)) => Mutable n (ReMutable s m a) where
    type Ref n (ReMutable s m a) = ReMutable s m (Ref m a)
    thawRef :: ReMutable s m a -> n (Ref n (ReMutable s m a))
thawRef (ReMutable x :: a
x) = ReMutableTrans m n -> forall x. m x -> n x
forall k (m :: k -> *) (n :: k -> *).
ReMutableTrans m n -> forall (x :: k). m x -> n x
runRMT ReMutableTrans m n
rmt (m (ReMutable s m (Ref m a)) -> n (Ref n (ReMutable s m a)))
-> m (ReMutable s m (Ref m a)) -> n (Ref n (ReMutable s m a))
forall a b. (a -> b) -> a -> b
$ Ref m a -> ReMutable s m (Ref m a)
forall k s (m :: k) a. a -> ReMutable s m a
ReMutable (Ref m a -> ReMutable s m (Ref m a))
-> m (Ref m a) -> m (ReMutable s m (Ref m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (Ref m a)
forall (m :: * -> *) a. Mutable m a => a -> m (Ref m a)
thawRef @m @a a
x
      where
        rmt :: ReMutableTrans m n
rmt = Proxy s -> ReMutableTrans m n
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy s
forall k (t :: k). Proxy t
Proxy @s)
    freezeRef :: Ref n (ReMutable s m a) -> n (ReMutable s m a)
freezeRef (ReMutable v) = ReMutableTrans m n -> forall x. m x -> n x
forall k (m :: k -> *) (n :: k -> *).
ReMutableTrans m n -> forall (x :: k). m x -> n x
runRMT ReMutableTrans m n
rmt (m (ReMutable s m a) -> n (ReMutable s m a))
-> m (ReMutable s m a) -> n (ReMutable s m a)
forall a b. (a -> b) -> a -> b
$ a -> ReMutable s m a
forall k s (m :: k) a. a -> ReMutable s m a
ReMutable (a -> ReMutable s m a) -> m a -> m (ReMutable s m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
freezeRef @m @a Ref m a
v
      where
        rmt :: ReMutableTrans m n
rmt = Proxy s -> ReMutableTrans m n
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy s
forall k (t :: k). Proxy t
Proxy @s)
    copyRef :: Ref n (ReMutable s m a) -> ReMutable s m a -> n ()
copyRef (ReMutable x) (ReMutable v :: a
v) = ReMutableTrans m n -> forall x. m x -> n x
forall k (m :: k -> *) (n :: k -> *).
ReMutableTrans m n -> forall (x :: k). m x -> n x
runRMT ReMutableTrans m n
rmt (m () -> n ()) -> m () -> n ()
forall a b. (a -> b) -> a -> b
$ Ref m a -> a -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> a -> m ()
copyRef @m @a Ref m a
x a
v
      where
        rmt :: ReMutableTrans m n
rmt = Proxy s -> ReMutableTrans m n
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy s
forall k (t :: k). Proxy t
Proxy @s)
    moveRef :: Ref n (ReMutable s m a) -> Ref n (ReMutable s m a) -> n ()
moveRef (ReMutable x) (ReMutable v) = ReMutableTrans m n -> forall x. m x -> n x
forall k (m :: k -> *) (n :: k -> *).
ReMutableTrans m n -> forall (x :: k). m x -> n x
runRMT ReMutableTrans m n
rmt (m () -> n ()) -> m () -> n ()
forall a b. (a -> b) -> a -> b
$ Ref m a -> Ref m a -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> Ref m a -> m ()
moveRef @m @a Ref m a
x Ref m a
v
      where
        rmt :: ReMutableTrans m n
rmt = Proxy s -> ReMutableTrans m n
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy s
forall k (t :: k). Proxy t
Proxy @s)
    cloneRef :: Ref n (ReMutable s m a) -> n (Ref n (ReMutable s m a))
cloneRef (ReMutable x) = ReMutableTrans m n -> forall x. m x -> n x
forall k (m :: k -> *) (n :: k -> *).
ReMutableTrans m n -> forall (x :: k). m x -> n x
runRMT ReMutableTrans m n
rmt (m (ReMutable s m (Ref m a)) -> n (Ref n (ReMutable s m a)))
-> m (ReMutable s m (Ref m a)) -> n (Ref n (ReMutable s m a))
forall a b. (a -> b) -> a -> b
$ Ref m a -> ReMutable s m (Ref m a)
forall k s (m :: k) a. a -> ReMutable s m a
ReMutable (Ref m a -> ReMutable s m (Ref m a))
-> m (Ref m a) -> m (ReMutable s m (Ref m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref m a -> m (Ref m a)
forall (m :: * -> *) a. Mutable m a => Ref m a -> m (Ref m a)
cloneRef @m @a Ref m a
x
      where
        rmt :: ReMutableTrans m n
rmt = Proxy s -> ReMutableTrans m n
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy s
forall k (t :: k). Proxy t
Proxy @s)
    unsafeThawRef :: ReMutable s m a -> n (Ref n (ReMutable s m a))
unsafeThawRef (ReMutable x :: a
x) = ReMutableTrans m n -> forall x. m x -> n x
forall k (m :: k -> *) (n :: k -> *).
ReMutableTrans m n -> forall (x :: k). m x -> n x
runRMT ReMutableTrans m n
rmt (m (ReMutable s m (Ref m a)) -> n (Ref n (ReMutable s m a)))
-> m (ReMutable s m (Ref m a)) -> n (Ref n (ReMutable s m a))
forall a b. (a -> b) -> a -> b
$ Ref m a -> ReMutable s m (Ref m a)
forall k s (m :: k) a. a -> ReMutable s m a
ReMutable (Ref m a -> ReMutable s m (Ref m a))
-> m (Ref m a) -> m (ReMutable s m (Ref m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (Ref m a)
forall (m :: * -> *) a. Mutable m a => a -> m (Ref m a)
unsafeThawRef @m @a a
x
      where
        rmt :: ReMutableTrans m n
rmt = Proxy s -> ReMutableTrans m n
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy s
forall k (t :: k). Proxy t
Proxy @s)
    unsafeFreezeRef :: Ref n (ReMutable s m a) -> n (ReMutable s m a)
unsafeFreezeRef (ReMutable v) = ReMutableTrans m n -> forall x. m x -> n x
forall k (m :: k -> *) (n :: k -> *).
ReMutableTrans m n -> forall (x :: k). m x -> n x
runRMT ReMutableTrans m n
rmt (m (ReMutable s m a) -> n (ReMutable s m a))
-> m (ReMutable s m a) -> n (ReMutable s m a)
forall a b. (a -> b) -> a -> b
$ a -> ReMutable s m a
forall k s (m :: k) a. a -> ReMutable s m a
ReMutable (a -> ReMutable s m a) -> m a -> m (ReMutable s m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
unsafeFreezeRef @m @a Ref m a
v
      where
        rmt :: ReMutableTrans m n
rmt = Proxy s -> ReMutableTrans m n
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy s
forall k (t :: k). Proxy t
Proxy @s)

unsafeReMutable :: forall s m n a. Mutable n (ReMutable s m a) :- Mutable n a
unsafeReMutable :: Mutable n (ReMutable s m a) :- Mutable n a
unsafeReMutable = Mutable n (ReMutable s m a) :- Mutable n a
forall (a :: Constraint) (b :: Constraint). a :- b
unsafeCoerceConstraint

-- | If you can provice a natural transformation from @m@ to @n@, you
-- should be able to use a value as if it had @'Mutable' n a@ if you have
-- @'Mutable' m a@.
reMutable
    :: forall m n a r. (Mutable m a, Monad n)
    => (forall x. m x -> n x)
    -> (Mutable n a => r)
    -> r
reMutable :: (forall x. m x -> n x) -> (Mutable n a => r) -> r
reMutable f :: forall x. m x -> n x
f x :: Mutable n a => r
x = Mutable n a => r
x (Mutable n a => r) -> (Mutable m a :- Mutable n a) -> r
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall x. m x -> n x) -> Mutable m a :- Mutable n a
forall (m :: * -> *) (n :: * -> *) a.
(Mutable m a, Monad n) =>
(forall x. m x -> n x) -> Mutable m a :- Mutable n a
reMutableConstraint @m @n @a forall x. m x -> n x
f

-- | If you can provice a natural transformation from @m@ to @n@, then
-- @'Mutable' m a@ should also imply @'Mutable' n a@.
reMutableConstraint
    :: forall m n a. (Mutable m a, Monad n)
    => (forall x. m x -> n x)
    -> Mutable m a :- Mutable n a
reMutableConstraint :: (forall x. m x -> n x) -> Mutable m a :- Mutable n a
reMutableConstraint f :: forall x. m x -> n x
f = ReMutableTrans m n
-> (forall s.
    Reifies s (ReMutableTrans m n) =>
    Proxy s -> Mutable m a :- Mutable n a)
-> Mutable m a :- Mutable n a
forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify ((forall x. m x -> n x) -> ReMutableTrans m n
forall k (m :: k -> *) (n :: k -> *).
(forall (x :: k). m x -> n x) -> ReMutableTrans m n
RMT forall x. m x -> n x
f) ((forall s.
  Reifies s (ReMutableTrans m n) =>
  Proxy s -> Mutable m a :- Mutable n a)
 -> Mutable m a :- Mutable n a)
-> (forall s.
    Reifies s (ReMutableTrans m n) =>
    Proxy s -> Mutable m a :- Mutable n a)
-> Mutable m a :- Mutable n a
forall a b. (a -> b) -> a -> b
$ \(Proxy s
Proxy :: Proxy s) ->
    case Mutable n (ReMutable s m a) :- Mutable n a
forall k s (m :: k) (n :: * -> *) a.
Mutable n (ReMutable s m a) :- Mutable n a
unsafeReMutable @s @m @n @a of
      Sub Data.Constraint.Dict -> (Mutable m a => Dict (Mutable n a)) -> Mutable m a :- Mutable n a
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Mutable m a => Dict (Mutable n a)
forall (a :: Constraint). a => Dict a
Data.Constraint.Dict