Copyright | (c) Justin Le 2020 |
---|---|
License | BSD3 |
Maintainer | justin@jle.im |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
Provides the Mutable
typeclass and various helpers. See
Data.Mutable for the main "entrypoint". Many of the datatypes used
for Ref
instances are defined in Data.Mutable.Instances
Synopsis
- class Mutable s a where
- type Ref s a = (v :: Type) | v -> a s
- thawRef :: (PrimMonad m, PrimState m ~ s) => a -> m (Ref s a)
- freezeRef :: (PrimMonad m, PrimState m ~ s) => Ref s a -> m a
- copyRef :: (PrimMonad m, PrimState m ~ s) => Ref s a -> a -> m ()
- moveRef :: (PrimMonad m, PrimState m ~ s) => Ref s a -> Ref s a -> m ()
- cloneRef :: (PrimMonad m, PrimState m ~ s) => Ref s a -> m (Ref s a)
- unsafeThawRef :: (PrimMonad m, PrimState m ~ s) => a -> m (Ref s a)
- unsafeFreezeRef :: (PrimMonad m, PrimState m ~ s) => Ref s a -> m a
- copyRefWhole :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> a -> m ()
- moveRefWhole :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> Ref s a -> m ()
- cloneRefWhole :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> m (Ref s a)
- modifyRef :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> a) -> m ()
- modifyRef' :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> a) -> m ()
- updateRef :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> (a, b)) -> m b
- updateRef' :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> (a, b)) -> m b
- modifyRefM :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> m a) -> m ()
- modifyRefM' :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> m a) -> m ()
- updateRefM :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> m (a, b)) -> m b
- updateRefM' :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> m (a, b)) -> m b
- newtype RefFor s a = RefFor {}
- class DefaultMutable s a r | r -> a s where
- defaultThawRef :: (PrimMonad m, PrimState m ~ s) => a -> m r
- defaultFreezeRef :: (PrimMonad m, PrimState m ~ s) => r -> m a
- defaultCopyRef :: (PrimMonad m, PrimState m ~ s) => r -> a -> m ()
- defaultMoveRef :: (PrimMonad m, PrimState m ~ s) => r -> r -> m ()
- defaultCloneRef :: (PrimMonad m, PrimState m ~ s) => r -> m r
- defaultUnsafeThawRef :: (PrimMonad m, PrimState m ~ s) => a -> m r
- defaultUnsafeFreezeRef :: (PrimMonad m, PrimState m ~ s) => r -> m a
- newtype VarMut a = VarMut {
- getVarMut :: a
- newtype CoerceMut s a = CoerceMut {
- getCoerceMut :: s
- newtype TraverseMut f a = TraverseMut {
- getTraverseMut :: f a
- newtype Immutable s a = Immutable {
- getImmutable :: a
- type family MapRef s as where ...
Documentation
class Mutable s a where Source #
An instance of
means that Mutable
s aa
can be stored
a mutable reference in a PrimMonad
m
(where s
is the mutable state
token PrimState
of that monad).
The associated type
links any Ref
s aa
to the type of its
canonical mutable version.
The benefit of this typeclass, instead of just using
IORef
or MutVar
or specific mutable versions like
Vector
and MVector
, is two-fold:
- Piecewise-mutable values, so you can write to only one part and not
others. This also allows for cheaper "writes", even if you replace
the whole value: you don't need to ever synthesize an entire new
value, you can keep each component in a separate variable until you
freezeRef
it out. This can be especially useful for composite data types containing large structures likeVector
. Generic abstractions (similar to
Show
), so you can automatically derive instances while preserving piecewise-ness. For example, the instanceinstance (Mutable s a, Mutable s b) => Mutable s (a, b)
If
a
andb
are piecwise-mutable, then the instance here will appropriately utilize that fact.
To modify the specific parts of mutable values, it can be useful to use the functions in Data.Mutable.Parts.
There are facilities to automatically piecewise mutable versions for
user-defined instances of Generic
.
For example, if we have a type like:
data TwoVectors = TV { tvInt ::Vector
Int , tvDouble :: Vector Double } deriving Generic instance Mutable s TwoVectors where type Ref s TwoVectors =GRef
s TwoVectors
Then now we get:
thawRef
:: TwoVectors -> m (GRef
s TwoVectors)freezeRef
::GRef
s TwoVectors -> m TwoVectors
And
is now a piecewise-mutable reference storing each
part in a way that can be modified separately (for example, with tools
from Data.Mutable.Parts). It does this by internally allocating two
GRef
s TwoVectorsMVector
s. If the two vectors are large, this can be much more
efficient to modify (if you are modifying several times) than by just
doing alterations on TwoVector
s. It is also much better for large
vectors if you plan on modifying only a single item in the vector.
If you are using the "higher-kinded" data pattern, a la https://reasonablypolymorphic.com/blog/higher-kinded-data/, then we can also do:
data TwoVectors f = TV { tvInt ::HKD
f (Vector
Int) , tvDouble :: HKD f (Vector Double) } deriving Generic instance Mutable (TwoVectorsIdentity
) where type Ref (TwoVectorsIdentity
) = TwoVectors (RefFor
s)
And now your mutable ref is literally going to be a product of the components
ghci> tvr@(TV is ds) <- thawRef (TV xs ys) ghci> :t tvr TV (RefFor
RealWorld
) ghci> :t isMVector
RealWorld Int ghci> :t ds MV.MVector RealWorld Double
So thawRef
will actually just get you the same record type but with
the mutable versions of each field. If you modify the mutable fields,
and then later freezeRef
the whole thing, the resulting frozen value
will incorporate all of the changes to the individual fields.
In addition, there are a few more "automatically derived" instances you
can get by picking Ref
:
-- Make a mutable version for any newtype wrapper, using the Mutable
-- of the underlying type
newtype MyType = MT (Vector Double)
type Ref s MyType = CoerceRef s MyType (Vector Double)
-- Make a mutable version of any container, where the items are all
-- mutable references.
data MyContainer a = MC a a a a
deriving (Functor, Foldable, Traversable)
type Ref s (MyContainer a) = TraverseRef s MyContainer a
See https://mutable.jle.im/02-mutable-and-ref.html for more information on this typeclass and how to define instances automatically, and also
- https://mutable.jle.im/05-mutable-parts.html for more information on dealing with record types
- https://mutable.jle.im/06-mutable-branches for more information on dealing with sum types
Nothing
type Ref s a = (v :: Type) | v -> a s Source #
Links the type a
to the type of its canonical "mutable version".
For example, for Vector
, the mutable version is MVector
, so
we have
type Ref s (Vector
a) =MVector
s a
This means that using thawRef
on a Vector
will give you an
MVector
, using freezeRef
on a Vector
will give you
a Vector
, etc.
thawRef
:: (PrimMonad
m,PrimState
m ~ s) =>Vector
a -> m (Vector
s a)freezeRef
:: (PrimMonad
m,PrimState
m ~ s) =>Vector
s a -> m (Vector
a)copyRef
:: (PrimMonad
m,PrimState
m ~ s) =>Vector
s a ->Vector
a -> m ()
This associated type must be unique for a
, so no two types a
can
have the same
. This makes type inference a lot more
useful: if you use Ref
s afreezeRef
on an MVector
, for instance, the
return type will be inferred to be Vector
.
The default instance is just a plain old MutVar
containing the
type. This is a valid instance, but it treats the entire type
"wholesale" --- it is basically using it as a non-mutable type. You
won't get any of the performance benefits of piecewise mutation from
it, but it is useful as a base case for non-composite types like
Int
.
There are some built-in alternative options for user-defined ADTs
with Generic
instances:
-- Works for allGeneric
instances, preserves piecewise mutation -- for products type Ref s a =GRef
s a
If you just set up a blank instance, the implementations of
thawRef
, freezeRef
, and copyRef
will be inferred using
DefaultMutable
.
data MyType -- The default setup is OK instance Mutable s MyType -- This is equivalent to the above instance Mutable s MyType type Ref s MyType =MutVar
s MyType -- anyGeneric
instance data MyType = MyType { mtInt :: Int, mtDouble :: Double } deriving Generic instance Mutable s MyType where type Ref s MyType =GRef
s MyType
See https://mutable.jle.im/02-mutable-and-ref.html for more information on this type family and how to define instances automatically.
Note that this type synonym ins injective --- this means that if you
write a function polymorphic over
, you can always infer
Ref
s as
and a
(the value stored in the Ref
).
In practice, if you want to write your own instance from scratch,
the consequence is that you must have the s
type variable
somewhere in your type (see UnitRef
and VoidRef
for examples).
thawRef :: (PrimMonad m, PrimState m ~ s) => a -> m (Ref s a) Source #
Thaw a pure/persistent value into its mutable version, which can
be manipulated using modifyRef
or other methods
specific for that type (like read
).
Returns the Ref
instance, so, for example, for Vector
:
thawRef
:: (PrimMonad
m,PrimState
m ~ s) =>Vector
a -> m (Vector
s a)
For non-composite (like Int
), this is often called the "new var"
function, like newIORef
/ newSTRef
/ newMutVar
etc.
default thawRef :: (DefaultMutable s a (Ref s a), PrimMonad m, PrimState m ~ s) => a -> m (Ref s a) Source #
freezeRef :: (PrimMonad m, PrimState m ~ s) => Ref s a -> m a Source #
Freeze a mutable value into its pure/persistent version.
Takes a Ref
instance, but type inference will be able to infer the
pure value's type because Ref
is injective.
For example, for Vector
:
freezeRef
:: (PrimMonad
m,PrimState
m ~ s) =>Vector
s a -> m (Vector
a)
For non-composite (like Int
), this is often called the "read var"
function, like readIORef
/ readSTRef
/ readMutVar
etc.
default freezeRef :: (DefaultMutable s a (Ref s a), PrimMonad m, PrimState m ~ s) => Ref s a -> m a Source #
Overwrite a mutable value by provivding a pure/persistent value.
copyRef
Returns the Ref
and the value, so, for example, for Vector
:
copyRef
:: (PrimMonad
m,PrimState
m ~ s) =>Vector
s a ->Vector
a -> m ()
Note that if a
is a composite type (with an appropriate composite
reference), this will be done "piecewise": it'll write to each
mutable component separately.
For non-composite (like Int
), this is often called the "write var"
function, like writeIORef
/ writeSTRef
/ writeMutVar
etc.
default copyRef :: (DefaultMutable s a (Ref s a), PrimMonad m, PrimState m ~ s) => Ref s a -> a -> m () Source #
Deep Copy-move a mutable reference on top of another, overwriting the second one.
For non-composite types, this is the same as a thawRef
and
a copyRef
. For composite types this can be more effficient
because the copying is done piecewise, so the intermediate pure value
is never created.
default moveRef :: (DefaultMutable s a (Ref s a), PrimMonad m, PrimState m ~ s) => Ref s a -> Ref s a -> m () Source #
cloneRef :: (PrimMonad m, PrimState m ~ s) => Ref s a -> m (Ref s a) Source #
Create a deep copy of a mutable reference, allocated to a separate independent reference.
For non-composite types, this is the same as a thawRef
and
a freezeRef
. For composite types this can be more effficient
because the cloning is done piecewise, so the intermediate pure value
is never created.
default cloneRef :: (DefaultMutable s a (Ref s a), PrimMonad m, PrimState m ~ s) => Ref s a -> m (Ref s a) Source #
unsafeThawRef :: (PrimMonad m, PrimState m ~ s) => a -> m (Ref s a) Source #
A non-copying version of thawRef
that can be more efficient for
types where the mutable representation is the same as the immutable
one (like Vector
).
This is safe as long as you never again use the original pure value, since it can potentially directly mutate it.
default unsafeThawRef :: (DefaultMutable s a (Ref s a), PrimMonad m, PrimState m ~ s) => a -> m (Ref s a) Source #
unsafeFreezeRef :: (PrimMonad m, PrimState m ~ s) => Ref s a -> m a Source #
A non-copying version of freezeRef
that can be more efficient for
types where the mutable representation is the same as the immutable
one (like Vector
).
This is safe as long as you never again modify the mutable reference, since it can potentially directly mutate the frozen value magically.
default unsafeFreezeRef :: (DefaultMutable s a (Ref s a), PrimMonad m, PrimState m ~ s) => Ref s a -> m a Source #
Instances
modifyRef :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> a) -> m () Source #
Apply a pure function on an immutable value onto a value stored in a mutable reference.
modifyRef' :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> a) -> m () Source #
modifyRef
, but forces the result before storing it back in the
reference.
updateRef :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> (a, b)) -> m b Source #
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 s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> (a, b)) -> m b Source #
updateRef
, but forces the updated value before storing it back in the
reference.
modifyRefM :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> m a) -> m () Source #
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 s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> m a) -> m () Source #
modifyRefM
, but forces the result before storing it back in the
reference.
updateRefM :: (Mutable s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> m (a, b)) -> m b Source #
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 s a, PrimMonad m, PrimState m ~ s) => Ref s a -> (a -> m (a, b)) -> m b Source #
updateRefM
, but forces the updated value before storing it back in the
reference.
A handy newtype wrapper that allows you to partially apply Ref
.
is the same as RefFor
m a
, but can be partially applied.Ref
s a
If used with HKD
, you can treat this syntactically identically as
a
.Ref
s a
Instances
class DefaultMutable s a r | r -> a s where Source #
The default implementations of thawRef
, freezeRef
, and copyRef
dispatched for different choices of Ref
.
Basically, by specifying Ref
, you get the rest of the instance for
free.
We have the default case:
-- default, if you don't specify Ref
instance Mutable s MyType
-- the above is the same as:
instance Mutable s MyType
type Ref s MyType = MutVar s) MyType
The case for any instance of Generic
:
instance Mutable s MyType type Ref s MyType = GRef s MyType
The case for the "higher-kinded data" pattern a la https://reasonablypolymorphic.com/blog/higher-kinded-data/:
instance Mutable s (MyTypeF Identity) type Ref s (MyTypeF Identity) = MyTypeF (RefFor s)
The case for any newtype wrapper:
newtype MyType = MT (Vector Double) instance Mutable s MyType where type Ref s MyType = CoerceRef s MyType (Vector Double)
And the case for any 'Traversable instance, where the items will all be mutable references:
data MyContainer a = MC a a a a deriving (Functor, Foldable, Traversable) instance Mutable s a => Mutable s (MyContainer a) where type Ref s (MyContainer a) = TraverseRef s MyContainer a
defaultThawRef :: (PrimMonad m, PrimState m ~ s) => a -> m r Source #
defaultFreezeRef :: (PrimMonad m, PrimState m ~ s) => r -> m a Source #
defaultCopyRef :: (PrimMonad m, PrimState m ~ s) => r -> a -> m () Source #
defaultMoveRef :: (PrimMonad m, PrimState m ~ s) => r -> r -> m () Source #
defaultCloneRef :: (PrimMonad m, PrimState m ~ s) => r -> m r Source #
defaultUnsafeThawRef :: (PrimMonad m, PrimState m ~ s) => a -> m r Source #
defaultUnsafeFreezeRef :: (PrimMonad m, PrimState m ~ s) => r -> m a Source #
Instances
Providing and overwriting instances
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 s MyType where type Ref s MyType = GRef s 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
will be not be piecewise.VarMut
SomeType
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
to get that
VarMut
String
Mutable
instance.
Instances
Mutable s (VarMut a) Source # | |
Defined in Data.Mutable.Class thawRef :: (PrimMonad m, PrimState m ~ s) => VarMut a -> m (Ref s (VarMut a)) Source # freezeRef :: (PrimMonad m, PrimState m ~ s) => Ref s (VarMut a) -> m (VarMut a) Source # copyRef :: (PrimMonad m, PrimState m ~ s) => Ref s (VarMut a) -> VarMut a -> m () Source # moveRef :: (PrimMonad m, PrimState m ~ s) => Ref s (VarMut a) -> Ref s (VarMut a) -> m () Source # cloneRef :: (PrimMonad m, PrimState m ~ s) => Ref s (VarMut a) -> m (Ref s (VarMut a)) Source # unsafeThawRef :: (PrimMonad m, PrimState m ~ s) => VarMut a -> m (Ref s (VarMut a)) Source # unsafeFreezeRef :: (PrimMonad m, PrimState m ~ s) => Ref s (VarMut a) -> m (VarMut a) Source # | |
IsoHKD VarMut (a :: Type) Source # | Use a |
type Ref s (VarMut a) Source # | |
Defined in Data.Mutable.Class | |
type HKD VarMut (a :: Type) Source # | |
Defined in Data.Mutable.Class |
newtype CoerceMut s a Source #
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 Vector
s Mutable
instance (via
MVector
), but you don't want to write an orphan instance like
instance Mutable s DoubleVec where typeRef
s DoubleVec =CoerceRef
s DoubleVec (Vector Double)
then you can instead use
as the
data type. This wrapped type does use the inderlying CoerceMut
DoubleVec (Vector Double)Mutable
insatnce for Vector
.
CoerceMut | |
|
Instances
newtype TraverseMut f a Source #
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
is
a normal list of mutable references, instead of a full-on mutable linked
list.Mutable
(TraverseMut
[] a)
TraverseMut | |
|
Instances
newtype Immutable s a Source #
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 s MyType where type Ref s MyType = GRef s MyType
This basically uses three mutable references: the Int
, the
, and the Vector
DoubleString
. 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 s MyType where
type Ref s MyType = GRef s MyType
which has that behavior. The Int
and the Vector
will be mutable
within
, but not the Ref
s MyTypeString
.
Immutable | |
|
Instances
Mutable s (Immutable s a) Source # | |
Defined in Data.Mutable.Class thawRef :: (PrimMonad m, PrimState m ~ s) => Immutable s a -> m (Ref s (Immutable s a)) Source # freezeRef :: (PrimMonad m, PrimState m ~ s) => Ref s (Immutable s a) -> m (Immutable s a) Source # copyRef :: (PrimMonad m, PrimState m ~ s) => Ref s (Immutable s a) -> Immutable s a -> m () Source # moveRef :: (PrimMonad m, PrimState m ~ s) => Ref s (Immutable s a) -> Ref s (Immutable s a) -> m () Source # cloneRef :: (PrimMonad m, PrimState m ~ s) => Ref s (Immutable s a) -> m (Ref s (Immutable s a)) Source # unsafeThawRef :: (PrimMonad m, PrimState m ~ s) => Immutable s a -> m (Ref s (Immutable s a)) Source # unsafeFreezeRef :: (PrimMonad m, PrimState m ~ s) => Ref s (Immutable s a) -> m (Immutable s a) Source # | |
IsoHKD (Immutable s :: Type -> Type) (a :: Type) Source # | Use an |
type Ref s (Immutable s a) Source # | |
Defined in Data.Mutable.Class | |
type HKD (Immutable s :: Type -> Type) (a :: Type) Source # | |