Copyright | (c) Justin Le 2020 |
---|---|
License | BSD3 |
Maintainer | justin@jle.im |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
Data.Mutable.Parts
Description
Tools for working with individual components of piecewise-mutable values.
If Data.Mutable.Branches is for sum types, then Data.Mutable.Parts is for sum types.
See https://mutable.jle.im/05-mutable-parts.html for an introduction to this module.
Synopsis
- newtype MutPart s b a = MutPart {
- getMutPart :: Ref s b -> Ref s a
- withPart :: MutPart s b a -> Ref s b -> (Ref s a -> m r) -> m r
- freezePart :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> m a
- copyPart :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> a -> m ()
- movePartInto :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> Ref s a -> m ()
- movePartOver :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s a -> Ref s b -> m ()
- movePartWithin :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> Ref s b -> m ()
- clonePart :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> m (Ref s a)
- unsafeFreezePart :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> m a
- modifyPart :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> a) -> m ()
- modifyPart' :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> a) -> m ()
- updatePart :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> (a, r)) -> m r
- updatePart' :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> (a, r)) -> m r
- modifyPartM :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> m a) -> m ()
- modifyPartM' :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> m a) -> m ()
- updatePartM :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> m (a, r)) -> m r
- updatePartM' :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> m (a, r)) -> m r
- compMP :: MutPart s a b -> MutPart s b c -> MutPart s a c
- idMP :: MutPart s a a
- mutFst :: MutPart s (a, b) a
- mutSnd :: MutPart s (a, b) b
- class (Mutable s b, Mutable s a) => FieldMut (fld :: Symbol) s b a | fld b -> a where
- withField :: FieldMut fld s b a => Label fld -> Ref s b -> (Ref s a -> m r) -> m r
- mutField :: forall fld s b a. FieldMut fld s b a => Label fld -> Ref s b -> Ref s a
- data Label (a :: Symbol) = Label
- class (Mutable s b, Mutable s a) => PosMut (i :: Nat) s b a | i b -> a where
- withPos :: forall i s m b a r. PosMut i s b a => Ref s b -> (Ref s a -> m r) -> m r
- mutPos :: forall i s b a. PosMut i s b a => Ref s b -> Ref s a
- class (Mutable s b, Mutable s a) => TupleMut s b a | b -> a where
- withTuple :: TupleMut s b a => Ref s b -> (Ref s a -> m r) -> m r
- hkdMutParts :: forall z s. (Generic (z (RefFor s)), Generic (z (MutPart s (z Identity))), HKDMutParts s z (Rep (z (RefFor s))) (Rep (z (MutPart s (z Identity))))) => z (MutPart s (z Identity))
- class (Mutable s (z Identity), Ref s (z Identity) ~ z (RefFor s)) => HKDMutParts s z i o
- mutRec :: forall a as f rec s. (Ref s (rec f as) ~ rec (RecRef s f) as, RecElem rec a a as as (RIndex a as), RecElemFCtx rec (RecRef s f)) => MutPart s (rec f as) (f a)
- coerceRef :: Ref s b ~ CoerceRef s b a => MutPart s b a
- withCoerceRef :: CoerceRef s b a -> (Ref s a -> m r) -> m r
- type family MapRef s as where ...
Documentation
newtype MutPart s b a Source #
A
is a way to "zoom into" an MutPart
s b aa
, as a part of
a mutable reference on b
. This allows you to only modify a single
a
part of the b
, without touching the rest. It's spiritually
similar to a Lens' b a
.
If MutBranch
is for sum types, then MutPart
is
for product types.
See https://mutable.jle.im/05-mutable-parts.html for an introduction to this type.
An example that is commonly found in the ecosystem is something like
(flipped) write :: Int ->
from
Data.Vector.Mutable --- MVector
s a -> a -> m ()write 3 ::
, for instance, lets you modify a specific part of the vector
without touching the rest.MVector
s a -> a ->
m ()
You would use a MutPart
using freezePart
, copyPart
,
modifyPart
, etc.
For non-composite types, there won't really be any meaningful values. However, we have them for many composite types. For example, for tuples:
mutFst
::MutPart
s (a, b) amutSnd
:: MutPart s (a, b) b
ghci> r <-thawRef
(2, 4) ghci>copyPart
mutFst r 100 ghci>freezeRef
r (100, 4)
If you are using GRef
as an automatically-defined mutable reference,
then the easiest way to create these for your mutable types are with
fieldMut
and posMut
.
If you are using the "Higher-kinded data" pattern, then there's an easy
way to generate a MutPart
for every single field, if you have
a product type --- see hkdMutParts
for more information.
Constructors
MutPart | |
Fields
|
Instances
(Mutable s (z Identity), Ref s (z Identity) ~ z (RefFor s)) => HKDMutParts s z (K1 i (RefFor s c) :: k -> Type) (K1 i (MutPart s (z Identity) c) :: k -> Type) Source # | |
Defined in Data.Mutable.Parts | |
Category (MutPart s :: Type -> Type -> Type) Source # | |
IsoHKD (MutPart s b :: Type -> Type) (a :: Type) Source # | |
type HKD (MutPart s b :: Type -> Type) (a :: Type) Source # | |
freezePart :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> m a Source #
copyPart :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> a -> m () Source #
Arguments
:: (Mutable s a, PrimMonad m, PrimState m ~ s) | |
=> MutPart s b a | |
-> Ref s b | bigger type (destination) |
-> Ref s a | smaller type (source) |
-> m () |
With a MutPart
, copy a Ref
containing a subvalue into a specific
part of a larger Ref
.
data MyType = MT { mtInt :: Int, mtDouble :: Double } deriving Generic instance Mutable s MyType where type Ref s MyType = GRef s MyType
ghci> x <- thawRef $ MyType 3 4.5 ghci> y <- thawRef $ 100 ghci> movePartInto (fieldMut #mtInt) x y ghci> freezeRef x MyType 100 4.5
Arguments
:: (Mutable s a, PrimMonad m, PrimState m ~ s) | |
=> MutPart s b a | |
-> Ref s a | smaller type (destination) |
-> Ref s b | bigger type (source) |
-> m () |
With a MutPart
, copy a specific part of a larger Ref
into a Ref
of the smaller subvalue value.
data MyType = MT { mtInt :: Int, mtDouble :: Double } deriving Generic instance Mutable s MyType where type Ref s MyType = GRef s MyType
ghci> x <- thawRef $ MyType 3 4.5 ghci> y <- thawRef $ 100 ghci> movePartOver (fieldMut #mtInt) y x ghci> freezeRef y 3
Arguments
:: (Mutable s a, PrimMonad m, PrimState m ~ s) | |
=> MutPart s b a | |
-> Ref s b | destination |
-> Ref s b | source |
-> m () |
With a MutPart
, copy a specific part of a large Ref
into that
same part in another large Ref
.
data MyType = MT { mtInt :: Int, mtDouble :: Double } deriving Generic instance Mutable s MyType where type Ref s MyType = GRef s MyType
ghci> x <- thawRef $ MyType 3 4.5 ghci> y <- thawRef $ MyType 100 12.34 ghci> movePartWithin (fieldMut #mtInt) x y ghci> freezeRef x MyType 100 4.5
clonePart :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> m (Ref s a) Source #
Clone out a subvalue of a larger Ref
.
unsafeFreezePart :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> m a Source #
A non-copying version of unsafeFreezeRef
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.
modifyPart :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> a) -> m () Source #
modifyPart' :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> a) -> m () Source #
modifyPart
, but forces the result before storing it back in the
reference.
updatePart :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> (a, r)) -> m r Source #
updatePart' :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> (a, r)) -> m r Source #
updatePart
, but forces the result before storing it back in the
reference.
modifyPartM :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> m a) -> m () Source #
modifyPartM' :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> m a) -> m () Source #
modifyPartM
, but forces the result before storing it back in the
reference.
updatePartM :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> m (a, r)) -> m r Source #
updateRefM
, under a MutPart
to only modify a specific part of
a Ref
. copyRef
into the reference after the action is completed.
updatePartM' :: (Mutable s a, PrimMonad m, PrimState m ~ s) => MutPart s b a -> Ref s b -> (a -> m (a, r)) -> m r Source #
updatePartM
, but forces the result before storing it back in the
reference.
Built-in MutPart
Field
class (Mutable s b, Mutable s a) => FieldMut (fld :: Symbol) s b a | fld b -> a where Source #
Create a MutPart
for a field name. Should work for any type with
one constructor whose mutable reference is GRef
. See fieldMut
for
usage directions.
Mostly leverages the power of Data.Generics.Product.Fields.
Methods
Create a MutPart
for a field name. Should work for any type with
one constructor whose mutable reference is GRef
.
Is meant to be used with OverloadedLabels:
data MyType = MyType { mtInt :: Int, mtDouble :: Double }
deriving (Generic, Show)
instance Mutable s MyType where
type Ref s MyType = GRef
s MyType
ghci> r <-thawRef
(MyType 3 4.5) ghci>freezePart
(fieldMut
#mtInt) r 3 ghci>copyPart
(fieldMut #mtDouble) 1.23 ghci>freezeRef
r MyType 3 1.23
However, you can use it without OverloadedLabels by using Label
with
TypeApplications:
ghci>freezePart
(fieldMut
(Label
@"mtInt")) r 3
This and posMut
are the main ways to generate a MutPart
for
a type whose mutable reference is GRef
. Note that because all of
the lookups are done at compile-time, fieldMut
and posMut
have
more or less identical performance characteristics.
Arguments
:: forall fld s b a. FieldMut fld s b a | |
=> Label fld | field label (usually given using OverloadedLabels, @#blah) |
-> Ref s b | Larger record reference |
-> Ref s a | Internal mutable field |
A helpful wrapper around
. Directly
use a getMutPart
(fieldMut
#blah)fieldMut
to access a mutable field.
Proxy for label type
Constructors
Label |
Position
class (Mutable s b, Mutable s a) => PosMut (i :: Nat) s b a | i b -> a where Source #
Create a MutPart
for a position in a product type. Should work for any
type with one constructor whose mutable reference is GRef
. See
posMut
for usage directions.
Mostly leverages the power of Data.Generics.Product.Positions.
Methods
posMut :: MutPart s b a Source #
Create a MutPart
for a position in a product type. Should work for any
type with one constructor whose mutable reference is GRef
.
Meant to be used with TypeApplications:
data MyType = MyType Int Double
deriving (Generic, Show)
instance Mutable s MyType where
type Ref s MyType = GRef
s MyType
ghci> r <-thawRef
(MyType 3 4.5) ghci>freezePart
(posMut
@1) r 3 ghci>copyPart
(posMut @2) 1.23 ghci>freezeRef
r MyType 3 1.23
This and fieldMut
are the main ways to generate a MutPart
for
a type whose mutable reference is GRef
. Note that because all of
the lookups are done at compile-time, posMut
and fieldMut
have
more or less identical performance characteristics.
Instances
Arguments
:: forall i s b a. PosMut i s b a | |
=> Ref s b | Larger record reference |
-> Ref s a | Internal mutable field |
A helpful wrapper around
. Directly
use a getMutPart
(posMut
@n)posMut
to access a mutable field.
HList
class (Mutable s b, Mutable s a) => TupleMut s b a | b -> a where Source #
Create a MutPart
splitting out a product type into a tuple of refs
for every field in that product type. Should work for any type with one
constructor whose mutable reference is GRef
. See tupleMut
for usage
directions.
Mostly leverages the power of Data.Generics.Product.HList.
Methods
tupleMut :: MutPart s b a Source #
Create a MutPart
splitting out a product type into a tuple of refs
for every field in that product type. Should work for any type with one
constructor whose mutable reference is GRef
.
Probably most easily used using withTuple
:
data MyType = MyType Int Double
deriving (Generic, Show)
instance Mutable s MyType where
type Ref s MyType = GRef
s MyType
Now there is an instance of
.TupleMut
m MyType (Int, Double)
ghci> r <-thawRef
(MyType 3 4.5) ghci>withTuple
r $ (rI, rD) -> do ..modifyRef
rI negate .. modifyRef rD (* 2) ghci>freezeRef
r MyType (-3) 9
As can be seen, within the lambda, we can get access to every
mutable reference inside a MyType
reference.
Performance-wise, this appears to be faster than fieldMut
and
posMut
when using a single reference, but slower if using all
references.
Arguments
:: TupleMut s b a | |
=> Ref s b | Larger record reference |
-> (Ref s a -> m r) | What to do with each mutable field. The
|
-> m r |
A helpful wrapper over
. Directly operate on
the items in the data type, getting the references as a tuple. See
withPart
tupleMut
tupleMut
for more details on when this should work.
data MyType = MyType Int Double
deriving (Generic, Show)
instance Mutable s MyType where
type Ref s MyType = GRef
s MyType
ghci> r <-thawRef
(MyType 3 4.5) ghci>withTuple
r $ (rI, rD) -> do ..modifyRef
rI negate .. modifyRef rD (* 2) ghci>freezeRef
r MyType (-3) 9
Other
hkdMutParts :: forall z s. (Generic (z (RefFor s)), Generic (z (MutPart s (z Identity))), HKDMutParts s z (Rep (z (RefFor s))) (Rep (z (MutPart s (z Identity))))) => z (MutPart s (z Identity)) Source #
If you are using the "higher-kinded data" pattern, a la
https://reasonablypolymorphic.com/blog/higher-kinded-data/, and you
have the appropriate instance for Ref
, then you can use this to
generate a MutPart
for every field, if you have a type with only one
constructor.
data MyTypeF f = MT { mtInt :: f Int , mtDouble :: f Double } deriving Generic instance Mutable (MyTypeFIdentity
) where type Ref (MyTypeFIdentity
) = MyTypeF (RefFor
m) mx :: MutPart s (MyTypeF Identity) (Vector
Int) my :: MutPart s (MyTypeF Identity) (Vector Double) MT mx my = hkdMutParts @MyTypeF
ghci> r <- thawRef (MT 3 4.5) ghci>freezePart
mx r 3 ghci>copyPart
(mtDouble (hkdMutParts @MyTypeF)) r 12.3 ghci>freezeRef
r MT 3 12.3
Performance-wise, this is about equivalent to fieldMut
and posMut
for the most part, so the main advantage would be purely syntactical. If
performance is an issue, you should benchmark all the different ways
just to be sure. As a general rule, it seems like deep nested accesses
are faster with composition of fieldMut
and posMut
, but immediate
shallow access is often faster with hkdMutParts
...but this probably
does vary on a case-by-case basis.
class (Mutable s (z Identity), Ref s (z Identity) ~ z (RefFor s)) => HKDMutParts s z i o Source #
Typeclass used to implement hkdMutParts
. See documentation of
hkdMutParts
for more information.
Minimal complete definition
hkdMutParts_
Instances
(Mutable s (z Identity), Ref s (z Identity) ~ z (RefFor s), TypeError ('Text "Cannot use hkdMutParts for uninhabited types: " :<>: 'ShowType z) :: Constraint) => HKDMutParts s z (V1 :: k -> Type) (V1 :: k -> Type) Source # | |
Defined in Data.Mutable.Parts Methods hkdMutParts_ :: forall (a :: k0). (z (RefFor s) -> V1 a) -> V1 a | |
(Mutable s (z Identity), Ref s (z Identity) ~ z (RefFor s)) => HKDMutParts s z (U1 :: k -> Type) (U1 :: k -> Type) Source # | |
Defined in Data.Mutable.Parts Methods hkdMutParts_ :: forall (a :: k0). (z (RefFor s) -> U1 a) -> U1 a | |
(Mutable s (z Identity), Ref s (z Identity) ~ z (RefFor s), TypeError ('Text "Cannot use hkdMutParts for sum types: " :<>: 'ShowType z) :: Constraint) => HKDMutParts s z (i :+: i' :: k -> Type) (o :: k -> Type) Source # | |
Defined in Data.Mutable.Parts Methods hkdMutParts_ :: forall (a :: k0). (z (RefFor s) -> (i :+: i') a) -> o a | |
(HKDMutParts s z i o, HKDMutParts s z i' o') => HKDMutParts s z (i :*: i' :: k -> Type) (o :*: o' :: k -> Type) Source # | |
Defined in Data.Mutable.Parts Methods hkdMutParts_ :: forall (a :: k0). (z (RefFor s) -> (i :*: i') a) -> (o :*: o') a | |
(Mutable s (z Identity), Ref s (z Identity) ~ z (RefFor s)) => HKDMutParts s z (K1 i (RefFor s c) :: k -> Type) (K1 i (MutPart s (z Identity) c) :: k -> Type) Source # | |
Defined in Data.Mutable.Parts | |
HKDMutParts s z i o => HKDMutParts s z (M1 a b i :: k -> Type) (M1 a b o :: k -> Type) Source # | |
Defined in Data.Mutable.Parts Methods hkdMutParts_ :: forall (a0 :: k0). (z (RefFor s) -> M1 a b i a0) -> M1 a b o a0 |
mutRec :: forall a as f rec s. (Ref s (rec f as) ~ rec (RecRef s f) as, RecElem rec a a as as (RIndex a as), RecElemFCtx rec (RecRef s f)) => MutPart s (rec f as) (f a) Source #
A MutPart
for a field in a vinyl Rec
, automatically
generated as the first field with a matching type. This is polymorphic
to work over both Rec
and ARec
.
ghci> r <-thawRef
$ [1,2,3]:&
[True, False] :&RNil
ghci> modifyPart (mutRec @Bool) r reverse ghci> freezeRef r [1,2,3] :& [False, True] :& RNil
withCoerceRef :: CoerceRef s b a -> (Ref s a -> m r) -> m r Source #
Handy wrapper over
.getMutPart
coerceRef