mutable (empty) → 0.1.0.0
raw patch · 12 files changed
+4122/−0 lines, 12 filesdep +basedep +constraintsdep +criterionsetup-changed
Dependencies added: base, constraints, criterion, deepseq, directory, generic-lens, microlens, microlens-th, mutable, primitive, reflection, time, transformers, vector, vinyl
Files
- CHANGELOG.md +11/−0
- LICENSE +30/−0
- README.md +203/−0
- Setup.hs +2/−0
- bench/bench.hs +295/−0
- mutable.cabal +84/−0
- src/Data/Mutable.hs +84/−0
- src/Data/Mutable/Branches.hs +681/−0
- src/Data/Mutable/Class.hs +356/−0
- src/Data/Mutable/Instances.hs +476/−0
- src/Data/Mutable/Internal.hs +1244/−0
- src/Data/Mutable/Parts.hs +656/−0
+ CHANGELOG.md view
@@ -0,0 +1,11 @@+Changelog+=========++Version 0.1.0.0+---------------++*January 23, 2020*++<https://github.com/mstksg/mutable/releases/tag/v0.1.0.0>++* Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Justin Le (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Justin Le nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,203 @@+[mutable][docs]+===============++[](https://hackage.haskell.org/package/mutable)+[](https://travis-ci.org/mstksg/mutable)++[**Documentation and Walkthrough**][docs]++[docs]: https://mutable.jle.im++Beautiful Mutable Values+------------------------++**Mutability can be awesome!**++Take back the power of **mutable objects** with all the **safety** and explicit+state of Haskell. Associate and generate "piecewise-mutable" versions for your+composite data types in a composable and automatic way. Think of it like a+"generalized `MVector` for all ADTs". It also leverages GHC Generics to make+working with piecewise mutability as simple as possible.++Making piecewise updates on your giant composite data types (like artificial+neural networks or game states in your game loop) got you down because they+require re-allocating the entire value? Tired of requiring a full deep copy+every time you make a small change, and want to be able to build mutable+versions of your types automatically in composable ways? This is the package+for you.++Useful for a situation where you have a record with many fields (or many nested+records) that you want to use for efficient mutable in-place algorithms. This+library lets you do efficient "piecewise" mutations (operations that only edit+one field), and also efficient entire-datatype copies/updates, as well, in many+cases.++Check out the [documentation home page][docs], [haddock reference][haddock], or+read below for motivation and high-level descriptions.++[haddock]: https://hackage.haskell.org/package/mutable++Motivation+----------++### Piecewise-Mutable++For a simple motivating example where in-place piecewise mutations might be+better, consider a large vector.++Let's say you only want to edit the first item in a vector, multiple times.+This is extremely inefficient with a pure vector:++```haskell+addFirst :: Vector Double -> Vector Double+addFirst xs = iterate incr xs !! 1000000+ where+ incr v = v V.// [(0, (v V.! 0) + 1)]+```++That's because `addFirst` will copy over the entire vector for every step+--- every single item, even if not modified, will be copied one million times.+It is `O(n*l)` in memory updates --- it is very bad for long vectors or large+matrices.++However, this is extremely efficient with a mutable vector:++```haskell+addFirst :: Vector Double -> Vector Double+addFirst xs = runST $ do+ v <- V.thaw xs+ replicateM_ 1000000 $ do+ MV.modify v 0 (+ 1)+ V.freeze v+```++This is because all of the other items in the vector are kept the same and not+copied-over over the course of one million updates. It is `O(n+l)` in memory+updates. It is very good even for long vectors or large matrices.++(Of course, this situation is somewhat contrived, but it isolates a problem that+many programs face. A more common situation might be that you have two+functions that each modify different items in a vector in sequence, and you+want to run them many times interleaved, or one after the other.)++Composite Datatype+------------------++That all works for `MVector`, but let's say you have a simple composite data+type that is two vectors:++```haskell+data TwoVec = TV { tv1 :: Vector Double+ , tv2 :: Vector Double+ }+ deriving Generic+```++Is there a nice "piecewise-mutable" version of this? You *could* break up+`TwoVec` manually into its pieces and treat each piece independently, but that method+isn't composable. If only there was some equivalent of `MVector` for+`TwoVec`...and some equivalent of `MV.modify`.++That's where this library comes in.++```haskell+instance PrimMonad m => Mutable m TwoVec where+ type Ref m TwoVec = GRef m TwoVec+```++This gives us `thawRef :: TwoVec -> m (GRef m TwoVec)`, where `GRef m TwoVec`+is a mutable version of `TwoVec`, like how `MVector s Double` is a mutable+version of `Vector Double`. It stores each field `tv1` and `tv2` as a seaprate+`MVector` in memory that can be modified independently.++Now we can write:++```haskell+addFirst :: TwoVec -> TwoVec+addFirst xs = runST $ do+ v <- thawRef xs+ replicateM_ 1000000 $ do+ withField #tv1 v $ \u ->+ MV.modify u 0 (+ 1)+ freezeRef v+```++This will in-place edit only the first item in the `tv1` field one million+times, without ever needing to copy over the contents `tv2`. Basically, it+gives you a version of `TwoVec` that you can modify in-place piecewise. You+can compose two functions that each work piecewise on `TwoVec`:++```haskell+mut1 :: PrimMonad m => Ref m TwoVec -> m ()+mut1 v = do+ withField #tv1 v $ \u ->+ MV.modify u 0 (+ 1)+ MV.modify u 1 (+ 2)+ withField #tv2 v $ \u ->+ MV.modify u 2 (+ 3)+ MV.modify u 3 (+ 4)++mut2 :: PrimMonad m => Ref m TwoVec -> m ()+mut2 v = do+ withField #tv1 v $ \u ->+ MV.modify u 4 (+ 1)+ MV.modify u 5 (+ 2)+ withField #tv2 v $ \u ->+ MV.modify u 6 (+ 3)+ MV.modify u 7 (+ 4)++doAMillion :: TwoVec -> TwoVec+doAMillion xs = runST $ do+ v <- thawRef xs+ replicateM_ 1000000 $ do+ mut1 v+ mut2 v+ freezeRef v+```++This is a type of composition and interleaving that cannot be achieved by+simply breaking down `TwoVec` and running functions that work purely on each of+the two vectors individually.++Show me the numbers+-------------------++Here are some benchmark cases --- only bars of the same color are comparable,+and shorter bars are better (performance-wise).++++There are four situations here, compared and contrasted between pure and+mutable versions++1. A large ADT with 256 fields, generated by repeated nestings of `data V4 a =+ V4 !a !a !a !a`++ 1. Updating only a single part (one field out of 256)+ 2. Updating the entire ADT (all 256 fields)++2. A composite data type of four `Vector`s of 500k elements each, so 2 million+ elements total.++ 1. Updating only a single part (one item out of 2 million)+ 2. Updating all elements of all four vectors (all 2 million items)++We can see four conclusions:++1. For a large ADT, updating a single field (or multiple fields, interleaved)+ is going to be faster with *mutable*. This speedup is between x4 and x5,+ suggesting it is a speedup arising from the fact that the top-level type+ has four fields.+2. For a large ADT, updating the whole ADT (so just replacing the entire+ thing, no actual copies) is faster just as a pure value by a large factor+ (which is a big testament to GHC).+3. For a small ADT with huge vectors, updating a single field is *much* faster+ with *mutable*.+4. For a small ADT with huge vectors, updating the entire value (so, the+ entire vectors and entire ADT) is actually faster with *mutable* as well.++Interestingly, the "update entire structure" case (which should be the+worst-case for *mutable* and the best-case for pure values) actually becomes+faster with *mutable* when you get to the region of *many* values... somewhere+between 256 and 2 million, apparently. However, this may just be from the+efficiency of modifying vectors sequentially.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/bench.hs view
@@ -0,0 +1,295 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}++import Control.Category ((.))+import Control.DeepSeq+import Control.Monad.ST+import Control.Monad.Trans.Class+import Control.Monad.Trans.Cont+import Control.Monad.Trans.State+import Criterion.Main+import Criterion.Types+import Data.Foldable+import Data.Mutable+import Data.Time+import Data.Vector (Vector)+import Data.Vinyl.Functor+import GHC.Generics+import Lens.Micro+import Lens.Micro.TH+import Prelude hiding ((.))+import System.Directory+import qualified Data.Vector as V+import qualified Data.Vector.Mutable as MV++data V4 a = V4 { _v4X :: !a+ , _v4Y :: !a+ , _v4Z :: !a+ , _v4W :: !a+ }+ deriving (Show, Generic, Functor, Foldable, Traversable)++instance NFData a => NFData (V4 a)+instance Mutable m a => Mutable m (V4 a) where+ type Ref m (V4 a) = GRef m (V4 a)+instance Applicative V4 where+ pure x = V4 x x x x+ V4 a b c d <*> V4 x y z w = V4 (a x) (b y) (c z) (d w)+makeLenses 'V4++newtype V256 a = V256 { _v256 :: V4 (V4 (V4 (V4 a))) }+ deriving (Show, Generic, Functor, Foldable, Traversable)+ deriving Applicative via (V4 :.: V4 :.: V4 :.: V4)+instance NFData a => NFData (V256 a)+instance Mutable m a => Mutable m (V256 a) where+ type Ref m (V256 a) = CoerceRef m (V256 a) (V4 (V4 (V4 (V4 a))))+makeLenses 'V256++-- HKD variant of V4+data V4F a f = V4F { _vf4X :: !(f a)+ , _vf4Y :: !(f a)+ , _vf4Z :: !(f a)+ , _vf4W :: !(f a)+ }+ deriving (Show, Generic)+instance NFData (f a) => NFData (V4F a f)+instance Mutable m a => Mutable m (V4F a Identity) where+ type Ref m (V4F a Identity) = V4F a (RefFor m)++-- HKD variant of V256+newtype V256F a = V256F { _v256F :: V4F (V4F (V4F (V4F a Identity) Identity) Identity) Identity }+ deriving (Show, Generic)+instance NFData a => NFData (Identity a)+instance NFData a => NFData (V256F a)+instance Mutable m a => Mutable m (V256F a) where+ type Ref m (V256F a) = CoerceRef m (V256F a) (V4F (V4F (V4F (V4F a Identity) Identity) Identity) Identity)+++type ADT = V256 Double+type ADTF = V256F Double+type Vec = V4 (Vector Double)+type VecF = V4F (Vector Double) Identity++pureLoop :: (a -> a) -> Int -> a -> a+pureLoop f n = go 0+ where+ go !i !x+ | i < n = go (i + 1) (f x)+ | otherwise = x++modifyPartPure :: Int -> ADT -> ADT+modifyPartPure = pureLoop $ over (v256 . v4X . v4X . v4X . v4X) (+1)++modifyWholePure :: Int -> ADT -> ADT+modifyWholePure = pureLoop $ fmap (+ 1)++modifyPartPureV :: Int -> Vec -> Vec+modifyPartPureV = pureLoop $ over v4X $ \v -> v V.// [(0, (v V.! 0) + 1)]++modifyWholePureV :: Int -> Vec -> Vec+modifyWholePureV = pureLoop $ (fmap . fmap) (+ 1)+++++mutLoop :: (forall s. Mutable (ST s) a) => (forall s. Ref (ST s) a -> ST s ()) -> Int -> a -> a+mutLoop f n x0 = runST $ do+ r <- thawRef x0+ let go !i+ | i < n = do+ f r+ go (i + 1)+ | otherwise = pure ()+ go 0+ unsafeFreezeRef r++modifyPartMut :: (forall s. Mutable (ST s) a) => (forall s. MutPart (ST s) a Double) -> Int -> a -> a+modifyPartMut f = mutLoop $ \r -> modifyPart' f r (+1)++modifyWholeMut :: (forall s b. Mutable (ST s) b => Ref (ST s) (V4 b) -> ContT () (ST s) (Ref (ST s) b)) -> Int -> ADT -> ADT+modifyWholeMut f = mutLoop $ \r ->+ withAllRefV256 f r $ \s ->+ modifyRef s (+ 1)++modifyWholeMutHKD :: Int -> ADTF -> ADTF+modifyWholeMutHKD = mutLoop $ \r ->+ withAllRefV256HKD r $ \s ->+ modifyRef s (+ 1)++modifyPartMutV :: (forall s. Mutable (ST s) a) => (forall s. MutPart (ST s) a (Vector Double)) -> Int -> a -> a+modifyPartMutV f = mutLoop $ \r -> withPart f r $ \mv ->+ (MV.write mv 0 $!) . (+ 1) =<< MV.read mv 0++modifyWholeMutV :: (forall s. Mutable (ST s) a) => (forall s. Ref (ST s) a -> ContT () (ST s) (MV.MVector s Double)) -> Int -> a -> a+modifyWholeMutV f = mutLoop $ \r -> runContT (f r) $ \mv -> do+ forM_ [0 .. MV.length mv - 1] $ \i ->+ (MV.write mv i $!) . (+ 1) =<< MV.read mv i++main :: IO ()+main = do+ t <- getZonedTime+ let tstr = formatTime defaultTimeLocale "%Y%m%d-%H%M%S" t+ createDirectoryIfMissing True "bench-results"+ defaultMainWith defaultConfig+ { reportFile = Just $ "bench-results/mutable-bench_" ++ tstr ++ ".html"+ , timeLimit = 10+ } [+ bgroup "adt-256" [+ bgroup "part-50M"+ [ bench "pure" $ nf (modifyPartPure 50_000_000) bigADT+ -- , bench "mutable" $ nf (modifyPartMut (partRep (fieldMut #_v4X)) 50_000_000) bigADT+ , bgroup "mutable" [+ bench "field" $ nf (modifyPartMut (partRep (fieldMut #_v4X)) 50_000_000) bigADT+ , bench "pos" $ nf (modifyPartMut (partRep (posMut @1 )) 50_000_000) bigADT+ , bench "tuple" $ nf (modifyPartMut (partRep firstTuple ) 50_000_000) bigADT+ , bench "hkd" $ nf (modifyPartMut modPartHKD 50_000_000) bigADTF+ ]+ ]+ , bgroup "whole-20K"+ [ bench "pure" $ nf (modifyWholePure 20_000) bigADT+ -- , bench "mutable" $ nf (modifyWholeMut withAllRefV4Field 20_000) bigADT+ , bgroup "mutable" [+ bench "field" $ nf (modifyWholeMut withAllRefV4Field 20_000) bigADT+ , bench "pos" $ nf (modifyWholeMut withAllRefV4Pos 20_000) bigADT+ , bench "tuple" $ nf (modifyWholeMut withAllRefV4Tuple 20_000) bigADT+ , bench "hkd" $ nf (modifyWholeMutHKD 20_000) bigADTF+ ]+ ]+ ]+ , bgroup "vector-2M" [+ bgroup "part-100"+ [ bench "pure" $ nf (modifyPartPureV 100) bigVec+ -- , bench "mutable" $ nf (modifyPartMutV (fieldMut #_v4X) 100) bigVec+ , bgroup "mutable" [+ bench "field" $ nf (modifyPartMutV (fieldMut #_v4X) 100) bigVec+ , bench "pos" $ nf (modifyPartMutV (posMut @1 ) 100) bigVec+ , bench "tuple" $ nf (modifyPartMutV (firstTuple ) 100) bigVec+ , bench "hkd" $ nf (modifyPartMutV (_vf4X vfParts) 100) bigVecF+ ]+ ]+ , bgroup "whole-3"+ [ bench "pure" $ nf (modifyWholePureV 3) bigVec+ -- , bench "mutable" $ nf (modifyWholeMutV withAllRefV4Field 3) bigVec+ , bgroup "mutable" [+ bench "field" $ nf (modifyWholeMutV withAllRefV4Field 3) bigVec+ , bench "pos" $ nf (modifyWholeMutV withAllRefV4Pos 3) bigVec+ , bench "tuple" $ nf (modifyWholeMutV withAllRefV4Tuple 3) bigVec+ , bench "hkd" $ nf (modifyWholeMutV withAllRefV4HKD 3) bigVecF+ ]+ ]+ ]+ ]+ where+ bigADT :: ADT+ !bigADT = populate $ pure ()+ bigADTF :: ADTF+ !bigADTF = toADTF bigADT+ bigVec :: Vec+ !bigVec = getCompose . populate . Compose $ pure (V.replicate 500_000 ())+ bigVecF :: VecF+ !bigVecF = toVF bigVec++++toADTF :: ADT -> ADTF+toADTF = V256F+ . toVF . fmap (toVF . fmap (toVF . fmap toVF))+ . _v256++toVF :: V4 a -> V4F a Identity+toVF (V4 a b c d) = V4F (Identity a) (Identity b) (Identity c) (Identity d)++vfParts :: forall m a. Mutable m a => V4F a (MutPart m (V4F a Identity))+vfParts = hkdMutParts @(V4F a)++partRep :: Mutable m a => (forall b. Mutable m b => MutPart m (V4 b) b) -> MutPart m (V256 a) a+partRep f = f . f . f . f . coerceRef++firstTuple :: Mutable m a => MutPart m (V4 a) a+firstTuple = MutPart (\(x,_,_,_) -> x) . tupleMut++modPartHKD :: forall m a. Mutable m a => MutPart m (V256F a) a+modPartHKD = _vf4X vfParts+ . _vf4X vfParts+ . _vf4X vfParts+ . _vf4X vfParts+ . coerceRef++++withAllRefV4Field :: Mutable m a => Ref m (V4 a) -> ContT () m (Ref m a)+withAllRefV4Field r = ContT $ \f -> do+ withPart (fieldMut #_v4X) r f+ withPart (fieldMut #_v4Y) r f+ withPart (fieldMut #_v4Z) r f+ withPart (fieldMut #_v4W) r f++withAllRefV4Pos :: Mutable m a => Ref m (V4 a) -> ContT () m (Ref m a)+withAllRefV4Pos r = ContT $ \f -> do+ withPart (posMut @1) r f+ withPart (posMut @2) r f+ withPart (posMut @3) r f+ withPart (posMut @4) r f++withAllRefV4Tuple :: Mutable m a => Ref m (V4 a) -> ContT () m (Ref m a)+withAllRefV4Tuple r = ContT $ \f ->+ withTuple r $ \(x, y, z, w) -> do+ f x+ f y+ f z+ f w++withAllRefV4HKD :: forall m a. Mutable m a => V4F a (RefFor m) -> ContT () m (Ref m a)+withAllRefV4HKD r = ContT $ \f -> do+ withPart (_vf4X vfParts) r f+ withPart (_vf4Y vfParts) r f+ withPart (_vf4Z vfParts) r f+ withPart (_vf4W vfParts) r f++withAllRefV256+ :: Mutable m a+ => (forall b. Mutable m b => Ref m (V4 b) -> ContT () m (Ref m b))+ -> Ref m (V256 a)+ -> (Ref m a -> m ())+ -> m ()+withAllRefV256 a r f = flip runContT pure $ do+ s <- a =<< a =<< a =<< a+ =<< ContT (withPart coerceRef r)+ lift $ f s+++withAllRefV256HKD :: Mutable m a => Ref m (V256F a) -> (Ref m a -> m ()) -> m ()+withAllRefV256HKD r f = flip runContT pure $ do+ s <- withAllRefV4HKD+ =<< withAllRefV4HKD+ =<< withAllRefV4HKD+ =<< withAllRefV4HKD+ =<< ContT (withPart coerceRef r)+ lift $ f s++populate :: Traversable f => f () -> f Double+populate = flip evalState 0 . traverse go+ where+ go _ = state $ \i -> (fromInteger i, i + 1)+
+ mutable.cabal view
@@ -0,0 +1,84 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 4bc371a3f5a9dc170b74be324280aeabe3d89a2be7c8766d3b5c3e27b5b29333++name: mutable+version: 0.1.0.0+synopsis: Automatic piecewise-mutable references for your types+description: Associate and generate "piecewise-mutable" versions for your composite data+ types. Think of it like a "generalized MVector for all ADTs".+ .+ Useful for a situation where you have a record with many fields (or many nested+ records) that you want to use for efficient mutable in-place algorithms. This+ library lets you do efficient "piecewise" mutations (operations that only edit+ one field), and also efficient entire-datatype copies/updates, as well, in many+ cases.+ .+ See <https://mutable.jle.im> for official introduction and documentation,+ or jump right in by importing "Data.Mutable".+category: Data+homepage: https://github.com/mstksg/mutable#readme+bug-reports: https://github.com/mstksg/mutable/issues+author: Justin Le+maintainer: justin@jle.im+copyright: (c) Justin Le 2020+license: BSD3+license-file: LICENSE+tested-with: GHC >= 8.6 && < 8.10+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/mstksg/mutable++library+ exposed-modules:+ Data.Mutable+ Data.Mutable.Branches+ Data.Mutable.Class+ Data.Mutable.Instances+ Data.Mutable.Parts+ other-modules:+ Data.Mutable.Internal+ hs-source-dirs:+ src+ ghc-options: -Wall -Wcompat -Wredundant-constraints -Werror=incomplete-patterns+ build-depends:+ base >=4.11 && <5+ , constraints+ , generic-lens >=1.1+ , primitive >=0.6.4+ , reflection+ , transformers+ , vector+ , vinyl+ default-language: Haskell2010++benchmark mutable-bench+ type: exitcode-stdio-1.0+ main-is: bench.hs+ other-modules:+ Paths_mutable+ hs-source-dirs:+ bench+ ghc-options: -Wall -Wcompat -Wredundant-constraints -Werror=incomplete-patterns -threaded -rtsopts -with-rtsopts=-N -O2+ build-depends:+ base >=4.12 && <5+ , criterion+ , deepseq+ , directory+ , microlens+ , microlens-th+ , mutable+ , time+ , transformers+ , vector+ , vinyl+ default-language: Haskell2010
+ src/Data/Mutable.hs view
@@ -0,0 +1,84 @@++-- |+-- Module : Data.Mutable.Class+-- Copyright : (c) Justin Le 2020+-- License : BSD3+--+-- Maintainer : justin@jle.im+-- Stability : experimental+-- Portability : non-portable+--+-- Main entrypoint of the package. Abstract over different types for+-- piecewise-mutable references of values.+--+-- See <https://mutable.jle.im/> for a comprehensive introduction.+module Data.Mutable (+ Mutable(..)+ , modifyRef, modifyRef'+ , updateRef, updateRef'+ , RefFor(..)+ -- * Instances+ , DefaultMutable+ , GRef+ , MutVar+ , CoerceRef(..)+ , TraverseRef(..)+ , GMutableRef(..)+ , HListRef(..)+ -- * Providing/overriding instances+ , VarMut(..)+ , CoerceMut(..)+ , TraverseMut(..)+ , Immutable(..)+ -- * Parts+ , MutPart(..)+ , withPart+ , freezePart, copyPart+ , movePartInto, movePartOver, movePartWithin+ , clonePart, unsafeFreezePart+ , modifyPart, modifyPart'+ , updatePart, updatePart'+ -- ** Built-in 'MutPart'+ -- *** Field+ , FieldMut(..), withField, mutField, Label(..)+ -- *** Position+ , PosMut(..), withPos, mutPos+ -- *** Tuple+ , TupleMut(..), withTuple+ -- *** Higher-Kinded Data+ , hkdMutParts, HKDMutParts+ -- *** Other+ , mutFst, mutSnd+ , mutRec+ , coerceRef, withCoerceRef+ -- * Branches+ , MutBranch(..)+ , thawBranch+ , freezeBranch+ , moveBranch+ , copyBranch+ , cloneBranch+ , hasBranch, hasn'tBranch+ , unsafeThawBranch+ , unsafeFreezeBranch+ , withBranch, withBranch_+ , modifyBranch, modifyBranch'+ , updateBranch, updateBranch'+ -- ** Built-in 'MutBranch'+ -- *** Using GHC Generics+ , constrMB, CLabel(..), GMutBranchConstructor, MapRef+ -- *** For common types+ , nilMB, consMB+ , nothingMB, justMB+ , leftMB, rightMB+ -- * Re-exports+ , PrimMonad, PrimState+ ) where++import Control.Monad.Primitive+import Data.Mutable.Branches+import Data.Mutable.Class+import Data.Mutable.Instances+import Data.Mutable.Parts+import Data.Primitive.MutVar+
+ src/Data/Mutable/Branches.hs view
@@ -0,0 +1,681 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+++-- |+-- Module : Data.Mutable.MutBranch+-- Copyright : (c) Justin Le 2020+-- License : BSD3+--+-- Maintainer : justin@jle.im+-- Stability : experimental+-- Portability : non-portable+--+-- Tools for working with potential branches of piecewise-mutable+-- values.+--+-- If "Data.Mutable.Parts" is for product types, then+-- "Data.Mutable.Branches" is for sum types.+--+-- See <https://mutable.jle.im/06-mutable-branches.html> for an+-- introduction to this module.+module Data.Mutable.Branches (+ MutBranch(..)+ , thawBranch+ , freezeBranch+ , hasBranch, hasn'tBranch+ , moveBranch+ , copyBranch+ , cloneBranch+ , unsafeThawBranch+ , unsafeFreezeBranch+ , withBranch, withBranch_+ , modifyBranch, modifyBranch'+ , updateBranch, updateBranch'+ , modifyBranchM, modifyBranchM'+ , updateBranchM, updateBranchM'+ -- * Built-in 'MutBranch'+ , compMB, idMB+ -- ** Using GHC Generics+ , constrMB, CLabel(..), GMutBranchConstructor, MapRef+ -- ** For common types+ , nilMB, consMB+ , nothingMB, justMB+ , leftMB, rightMB+ ) where++import Control.Monad+import Control.Monad.Primitive+import Data.Maybe+import Data.Mutable.Class+import Data.Mutable.Instances+import Data.Primitive.MutVar+import GHC.Generics+import GHC.OverloadedLabels+import GHC.TypeLits+import qualified Data.GenericLens.Internal as GL+import qualified Data.Generics.Internal.Profunctor.Lens as GLP++-- | A @'MutBranch' m s a@ represents the information that @s@ could+-- potentially be an @a@. Similar in spirit to a @Prism' s a@.+--+-- @'MutBranch' m s a@ means that @a@ is one potential option that @s@+-- could be in, or that @s@ is a sum type and @a@ is one of the+-- branches/constructors.+--+-- See <https://mutable.jle.im/06-mutable-branches.html> for an+-- introduction to this module.+--+-- If 'Data.Mutable.Parts.MutPart' is for product types, then 'MutBranch'+-- is for sum types.+--+-- In this case, "branch" means "potential option". For example, the+-- branches of 'Either' are 'Left' and 'Right'.+--+-- The simplest way to make these is by using 'constrMB'. For instance, to+-- get the two branches of an 'Either':+--+-- @+-- constrMB #_Left :: MutBranch m (Either a b) a+-- constrMB #_Right :: MutBranch m (Either a b) b+-- @+--+-- @+-- ghci> r <- 'thawRef' (Left 10)+-- ghci> 'freezeBranch' ('constrMB' #_Left) r+-- Just 10+-- ghci> freezeBranch (constrMB #_Right) r+-- Nothing+-- @+--+-- It uses OverloadedLabels, but requires an underscore before the+-- constructor name due to limitations in the extension.+--+-- One nice way to /use/ these is with 'withBranch_':+--+-- @+-- ghci> r <- 'thawRef' (Just 10)+-- ghci> 'withBranch_' (constrMB #_Just) $ \i -> -- @i@ is an Int ref+-- .. modifyRef i (+ 1)+-- ghci> 'freezeRef' r+-- Just 11+-- @+--+-- @+-- ghci> r <- thawRef Nothing+-- ghci> withBranch_ (constrMB #_Just) $ \i -> -- @i@ is an Int ref+-- .. modifyRef i (+ 1)+-- ghci> freezeRef r+-- Nothing+-- @+--+-- Perhaps the most useful usage of this abstraction is for recursive data+-- types.+--+-- @+-- data List a = Nil | Cons a (List a)+-- deriving Generic+--+-- instance Mutable m a => 'Mutable' m (List a) where+-- type Ref m (List a) = 'GRef' m (List a)+-- @+--+-- @'GRef' m (List a)@ is now a mutable linked list! Once we make the+-- 'MutBranch' for the nil and cons cases:+--+-- @+-- nilBranch :: MutBranch m (List a) ()+-- nilBranch = constrMB #_Nil+-- +-- consBranch :: MutBranch m (List a) (a, List a)+-- consBranch = constrMB #_Cons+-- @+--+--+-- Here is a function to check if a linked list is currently empty:+--+-- @+-- isEmpty+-- :: (PrimMonad m, Mutable m a)+-- => Ref m (List a)+-- -> m Bool+-- isEmpty = hasBranch nilBranch+-- @+--+-- Here is one to "pop" a mutable linked list, giving us the first value+-- and shifting the rest of the list up.+--+-- @+-- popStack+-- :: (PrimMonad m, Mutable m a)+-- => Ref m (List a)+-- -> m (Maybe a)+-- popStack r = do+-- c <- projectBranch consBranch r+-- case c of+-- Nothing -> pure Nothing+-- Just (x, xs) -> do+-- moveRef r xs+-- Just <$> freezeRef x+-- @+--+-- And here is a function to concatenate a second linked list to the end of a+-- first one.+--+-- @+-- concatLists+-- :: (PrimMonad m, Mutable m a)+-- => Ref m (List a)+-- -> Ref m (List a)+-- -> m ()+-- concatLists l1 l2 = do+-- c <- projectBranch consBranch l1+-- case c of+-- Nothing -> moveRef l1 l2+-- Just (_, xs) -> concatLists xs l2+-- @+data MutBranch m s a = MutBranch+ { -- | With a 'MutBranch', attempt to get the mutable contents of+ -- a branch of a mutable+ -- @s@, if possible.+ --+ -- @+ -- ghci> r <- thawRef (Left 10)+ -- ghci> s <- cloneBranch (constrMB #_Left)+ -- ghci> case s of Just s' -> freezeRef s'+ -- 10+ -- @+ --+ -- @+ -- ghci> r <- thawRef (Right True)+ -- ghci> s <- cloneBranch (constrMB #_Left)+ -- ghci> case s of Nothing -> "it was Right"+ -- "it was Right"+ -- @+ projectBranch :: Ref m s -> m (Maybe (Ref m a))+ -- | Embed an @a@ ref as a part of a larger @s@ ref. Note that this+ -- /does not copy or clone/: any mutations to the @a@ ref will be+ -- reflected in the @s@ ref, as long as the @s@ ref maintains the+ -- reference.+ --+ -- @+ -- ghci> r <- thawRef 100+ -- ghci> s <- embedBranch (constMB #_Left) r+ -- ghci> freezeRef s+ -- Left 100+ -- ghci> modifyRef r (+ 1)+ -- ghci> freezeRef s+ -- Left 101+ -- @+ --+ -- Any mutations on @s@ (as long as they keep the same branch) will+ -- also affect @a@:+ --+ -- @+ -- ghci> copyRef s (Left 0)+ -- ghci> freezeRef r+ -- 0+ -- @+ --+ -- However, "switching branches" on an 'Either' ref will cause it to+ -- loose the original reference:+ --+ -- @+ -- ghci> copyRef s (Right True)+ -- ghci> copyRef s (Left 999)+ -- ghci> freezeRef r+ -- 0+ -- @+ , embedBranch :: Ref m a -> m (Ref m s)+ }++-- | Compose two 'MutBranch's, to drill down on what is being focused.+compMB :: Monad m => MutBranch m a b -> MutBranch m b c -> MutBranch m a c+compMB mb1 mb2 = MutBranch+ { projectBranch = projectBranch mb1 >=> \case+ Nothing -> pure Nothing+ Just s -> projectBranch mb2 s+ , embedBranch = embedBranch mb1 <=< embedBranch mb2+ }++-- | An identity 'MutBranch', treating the item itself as a whole branch.+-- 'cloneBranch' will always "match".+idMB :: Applicative m => MutBranch m a a+idMB = MutBranch (pure . Just) pure++-- | With a 'MutBranch', thaw an @a@ into a mutable @s@ on that branch.+--+-- @+-- ghci> r <- 'thawBranch' ('constrMB' #_Left) 10+-- ghci> 'freezeRef' r+-- Left 10+-- @+thawBranch+ :: Mutable m a+ => MutBranch m s a+ -> a+ -> m (Ref m s)+thawBranch mb = embedBranch mb <=< thawRef++-- | With a 'MutBranch', read out a specific @a@ branch of an @s@, if it exists.+--+-- @+-- ghci> r <- 'thawRef' (Left 10)+-- ghci> 'freezeBranch' ('constrMB' #_Left) r+-- Just 10+-- ghci> freezeBranch (constrMB #_Right) r+-- Nothing+-- @+freezeBranch+ :: Mutable m a+ => MutBranch m s a -- ^ How to check if is @s@ is an @a@+ -> Ref m s -- ^ Structure to read out of+ -> m (Maybe a)+freezeBranch mb = mapM freezeRef <=< projectBranch mb++-- | Check if an @s@ is currently a certain branch @a@.+hasBranch+ :: Mutable m a+ => MutBranch m s a+ -> Ref m s+ -> m Bool+hasBranch mb = fmap isJust . projectBranch mb++-- | Check if an @s@ is /not/ currently a certain branch @a@.+hasn'tBranch+ :: Mutable m a+ => MutBranch m s a+ -> Ref m s+ -> m Bool+hasn'tBranch mb = fmap isNothing . projectBranch mb++-- | With a 'MutBranch', /set/ @s@ to have the branch @a@.+--+-- @+-- ghci> r <- 'thawRef' (Left 10)+-- ghci> 'copyBranch' ('constrMB' #_Left) r 5678+-- ghci> 'freezeRef' r+-- Left 5678+-- ghci> copyBranch (constrMB #_Right) r True+-- ghci> freezeRef r+-- Right True+-- @+copyBranch+ :: (Mutable m s, Mutable m a)+ => MutBranch m s a -- ^ How to check if @s@ is an @a@+ -> Ref m s -- ^ Structure to write into+ -> a -- ^ Value to set @s@ to be+ -> m ()+copyBranch mb r = moveBranch mb r <=< thawRef++-- | With a 'MutBranch', overwrite an @s@ as an @a@, on that branch.+--+-- @+-- ghci> r <- thawRef (Left 10)+-- ghci> s <- thawRef 100+-- ghci> moveBranch (constrMB #_Left) r s+-- ghci> freezeRef r+-- Left 100+-- ghci> t <- thawRef True+-- ghci> moveBranch (constrMB #_Right) r t+-- ghci> freezeRef r+-- Right True+-- @+moveBranch+ :: Mutable m s+ => MutBranch m s a+ -> Ref m s+ -> Ref m a+ -> m ()+moveBranch mb r = moveRef r <=< embedBranch mb++-- | With a 'MutBranch', attempt to clone out a branch of a mutable+-- @s@, if possible.+--+-- @+-- ghci> r <- thawRef (Left 10)+-- ghci> s <- cloneBranch (constrMB #_Left)+-- ghci> case s of Just s' -> freezeRef s'+-- 10+-- @+--+-- @+-- ghci> r <- thawRef (Right True)+-- ghci> s <- cloneBranch (constrMB #_Left)+-- ghci> case s of Nothing -> "it was Right"+-- "it was Right"+-- @+cloneBranch+ :: Mutable m a+ => MutBranch m s a -- ^ How to check if @s@ is an @a@+ -> Ref m s -- ^ Structure to read out of+ -> m (Maybe (Ref m a))+cloneBranch mb = mapM cloneRef <=< projectBranch mb++-- | A non-copying version of 'freezeBranch' that can be more efficient+-- for types where the mutable representation is the same as the immutable+-- one (like 'V.Vector').+--+-- This is safe as long as you never again modify the mutable+-- reference, since it can potentially directly mutate the frozen value+-- magically.+unsafeFreezeBranch+ :: Mutable m a+ => MutBranch m s a -- ^ How to check if is @s@ is an @a@+ -> Ref m s -- ^ Structure to read out of+ -> m (Maybe a)+unsafeFreezeBranch mb = mapM unsafeFreezeRef <=< projectBranch mb++-- | A non-copying version of 'thawBranch' that can be more efficient for+-- types where the mutable representation is the same as the immutable one+-- (like 'V.Vector').+--+-- This is safe as long as you never again use the original pure value,+-- since it can potentially directly mutate it.+unsafeThawBranch+ :: Mutable m a+ => MutBranch m s a+ -> a+ -> m (Ref m s)+unsafeThawBranch mb = embedBranch mb <=< unsafeThawRef+++-- | With a 'MutBranch', if an @s@ is on the @a@ branch, perform an action+-- on the @a@ reference and overwrite the @s@ with the modified @a@.+-- Returns the result of the action, if @a@ was found.+--+-- @+-- ghci> r <- 'thawRef' (Just 10)+-- ghci> 'withBranch_' ('constrMB' #_Just) $ \i -> -- @i@ is an Int ref+-- .. 'modifyRef' i (+ 1)+-- ghci> 'freezeRef' r+-- Just 11+-- @+--+-- @+-- ghci> r <- thawRef Nothing+-- ghci> withBranch_ (constrMB #_Just) $ \i -> -- @i@ is an Int ref+-- .. modifyRef i (+ 1)+-- ghci> freezeRef r+-- Nothing+-- @+withBranch+ :: Mutable m a+ => MutBranch m s a -- ^ How to check if is @s@ is an @a@+ -> Ref m s -- ^ Structure to read out of and write into+ -> (Ref m a -> m b) -- ^ Action to perform on the @a@ branch of @s@+ -> m (Maybe b)+withBranch mb r f = mapM f =<< projectBranch mb r++-- | 'withBranch', but discarding the returned value.+withBranch_+ :: Mutable m a+ => MutBranch m s a -- ^ How to check if is @s@ is an @a@+ -> Ref m s -- ^ Structure to read out of and write into+ -> (Ref m a -> m b) -- ^ Action to perform on the @a@ branch of @s@+ -> m ()+withBranch_ mb r = void . withBranch mb r++-- | With a 'MutBranch', run a pure function over a potential branch @a@ of+-- @s@. If @s@ is not on that branch, leaves @s@ unchanged.+--+-- @+-- ghci> r <- 'thawRef' (Just 10)+-- ghci> 'modifyBranch' ('constrMB' #_Just) r (+ 1)+-- ghci> freezeRef r+-- Just 11+-- @+--+-- @+-- ghci> r <- thawRef Nothing+-- ghci> modifyBranch (constrMB #_Just) r (+ 1)+-- ghci> freezeRef r+-- Nothing+-- @+modifyBranch+ :: Mutable m a+ => MutBranch m s a -- ^ How to check if @s@ is an @a@+ -> Ref m s -- ^ Structure to read out of and write into+ -> (a -> a) -- ^ Pure function modifying @a@+ -> m ()+modifyBranch mb r f = withBranch_ mb r (`modifyRef` f)++-- | 'modifyBranch', but forces the result before storing it back in the+-- reference.+modifyBranch'+ :: Mutable m a+ => MutBranch m s a -- ^ How to check if @s@ is an @a@+ -> Ref m s -- ^ Structure to read out of and write into+ -> (a -> a) -- ^ Pure function modifying @a@+ -> m ()+modifyBranch' mb r f = withBranch_ mb r (`modifyRef'` f)++-- | 'modifyBranch' but for a monadic function. Uses 'copyRef' into the+-- reference after the action is completed.+modifyBranchM+ :: Mutable m a+ => MutBranch m s a -- ^ How to check if @s@ is an @a@+ -> Ref m s -- ^ Structure to read out of and write into+ -> (a -> m a) -- ^ Monadic function modifying @a@+ -> m ()+modifyBranchM mb r f = withBranch_ mb r (`modifyRefM` f)++-- | 'modifyBranchM', but forces the result before storing it back in the+-- reference.+modifyBranchM'+ :: Mutable m a+ => MutBranch m s a -- ^ How to check if @s@ is an @a@+ -> Ref m s -- ^ Structure to read out of and write into+ -> (a -> m a) -- ^ Monadic function modifying @a@+ -> m ()+modifyBranchM' mb r f = withBranch_ mb r (`modifyRefM'` f)++-- | With a 'MutBranch', run a pure function over a potential branch @a@ of+-- @s@. The function returns the updated @a@ and also an output value to+-- observe. If @s@ is not on that branch, leaves @s@ unchanged.+--+-- @+-- ghci> r <- 'thawRef' (Just 10)+-- ghci> 'updateBranch' ('constrMB' #_Just) r $ \i -> (i + 1, show i)+-- Just "10"+-- ghci> 'freezeRef' r+-- Just 11+-- @+--+-- @+-- ghci> r <- thawRef Nothing+-- ghci> updateBranch (constrMB #_Just) r $ \i -> (i + 1, show i)+-- Nothing+-- ghci> freezeRef r+-- Nothing+-- @+updateBranch+ :: Mutable m a+ => MutBranch m s a -- ^ How to check if @s@ is an @a@+ -> Ref m s -- ^ Structure to read out of and write into+ -> (a -> (a, b))+ -> m (Maybe b)+updateBranch mb r f = withBranch mb r (`updateRef` f)++-- | 'updateBranch', but forces the result before storing it back in the+-- reference.+updateBranch'+ :: Mutable m a+ => MutBranch m s a -- ^ How to check if @s@ is an @a@+ -> Ref m s -- ^ Structure to read out of and write into+ -> (a -> (a, b))+ -> m (Maybe b)+updateBranch' mb r f = withBranch mb r (`updateRef'` f)++-- | 'updateBranch' but for a monadic function. Uses 'copyRef' into the+-- reference after the action is completed.+updateBranchM+ :: Mutable m a+ => MutBranch m s a -- ^ How to check if @s@ is an @a@+ -> Ref m s -- ^ Structure to read out of and write into+ -> (a -> m (a, b))+ -> m (Maybe b)+updateBranchM mb r f = withBranch mb r (`updateRefM` f)++-- | 'updateBranchM', but forces the result before storing it back in the+-- reference.+updateBranchM'+ :: Mutable m a+ => MutBranch m s a -- ^ How to check if @s@ is an @a@+ -> Ref m s -- ^ Structure to read out of and write into+ -> (a -> m (a, b))+ -> m (Maybe b)+updateBranchM' mb r f = withBranch mb r (`updateRefM'` f)++++-- | A version of 'Data.Vinyl.Derived.Label' that removes an underscore at+-- the beginning when used with -XOverloadedLabels. Used to specify+-- constructors, since labels are currently not able to start with capital+-- letters.+data CLabel (ctor :: Symbol) = CLabel++instance (ctor_ ~ AppendSymbol "_" ctor) => IsLabel ctor_ (CLabel ctor) where+ fromLabel = CLabel++++-- | Typeclass powering 'constrMB' using GHC Generics.+--+-- Heavily inspired by "Data.Generics.Sum.Constructors".+class (GMutable m f, Mutable m a) => GMutBranchConstructor (ctor :: Symbol) m f a | ctor f -> a where+ gmbcProj :: CLabel ctor -> GRef_ m f x -> m (Maybe (Ref m a))+ gmbcEmbed :: CLabel ctor -> Ref m a -> m (GRef_ m f x)++instance+ ( GMutable m f+ , Mutable m a+ , GL.GIsList (GRef_ m f) (GRef_ m f) (MapRef m as) (MapRef m as)+ , GL.GIsList f f as as+ , GL.ListTuple a as+ , GL.ListTuple b (MapRef m as)+ , Ref m a ~ b+ )+ => GMutBranchConstructor ctor m (M1 C ('MetaCons ctor fixity fields) f) a where+ gmbcProj _ = pure . Just . GL.listToTuple . GLP.view GL.glist . unM1+ gmbcEmbed _ = pure . M1 . GLP.view GL.glistR . GL.tupleToList++instance GMutBranchConstructor ctor m f a => GMutBranchConstructor ctor m (M1 D meta f) a where+ gmbcProj lb = gmbcProj lb . unM1+ gmbcEmbed lb = fmap M1 . gmbcEmbed lb++instance+ ( PrimMonad m+ , Mutable m a+ , GMutBranchSum ctor (GL.HasCtorP ctor l) m l r a+ )+ => GMutBranchConstructor ctor m (l :+: r) a where+ gmbcProj = gmbsProj @ctor @(GL.HasCtorP ctor l)+ gmbcEmbed = gmbsEmbed @ctor @(GL.HasCtorP ctor l)++class (GMutable m l, GMutable m r, Mutable m a) => GMutBranchSum (ctor :: Symbol) (contains :: Bool) m l r a | ctor l r -> a where+ gmbsProj :: CLabel ctor -> MutSumF m (GRef_ m l) (GRef_ m r) x -> m (Maybe (Ref m a))+ gmbsEmbed :: CLabel ctor -> Ref m a -> m (MutSumF m (GRef_ m l) (GRef_ m r) x)++instance+ ( PrimMonad m+ , GMutable m r+ , GMutBranchConstructor ctor m l a+ , GL.GIsList (GRef_ m l) (GRef_ m l) (MapRef m as) (MapRef m as)+ , GL.GIsList l l as as+ , GL.ListTuple a as+ , GL.ListTuple b (MapRef m as)+ , Ref m a ~ b+ )+ => GMutBranchSum ctor 'True m l r a where+ gmbsProj lb (MutSumF r) = readMutVar r >>= \case+ L1 x -> gmbcProj lb x+ R1 _ -> pure Nothing+ gmbsEmbed _ = fmap MutSumF . newMutVar . L1 . GLP.view GL.glistR . GL.tupleToList++instance+ ( PrimMonad m+ , GMutable m l+ , GMutBranchConstructor ctor m r a+ , GL.GIsList (GRef_ m r) (GRef_ m r) (MapRef m as) (MapRef m as)+ , GL.GIsList r r as as+ , GL.ListTuple a as+ , GL.ListTuple b (MapRef m as)+ , Ref m a ~ b+ )+ => GMutBranchSum ctor 'False m l r a where+ gmbsProj lb (MutSumF r) = readMutVar r >>= \case+ L1 _ -> pure Nothing+ R1 x -> gmbcProj lb x+ gmbsEmbed _ = fmap MutSumF . newMutVar . R1 . GLP.view GL.glistR . GL.tupleToList++-- | Create a 'MutBranch' for any data type with a 'Generic' instance by+-- specifying the constructor name using OverloadedLabels+--+-- @+-- ghci> r <- 'thawRef' (Left 10)+-- ghci> 'freezeBranch' ('constrMB' #_Left) r+-- Just 10+-- ghci> freezeBranch (constrMB #_Right) r+-- Nothing+-- @+--+-- Note that due to limitations in OverloadedLabels, you must prefix the+-- constructor name with an undescore.+--+-- There also isn't currently any way to utilize OverloadedLabels with+-- operator identifiers, so using it with operator constructors (like @:@+-- and @[]@) requires explicit TypeApplications:+--+-- @+-- -- | 'MutBranch' focusing on the cons case of a list+-- consMB :: (PrimMonad m, Mutable m a) => MutBranch m [a] (a, [a])+-- consMB = 'constrMB' ('CLabel' @":")+-- @+constrMB+ :: forall ctor m s a.+ ( Ref m s ~ GRef m s+ , GMutBranchConstructor ctor m (Rep s) a+ )+ => CLabel ctor+ -> MutBranch m s a+constrMB l = MutBranch+ { projectBranch = gmbcProj l . unGRef+ , embedBranch = fmap GRef . gmbcEmbed l+ }++-- | 'MutBranch' focusing on the nil case of a list+nilMB :: (PrimMonad m, Mutable m a) => MutBranch m [a] ()+nilMB = constrMB (CLabel @"[]")++-- | 'MutBranch' focusing on the cons case of a list+consMB :: (PrimMonad m, Mutable m a) => MutBranch m [a] (a, [a])+consMB = constrMB (CLabel @":")++-- | 'MutBranch' focusing on the 'Nothing' case of a 'Maybe'+nothingMB :: (PrimMonad m, Mutable m a) => MutBranch m (Maybe a) ()+nothingMB = constrMB #_Nothing++-- | 'MutBranch' focusing on the 'Just' case of a 'Maybe'+justMB :: (PrimMonad m, Mutable m a) => MutBranch m (Maybe a) a+justMB = constrMB #_Just++-- | 'MutBranch' focusing on the 'Left' case of an 'Either'+leftMB :: (PrimMonad m, Mutable m a, Mutable m b) => MutBranch m (Either a b) a+leftMB = constrMB #_Left++-- | 'MutBranch' focusing on the 'Right' case of an 'Either'+rightMB :: (PrimMonad m, Mutable m a, Mutable m b) => MutBranch m (Either a b) b+rightMB = constrMB #_Right
+ src/Data/Mutable/Class.hs view
@@ -0,0 +1,356 @@+{-# 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 v f = copyRef v . f =<< freezeRef 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' v f = (copyRef v $!) . f =<< freezeRef 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 v f = copyRef v =<< f =<< freezeRef 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' v f = (copyRef v $!) =<< f =<< freezeRef 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 v f = do+ (x, y) <- f <$> freezeRef v+ copyRef v x+ return 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' v f = do+ (x, y) <- f <$> freezeRef v+ x `seq` copyRef v x+ return 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 v f = do+ (x, y) <- f =<< freezeRef v+ copyRef v x+ return 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' v f = do+ (x, y) <- f =<< freezeRef v+ x `seq` copyRef v x+ return 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 r v = moveRef r =<< thawRef 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 r v = copyRef r =<< freezeRef 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 = thawRef <=< 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 { getVarMut :: a }++-- | Use a @'VarMut' a@ as if it were an @a@.+instance X.IsoHKD VarMut a where+ type HKD VarMut a = a+ unHKD = VarMut+ toHKD = 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 { getTraverseMut :: f a }+ deriving (Show, Eq, Ord, Generic, Functor, Foldable, 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 = TraverseMut+ toHKD = 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 { 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 = CoerceMut+ toHKD = 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 { getImmutable :: a }++-- | Use an @'Immutable' a@ as if it were an @a@+instance X.IsoHKD Immutable a where+ type HKD Immutable a = a+ unHKD = Immutable+ toHKD = 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 { 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 x) = runRMT rmt $ ReMutable <$> thawRef @m @a x+ where+ rmt = reflect (Proxy @s)+ freezeRef (ReMutable v) = runRMT rmt $ ReMutable <$> freezeRef @m @a v+ where+ rmt = reflect (Proxy @s)+ copyRef (ReMutable x) (ReMutable v) = runRMT rmt $ copyRef @m @a x v+ where+ rmt = reflect (Proxy @s)+ moveRef (ReMutable x) (ReMutable v) = runRMT rmt $ moveRef @m @a x v+ where+ rmt = reflect (Proxy @s)+ cloneRef (ReMutable x) = runRMT rmt $ ReMutable <$> cloneRef @m @a x+ where+ rmt = reflect (Proxy @s)+ unsafeThawRef (ReMutable x) = runRMT rmt $ ReMutable <$> unsafeThawRef @m @a x+ where+ rmt = reflect (Proxy @s)+ unsafeFreezeRef (ReMutable v) = runRMT rmt $ ReMutable <$> unsafeFreezeRef @m @a v+ where+ rmt = reflect (Proxy @s)++unsafeReMutable :: forall s m n a. Mutable n (ReMutable s m a) :- Mutable n a+unsafeReMutable = 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 f x = x \\ reMutableConstraint @m @n @a 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 f = reify (RMT f) $ \(Proxy :: Proxy s) ->+ case unsafeReMutable @s @m @n @a of+ Sub Data.Constraint.Dict -> Sub Data.Constraint.Dict++
+ src/Data/Mutable/Instances.hs view
@@ -0,0 +1,476 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module : Data.Mutable.Instances+-- Copyright : (c) Justin Le 2020+-- License : BSD3+--+-- Maintainer : justin@jle.im+-- Stability : experimental+-- Portability : non-portable+--+-- Provides 'Ref' instances for various data types, as well as automatic+-- derivation of instances. See "Data.Mutable" for more information.+module Data.Mutable.Instances (+ RecRef(..)+ , HListRef(..)+ -- * Generic+ , GRef(..)+ , gThawRef, gFreezeRef+ , gCopyRef, gMoveRef, gCloneRef+ , gUnsafeThawRef, gUnsafeFreezeRef+ , GMutable (GRef_)+ -- * Higher-Kinded Data Pattern+ , thawHKD, freezeHKD+ , copyHKD, moveHKD, cloneHKD+ , unsafeThawHKD, unsafeFreezeHKD+ -- * Coercible+ , CoerceRef(..)+ , thawCoerce, freezeCoerce+ , copyCoerce, moveCoerce, cloneCoerce+ , unsafeThawCoerce, unsafeFreezeCoerce+ -- * Traversable+ , TraverseRef(..)+ , thawTraverse, freezeTraverse+ , copyTraverse, moveTraverse, cloneTraverse+ , unsafeThawTraverse, unsafeFreezeTraverse+ -- * Immutable+ , ImmutableRef(..), thawImmutable, freezeImmutable, copyImmutable+ -- * Instances for Generics combinators themselves+ , GMutableRef(..)+ , MutSumF(..)+ -- * Utility+ , MapRef+ ) where++import Control.Applicative+import Control.Monad.Primitive+import Data.Complex+import Data.Functor.Compose+import Data.Functor.Identity+import Data.Functor.Product+import Data.Functor.Sum+import Data.GenericLens.Internal (HList(..))+import Data.Kind+import Data.Mutable.Internal+import Data.Ord+import Data.Primitive.Array+import Data.Primitive.ByteArray+import Data.Primitive.PrimArray+import Data.Primitive.SmallArray+import Data.Primitive.Types+import Data.Ratio+import Data.Vinyl as V hiding (HList)+import Data.Void+import Data.Word+import Foreign.C.Types+import Foreign.Storable+import Numeric.Natural+import qualified Data.Monoid as M+import qualified Data.Vector as V+import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Generic.Mutable as MVG+import qualified Data.Vector.Mutable as MV+import qualified Data.Vector.Primitive as VP+import qualified Data.Vector.Primitive.Mutable as MVP+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Storable.Mutable as MVS+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Unboxed.Mutable as MVU+import qualified Data.Vinyl.ARec as V+import qualified Data.Vinyl.Functor as V+import qualified Data.Vinyl.TypeLevel as V++instance PrimMonad m => Mutable m Int+instance PrimMonad m => Mutable m Integer+instance PrimMonad m => Mutable m Natural+instance PrimMonad m => Mutable m (Ratio a)+instance PrimMonad m => Mutable m Float+instance PrimMonad m => Mutable m Double+instance PrimMonad m => Mutable m (Complex a)+instance PrimMonad m => Mutable m Bool+instance PrimMonad m => Mutable m Char++instance PrimMonad m => Mutable m Word+instance PrimMonad m => Mutable m Word8+instance PrimMonad m => Mutable m Word16+instance PrimMonad m => Mutable m Word64++instance PrimMonad m => Mutable m CChar+instance PrimMonad m => Mutable m CSChar+instance PrimMonad m => Mutable m CUChar+instance PrimMonad m => Mutable m CShort+instance PrimMonad m => Mutable m CUShort+instance PrimMonad m => Mutable m CInt+instance PrimMonad m => Mutable m CUInt+instance PrimMonad m => Mutable m CLong+instance PrimMonad m => Mutable m CULong+instance PrimMonad m => Mutable m CPtrdiff+instance PrimMonad m => Mutable m CSize+instance PrimMonad m => Mutable m CWchar+instance PrimMonad m => Mutable m CSigAtomic+instance PrimMonad m => Mutable m CLLong+instance PrimMonad m => Mutable m CULLong+instance PrimMonad m => Mutable m CBool+instance PrimMonad m => Mutable m CIntPtr+instance PrimMonad m => Mutable m CUIntPtr+instance PrimMonad m => Mutable m CIntMax+instance PrimMonad m => Mutable m CUIntMax+instance PrimMonad m => Mutable m CClock+instance PrimMonad m => Mutable m CTime+instance PrimMonad m => Mutable m CUSeconds+instance PrimMonad m => Mutable m CSUSeconds+instance PrimMonad m => Mutable m CFloat+instance PrimMonad m => Mutable m CDouble++instance Mutable m a => Mutable m (Identity a) where+ type Ref m (Identity a) = CoerceRef m (Identity a) a++instance Mutable m a => Mutable m (Const a b) where+ type Ref m (Const a b) = CoerceRef m (Const a b) a++instance Mutable m a => Mutable m (V.Const a b) where+ type Ref m (V.Const a b) = CoerceRef m (V.Const a b) a++instance Mutable m a => Mutable m (M.Product a) where+ type Ref m (M.Product a) = CoerceRef m (M.Product a) a++instance Mutable m a => Mutable m (M.Sum a) where+ type Ref m (M.Sum a) = CoerceRef m (M.Sum a) a++instance Mutable m a => Mutable m (Down a) where+ type Ref m (Down a) = CoerceRef m (Down a) a++instance Mutable m a => Mutable m (M.Dual a) where+ type Ref m (M.Dual a) = CoerceRef m (M.Dual a) a++instance (Mutable m a, PrimMonad m) => Mutable m (Maybe a) where+ type Ref m (Maybe a) = GRef m (Maybe a)++instance (Mutable m a, Mutable m b, PrimMonad m) => Mutable m (Either a b) where+ type Ref m (Either a b) = GRef m (Either a b)++instance (Mutable m (f a), Mutable m (g a)) => Mutable m (Product f g a) where+ type Ref m (Product f g a) = GRef m (Product f g a)++instance (Mutable m (f a), Mutable m (g a), PrimMonad m) => Mutable m (Sum f g a) where+ type Ref m (Sum f g a) = GRef m (Sum f g a)++instance (Mutable m (f (g a))) => Mutable m (Compose f g a) where+ type Ref m (Compose f g a) = CoerceRef m (Compose f g a) (f (g a))++-- | Mutable linked list with mutable references in each cell. See+-- 'Data.Mutable.MutBranch' documentation for an example of using this as+-- a mutable linked list.l+instance (PrimMonad m, Mutable m a) => Mutable m [a] where+ type Ref m [a] = GRef m [a]++-- | Meant for usage with higher-kinded data pattern (See 'X.HKD')+instance Mutable m a => Mutable m (V.Identity a) where+ type Ref m (V.Identity a) = RefFor m a+ thawRef (V.Identity x) = RefFor <$> thawRef x+ freezeRef (RefFor r) = V.Identity <$> freezeRef r+ copyRef (RefFor r) (V.Identity x) = copyRef r x+ moveRef (RefFor r) (RefFor v) = moveRef r v+ cloneRef = fmap RefFor . cloneRef . getRefFor+ unsafeThawRef (V.Identity x) = RefFor <$> unsafeThawRef x+ unsafeFreezeRef (RefFor r) = V.Identity <$> unsafeFreezeRef r++-- | Mutable reference is 'MV.MVector'.+instance PrimMonad m => Mutable m (V.Vector a) where+ type Ref m (V.Vector a) = MV.MVector (PrimState m) a+ thawRef = VG.thaw+ freezeRef = VG.freeze+ copyRef = VG.copy+ moveRef = MVG.move+ cloneRef = MVG.clone+ unsafeThawRef = VG.unsafeThaw+ unsafeFreezeRef = VG.unsafeFreeze++-- | Mutable reference is 'MVS.MVector'.+instance (PrimMonad m, Storable a) => Mutable m (VS.Vector a) where+ type Ref m (VS.Vector a) = MVS.MVector (PrimState m) a+ thawRef = VG.thaw+ freezeRef = VG.freeze+ copyRef = VG.copy+ moveRef = MVG.move+ cloneRef = MVG.clone+ unsafeThawRef = VG.unsafeThaw+ unsafeFreezeRef = VG.unsafeFreeze++-- | Mutable reference is 'MVU.MVector'.+instance (PrimMonad m, VU.Unbox a) => Mutable m (VU.Vector a) where+ type Ref m (VU.Vector a) = MVU.MVector (PrimState m) a+ thawRef = VG.thaw+ freezeRef = VG.freeze+ copyRef = VG.copy+ moveRef = MVG.move+ cloneRef = MVG.clone+ unsafeThawRef = VG.unsafeThaw+ unsafeFreezeRef = VG.unsafeFreeze++-- | Mutable reference is 'MVP.MVector'.+instance (PrimMonad m, Prim a) => Mutable m (VP.Vector a) where+ type Ref m (VP.Vector a) = MVP.MVector (PrimState m) a+ thawRef = VG.thaw+ freezeRef = VG.freeze+ copyRef = VG.copy+ moveRef = MVG.move+ cloneRef = MVG.clone+ unsafeThawRef = VG.unsafeThaw+ unsafeFreezeRef = VG.unsafeFreeze++instance PrimMonad m => Mutable m (Array a) where+ type Ref m (Array a) = MutableArray (PrimState m) a++ thawRef xs = thawArray xs 0 (sizeofArray xs)+ freezeRef rs = freezeArray rs 0 (sizeofMutableArray rs)+ copyRef rs xs = copyArray rs 0 xs 0 l+ where+ l = sizeofArray xs `min` sizeofMutableArray rs+ moveRef rs vs = copyMutableArray rs 0 vs 0 l+ where+ l = sizeofMutableArray vs `min` sizeofMutableArray rs+ cloneRef rs = cloneMutableArray rs 0 (sizeofMutableArray rs)+ unsafeThawRef = unsafeThawArray+ unsafeFreezeRef = unsafeFreezeArray++instance PrimMonad m => Mutable m (SmallArray a) where+ type Ref m (SmallArray a) = SmallMutableArray (PrimState m) a++ thawRef xs = thawSmallArray xs 0 (sizeofSmallArray xs)+ freezeRef rs = freezeSmallArray rs 0 (sizeofSmallMutableArray rs)+ copyRef rs xs = copySmallArray rs 0 xs 0 l+ where+ l = sizeofSmallArray xs `min` sizeofSmallMutableArray rs+ moveRef rs vs = copySmallMutableArray rs 0 vs 0 l+ where+ l = sizeofSmallMutableArray vs `min` sizeofSmallMutableArray rs+ cloneRef rs = cloneSmallMutableArray rs 0 (sizeofSmallMutableArray rs)+ unsafeThawRef = unsafeThawSmallArray+ unsafeFreezeRef = unsafeFreezeSmallArray++instance PrimMonad m => Mutable m ByteArray where+ type Ref m ByteArray = MutableByteArray (PrimState m)++ thawRef xs = do+ rs <- newByteArray (sizeofByteArray xs)+ copyByteArray rs 0 xs 0 (sizeofByteArray xs)+ pure rs+ freezeRef rs = do+ xs <- newByteArray (sizeofMutableByteArray rs)+ copyMutableByteArray xs 0 rs 0 (sizeofMutableByteArray rs)+ unsafeFreezeByteArray xs+ copyRef rs xs = copyByteArray rs 0 xs 0 l+ where+ l = sizeofByteArray xs `min` sizeofMutableByteArray rs+ moveRef rs vs = copyMutableByteArray rs 0 vs 0 l+ where+ l = sizeofMutableByteArray vs `min` sizeofMutableByteArray rs+ cloneRef rs = do+ vs <- newByteArray (sizeofMutableByteArray rs)+ copyMutableByteArray vs 0 rs 0 (sizeofMutableByteArray rs)+ pure vs+ unsafeThawRef = unsafeThawByteArray+ unsafeFreezeRef = unsafeFreezeByteArray++instance (PrimMonad m, Prim a) => Mutable m (PrimArray a) where+ type Ref m (PrimArray a) = MutablePrimArray (PrimState m) a++ thawRef xs = do+ rs <- newPrimArray (sizeofPrimArray xs)+ copyPrimArray rs 0 xs 0 (sizeofPrimArray xs)+ pure rs+ freezeRef rs = do+ xs <- newPrimArray (sizeofMutablePrimArray rs)+ copyMutablePrimArray xs 0 rs 0 (sizeofMutablePrimArray rs)+ unsafeFreezePrimArray xs+ copyRef rs xs = copyPrimArray rs 0 xs 0 l+ where+ l = sizeofPrimArray xs `min` sizeofMutablePrimArray rs+ moveRef rs vs = copyMutablePrimArray rs 0 vs 0 l+ where+ l = sizeofMutablePrimArray vs `min` sizeofMutablePrimArray rs+ cloneRef rs = do+ vs <- newPrimArray (sizeofMutablePrimArray rs)+ copyMutablePrimArray vs 0 rs 0 (sizeofMutablePrimArray rs)+ pure vs+ unsafeThawRef = unsafeThawPrimArray+ unsafeFreezeRef = unsafeFreezePrimArray+++ ++instance Monad m => Mutable m Void where+ type Ref m Void = Void+ thawRef = \case {}+ freezeRef = \case {}+ copyRef = \case {}+ moveRef = \case {}+ cloneRef = \case {}+ unsafeThawRef = \case {}+ unsafeFreezeRef = \case {}++instance Monad m => Mutable m () where+ type Ref m () = ()+ thawRef _ = pure ()+ freezeRef _ = pure ()+ copyRef _ _ = pure ()+ moveRef _ _ = pure ()+ cloneRef _ = pure ()+ unsafeThawRef _ = pure ()+ unsafeFreezeRef _ = pure ()++-- | A 'Ref' of a tuple is a tuple of 'Ref's, for easy accessing.+--+-- @+-- Ref m (Int, 'V.Vector' Double) = ('Data.Primitive.MutVar.MutVar' s Int, 'MV.MVector' s Double)+-- @+instance (Monad m, Mutable m a, Mutable m b) => Mutable m (a, b) where+ type Ref m (a, b) = (Ref m a, Ref m b)+ thawRef (!x, !y) = (,) <$> thawRef x <*> thawRef y+ freezeRef (u , v ) = (,) <$> freezeRef u <*> freezeRef v+ copyRef (u , v ) (!x, !y) = copyRef u x *> copyRef v y+ moveRef (u , v ) ( x, y) = moveRef u x *> moveRef v y+ cloneRef (x , y ) = (,) <$> cloneRef x <*> cloneRef y+ unsafeThawRef (!x, !y) = (,) <$> unsafeThawRef x <*> unsafeThawRef y+ unsafeFreezeRef (u , v ) = (,) <$> unsafeFreezeRef u <*> unsafeFreezeRef v++-- | A 'Ref' of a tuple is a tuple of 'Ref's, for easy accessing.+instance (Monad m, Mutable m a, Mutable m b, Mutable m c) => Mutable m (a, b, c) where+ type Ref m (a, b, c) = (Ref m a, Ref m b, Ref m c)+ thawRef (!x, !y, !z) = (,,) <$> thawRef x <*> thawRef y <*> thawRef z+ freezeRef (u , v , w ) = (,,) <$> freezeRef u <*> freezeRef v <*> freezeRef w+ copyRef (u , v , w ) (!x, !y, !z) = copyRef u x *> copyRef v y *> copyRef w z+ moveRef (u , v , w ) ( x, y, z) = moveRef u x *> moveRef v y *> moveRef w z+ cloneRef (x , y , z ) = (,,) <$> cloneRef x <*> cloneRef y <*> cloneRef z+ unsafeThawRef (!x, !y, !z) = (,,) <$> unsafeThawRef x <*> unsafeThawRef y <*> unsafeThawRef z+ unsafeFreezeRef (u , v , w ) = (,,) <$> unsafeFreezeRef u <*> unsafeFreezeRef v <*> unsafeFreezeRef w++-- | A 'Ref' of a tuple is a tuple of 'Ref's, for easy accessing.+instance (Monad m, Mutable m a, Mutable m b, Mutable m c, Mutable m d) => Mutable m (a, b, c, d) where+ type Ref m (a, b, c, d) = (Ref m a, Ref m b, Ref m c, Ref m d)+ thawRef (!x, !y, !z, !a) = (,,,) <$> thawRef x <*> thawRef y <*> thawRef z <*> thawRef a+ freezeRef (u , v , w , j ) = (,,,) <$> freezeRef u <*> freezeRef v <*> freezeRef w <*> freezeRef j+ copyRef (u , v , w , j ) (!x, !y, !z, !a) = copyRef u x *> copyRef v y *> copyRef w z *> copyRef j a+ moveRef (u , v , w , j ) ( x, y, z, a) = moveRef u x *> moveRef v y *> moveRef w z *> moveRef j a+ cloneRef (x , y , z , a ) = (,,,) <$> cloneRef x <*> cloneRef y <*> cloneRef z <*> cloneRef a+ unsafeThawRef (!x, !y, !z, !a) = (,,,) <$> unsafeThawRef x <*> unsafeThawRef y <*> unsafeThawRef z <*> unsafeThawRef a+ unsafeFreezeRef (u , v , w , j ) = (,,,) <$> unsafeFreezeRef u <*> unsafeFreezeRef v <*> unsafeFreezeRef w <*> unsafeFreezeRef j++-- | A 'Ref' of a tuple is a tuple of 'Ref's, for easy accessing.+instance (Monad m, Mutable m a, Mutable m b, Mutable m c, Mutable m d, Mutable m e) => Mutable m (a, b, c, d, e) where+ type Ref m (a, b, c, d, e) = (Ref m a, Ref m b, Ref m c, Ref m d, Ref m e)+ thawRef (!x, !y, !z, !a, !b) = (,,,,) <$> thawRef x <*> thawRef y <*> thawRef z <*> thawRef a <*> thawRef b+ freezeRef (u , v , w , j , k ) = (,,,,) <$> freezeRef u <*> freezeRef v <*> freezeRef w <*> freezeRef j <*> freezeRef k+ copyRef (u , v , w , j , k ) (!x, !y, !z, !a, !b) = copyRef u x *> copyRef v y *> copyRef w z *> copyRef j a *> copyRef k b+ moveRef (u , v , w , j , k ) ( x, y, z, a, b) = moveRef u x *> moveRef v y *> moveRef w z *> moveRef j a *> moveRef k b+ cloneRef (x , y , z , a , b ) = (,,,,) <$> cloneRef x <*> cloneRef y <*> cloneRef z <*> cloneRef a <*> cloneRef b+ unsafeThawRef (!x, !y, !z, !a, !b) = (,,,,) <$> unsafeThawRef x <*> unsafeThawRef y <*> unsafeThawRef z <*> unsafeThawRef a <*> unsafeThawRef b+ unsafeFreezeRef (u , v , w , j , k ) = (,,,,) <$> unsafeFreezeRef u <*> unsafeFreezeRef v <*> unsafeFreezeRef w <*> unsafeFreezeRef j <*> unsafeFreezeRef k++-- | 'Ref' for components in a vinyl 'Rec'.+newtype RecRef m f a = RecRef { getRecRef :: Ref m (f a) }++deriving instance Eq (Ref m (f a)) => Eq (RecRef m f a)+deriving instance Ord (Ref m (f a)) => Ord (RecRef m f a)++instance Monad m => Mutable m (Rec f '[]) where+ type Ref m (Rec f '[]) = Rec (RecRef m f) '[]+ thawRef _ = pure RNil+ freezeRef _ = pure RNil+ copyRef _ _ = pure ()+ moveRef _ _ = pure ()+ cloneRef _ = pure RNil+ unsafeThawRef _ = pure RNil+ unsafeFreezeRef _ = pure RNil++instance (Monad m, Mutable m (f a), Mutable m (Rec f as), Ref m (Rec f as) ~ Rec (RecRef m f) as) => Mutable m (Rec f (a ': as)) where+ type Ref m (Rec f (a ': as)) = Rec (RecRef m f) (a ': as)+ thawRef = \case+ x :& xs -> (:&) <$> (RecRef <$> thawRef x) <*> thawRef xs+ freezeRef = \case+ RecRef v :& vs -> (:&) <$> freezeRef v <*> freezeRef vs+ copyRef = \case+ RecRef v :& vs -> \case+ x :& xs -> copyRef v x >> copyRef vs xs+ moveRef = \case+ RecRef v :& vs -> \case+ RecRef r :& rs ->+ moveRef v r >> moveRef vs rs+ cloneRef = \case+ RecRef v :& rs -> (:&) <$> (RecRef <$> cloneRef v) <*> cloneRef rs+ unsafeThawRef = \case+ x :& xs -> (:&) <$> (RecRef <$> unsafeThawRef x) <*> unsafeThawRef xs+ unsafeFreezeRef = \case+ RecRef v :& vs -> (:&) <$> unsafeFreezeRef v <*> unsafeFreezeRef vs+++instance (Monad m, RecApplicative as, V.NatToInt (V.RLength as), RPureConstrained (V.IndexableField as) as, Mutable m (Rec f as), Ref m (Rec f as) ~ Rec (RecRef m f) as) => Mutable m (ARec f as) where+ type Ref m (ARec f as) = ARec (RecRef m f) as++ thawRef = fmap toARec . thawRef . fromARec+ freezeRef = fmap toARec . freezeRef . fromARec+ copyRef r x = copyRef (fromARec r) (fromARec x)+ moveRef r v = moveRef (fromARec r) (fromARec v)+ cloneRef = fmap toARec . cloneRef . fromARec+ unsafeThawRef = fmap toARec . unsafeThawRef . fromARec+ unsafeFreezeRef = fmap toARec . unsafeFreezeRef . fromARec++-- | Useful type family to @'Ref' m@ over every item in a type-level list+--+-- @+-- ghci> :kind! MapRef IO '[Int, V.Vector Double]+-- '[ MutVar RealWorld Int, MVector RealWorld Double ]+-- @+type family MapRef m as where+ MapRef m '[] = '[]+ MapRef m (a ': as) = Ref m a ': MapRef m as++-- | The mutable reference of the 'HList' type from generic-lens.+data HListRef :: (Type -> Type) -> [Type] -> Type where+ NilRef :: HListRef m '[]+ (:!>) :: Ref m a -> HListRef m as -> HListRef m (a ': as)+infixr 5 :!>++instance Monad m => Mutable m (HList '[]) where+ type Ref m (HList '[]) = HListRef m '[]+ thawRef _ = pure NilRef+ freezeRef _ = pure Nil+ copyRef _ _ = pure ()+ moveRef _ _ = pure ()+ cloneRef _ = pure NilRef+ unsafeThawRef _ = pure NilRef+ unsafeFreezeRef _ = pure Nil++instance (Monad m, Mutable m a, Mutable m (HList as), Ref m (HList as) ~ HListRef m as) => Mutable m (HList (a ': as)) where+ type Ref m (HList (a ': as)) = HListRef m (a ': as)+ thawRef = \case+ x :> xs -> (:!>) <$> thawRef x <*> thawRef xs+ freezeRef = \case+ v :!> vs -> (:>) <$> freezeRef v <*> freezeRef vs+ copyRef = \case+ v :!> vs -> \case+ x :> xs -> copyRef v x >> copyRef vs xs+ moveRef = \case+ v :!> vs -> \case+ r :!> rs ->+ moveRef v r >> moveRef vs rs+ cloneRef = \case+ v :!> rs -> (:!>) <$> cloneRef v <*> cloneRef rs+ unsafeThawRef = \case+ x :> xs -> (:!>) <$> unsafeThawRef x <*> unsafeThawRef xs+ unsafeFreezeRef = \case+ v :!> vs -> (:>) <$> unsafeFreezeRef v <*> unsafeFreezeRef vs
+ src/Data/Mutable/Internal.hs view
@@ -0,0 +1,1244 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.Mutable.Internal (+ Mutable(..)+ , RefFor(..)+ , DefaultMutable(..)+ -- * Instances+ -- ** Generic+ , GRef(..)+ , gThawRef, gFreezeRef+ , gCopyRef, gMoveRef, gCloneRef+ , gUnsafeThawRef, gUnsafeFreezeRef+ , GMutable (GRef_)+ -- ** Higher-Kinded Data Pattern+ , thawHKD, freezeHKD+ , copyHKD, moveHKD, cloneHKD+ , unsafeThawHKD, unsafeFreezeHKD+ -- ** Coercible+ , CoerceRef(..)+ , thawCoerce, freezeCoerce+ , copyCoerce, moveCoerce, cloneCoerce+ , unsafeThawCoerce, unsafeFreezeCoerce+ -- ** Traversable+ , TraverseRef(..)+ , thawTraverse, freezeTraverse+ , copyTraverse, moveTraverse, cloneTraverse+ , unsafeThawTraverse, unsafeFreezeTraverse+ -- ** Immutable+ , ImmutableRef(..), thawImmutable, freezeImmutable, copyImmutable+ -- ** Instances for Generics combinators themselves+ , GMutableRef(..)+ , MutSumF(..)+ ) where++import Control.Monad.Primitive+import Control.Monad.Trans.Class+import Control.Monad.Trans.State+import Data.Bifunctor+import Data.Coerce+import Data.Foldable+import Data.Kind+import Data.List+import Data.Primitive.MutVar+import Data.Vinyl.Functor+import GHC.Generics+import qualified Data.Vinyl.XRec as X++-- | An instance of @'Mutable' m a@ means that @a@ can be stored+-- a mutable reference in monad @m@.+--+-- The associated type @'Ref' m a@ links any @a@ to the type of its+-- canonical mutable version.+--+-- The /benefit/ of this typeclass, instead of just using+-- 'Data.IORef.IORef' or 'MutVar' or specific mutable versions like+-- 'V.Vector' and 'MV.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 like 'V.Vector'.+-- * Generic abstractions (similar to 'Show'), so you can automatically+-- derive instances while preserving piecewise-ness. For example, the+-- instance+--+-- @+-- instance (Mutable m a, Mutable m b) => Mutable m (a, b)+-- @+--+-- If @a@ and @b@ 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 :: 'V.Vector' Int+-- , tvDouble :: Vector Double+-- }+-- deriving Generic+--+-- instance Mutable m TwoVectors where+-- type Ref m TwoVectors = 'GRef' m TwoVectors+-- @+--+-- Then now we get:+--+-- @+-- 'thawRef' :: TwoVectors -> m ('GRef' m TwoVectors)+-- 'freezeRef' :: 'GRef' m TwoVectors -> m TwoVectors+-- @+--+-- And @'GRef' m TwoVectors@ 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+-- 'MV.MVector'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 :: 'X.HKD' f ('V.Vector' Int)+-- , tvDouble :: HKD f (Vector Double)+-- }+-- deriving Generic+--+-- instance Mutable (TwoVectors 'Identity') where+-- type Ref (TwoVectors 'Identity') = TwoVectors ('RefFor' m)+-- @+--+-- 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' IO)+-- ghci> :t is+-- 'MV.MVector' 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 m MyType = CoerceRef m 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 m (MyContainer a) = TraverseRef m MyContainer a+-- @+--+-- See <https://mutable.jle.im/02-mutable-and-ref.html> for more+-- information on this typeclass and how to define instances+-- automatically.+class Monad m => Mutable m a where+ -- | Links the type @a@ to the type of its canonical "mutable version".+ --+ -- For example, for 'V.Vector', the mutable version is 'MV.MVector', so+ -- we have+ --+ -- @+ -- type Ref m ('V.Vector' a) = 'MV.MVector' ('PrimState' m) a+ -- @+ --+ -- This means that using 'thawRef' on a 'V.Vector' will give you an+ -- 'MV.MVector', using 'freezeRef' on a 'MV.Vector' will give you+ -- a 'V.Vector', etc.+ --+ -- @+ -- 'thawRef'+ -- :: ('PrimMonad' m, s ~ 'PrimState' m)+ -- => 'V.Vector' a+ -- -> m ('MV.Vector' s a)+ --+ -- 'freezeRef'+ -- :: ('PrimMonad' m, s ~ 'PrimState' m)+ -- => 'MV.Vector' s a+ -- -> m ('V.Vector' a)+ --+ -- 'copyRef'+ -- :: ('PrimMonad' m, s ~ 'PrimState' m)+ -- => 'MV.Vector' s a+ -- -> 'V.Vector' a+ -- -> m ()+ -- @+ --+ -- This associated type must be unique for @a@, so no two types @a@ can+ -- have the same @'Ref' m a@. This makes type inference a lot more+ -- useful: if you use 'freezeRef' on an 'MV.MVector', for instance, the+ -- return type will be inferred to be 'V.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 all 'Generic' instances, preserves piecewise mutation+ -- -- for products+ -- type Ref m a = 'GRef' m 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 m MyType+ --+ -- -- This is equivalent to the above+ -- instance Mutable m MyType+ -- type Ref m MyType = 'MutVar' ('PrimState' m) MyType+ --+ -- -- any 'Generic' instance+ -- data MyType = MyType { mtInt :: Int, mtDouble :: Double }+ -- deriving Generic+ --+ -- instance Mutable m MyType where+ -- type Ref m MyType = 'GRef' m MyType+ -- @+ --+ -- See <https://mutable.jle.im/02-mutable-and-ref.html> for more+ -- information on this type family and how to define instances+ -- automatically.+ type Ref m a = (v :: Type) | v -> a+ type Ref m a = MutVar (PrimState m) a++ -- | "Thaw" a pure/persistent value into its mutable version, which can+ -- be manipulated using 'Data.Mutable.modifyRef' or other methods+ -- specific for that type (like 'MV.read').+ --+ -- Returns the 'Ref' instance, so, for example, for 'V.Vector':+ --+ -- @+ -- 'thawRef'+ -- :: ('PrimMonad' m, s ~ 'PrimState' m)+ -- => 'V.Vector' a+ -- -> m ('MV.Vector' s a)+ -- @+ --+ -- For non-composite (like 'Int'), this is often called the "new var"+ -- function, like 'Data.IORef.newIORef' / 'Data.STRef.newSTRef'+ -- / 'newMutVar' etc.+ thawRef :: a -> m (Ref m a)++ -- | "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 'V.Vector':+ --+ -- @+ -- 'freezeRef'+ -- :: ('PrimMonad' m, s ~ 'PrimState' m)+ -- => 'MV.Vector' s a+ -- -> m ('V.Vector' a)+ -- @+ --+ -- For non-composite (like 'Int'), this is often called the "read var"+ -- function, like 'Data.IORef.readIORef' / 'Data.STRef.readSTRef'+ -- / 'readMutVar' etc.+ freezeRef :: Ref m a -> m a++ -- | Overwrite a mutable value by provivding a pure/persistent value.+ -- 'copyRef'+ --+ -- Returns the 'Ref' and the value, so, for example, for 'V.Vector':+ --+ -- @+ -- 'copyRef'+ -- :: ('PrimMonad' m, s ~ 'PrimState' m)+ -- => 'MV.Vector' s a+ -- -> 'V.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 'Data.IORef.writeIORef' / 'Data.STRef.writeSTRef'+ -- / 'writeMutVar' etc.+ copyRef+ :: Ref m a -- ^ destination to overwrite+ -> a -- ^ value+ -> m ()++ -- | 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.+ moveRef+ :: Ref m a -- ^ destination+ -> Ref m a -- ^ source+ -> m ()++ -- | 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.+ cloneRef :: Ref m a -> m (Ref m a)++ -- this is nice but you can't write an instance for 'TraverseRef' on+ -- this, so maybe not.+ -- -- | Initialize a mutable reference with fields being undefined or+ -- -- with undefined values. This is only useful if you can modify parts+ -- -- of the mutable value (with things like "Data.Mutable.Parts"). If+ -- -- you attempt to 'freezeRef' (or 'modifyRef' etc.) this before setting+ -- -- all of the fields to reasonable values, this is likely to blow up.+ -- initRef :: m (Ref m a)++ -- | 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 'V.Vector').+ --+ -- This is safe as long as you never again use the original pure+ -- value, since it can potentially directly mutate it.+ unsafeThawRef :: a -> m (Ref m a)++ -- | 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 'V.Vector').+ --+ -- This is safe as long as you never again modify the mutable+ -- reference, since it can potentially directly mutate the frozen value+ -- magically.+ unsafeFreezeRef :: Ref m a -> m a++ default thawRef :: DefaultMutable m a (Ref m a) => a -> m (Ref m a)+ thawRef = defaultThawRef+ default freezeRef :: DefaultMutable m a (Ref m a) => Ref m a -> m a+ freezeRef = defaultFreezeRef+ default copyRef :: DefaultMutable m a (Ref m a) => Ref m a -> a -> m ()+ copyRef = defaultCopyRef+ default moveRef :: DefaultMutable m a (Ref m a) => Ref m a -> Ref m a -> m ()+ moveRef = defaultMoveRef+ default cloneRef :: DefaultMutable m a (Ref m a) => Ref m a -> m (Ref m a)+ cloneRef = defaultCloneRef+ default unsafeThawRef :: DefaultMutable m a (Ref m a) => a -> m (Ref m a)+ unsafeThawRef = defaultUnsafeThawRef+ default unsafeFreezeRef :: DefaultMutable m a (Ref m a) => Ref m a -> m a+ unsafeFreezeRef = defaultUnsafeFreezeRef++-- | 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 m MyType+--+-- -- the above is the same as:+-- instance Mutable m MyType+-- type Ref m MyType = MutVar (PrimState m) MyType+-- @+--+-- The case for any instance of 'Generic':+--+-- @+-- instance Mutable m MyType+-- type Ref m MyType = GRef m MyType+-- @+--+-- The case for the "higher-kinded data" pattern a la+-- <https://reasonablypolymorphic.com/blog/higher-kinded-data/>:+--+-- @+-- instance Mutable m (MyTypeF Identity)+-- type Ref m (MyTypeF Identity) = MyTypeF (RefFor m)+-- @+--+-- The case for any newtype wrapper:+--+-- @+-- newtype MyType = MT (Vector Double)+--+-- instance Mutable m MyType where+-- type Ref m MyType = CoerceRef m 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 m a => Mutable m (MyContainer a) where+-- type Ref m (MyContainer a) = TraverseRef m MyContainer a+-- @+--+class DefaultMutable m a r | r -> a where+ defaultThawRef :: a -> m r+ defaultFreezeRef :: r -> m a+ defaultCopyRef :: r -> a -> m ()+ defaultMoveRef :: r -> r -> m ()+ defaultCloneRef :: r -> m r+ defaultUnsafeThawRef :: a -> m r+ defaultUnsafeFreezeRef :: r -> m a++instance (PrimMonad m, s ~ PrimState m) => DefaultMutable m a (MutVar s a) where+ defaultThawRef = newMutVar+ defaultFreezeRef = readMutVar+ defaultCopyRef = writeMutVar+ defaultMoveRef v u = writeMutVar v =<< readMutVar u+ defaultCloneRef v = newMutVar =<< readMutVar v+ defaultUnsafeThawRef = newMutVar+ defaultUnsafeFreezeRef = readMutVar++instance (Generic a, GMutable m (Rep a)) => DefaultMutable m a (GRef m a) where+ defaultThawRef = gThawRef+ defaultFreezeRef = gFreezeRef+ defaultCopyRef = gCopyRef+ defaultMoveRef = gMoveRef+ defaultCloneRef = gCloneRef+ defaultUnsafeThawRef = gUnsafeThawRef+ defaultUnsafeFreezeRef = gUnsafeFreezeRef++instance (Generic (z Identity), Generic (z (RefFor m)), GMutable m (Rep (z Identity)), GRef_ m (Rep (z Identity)) ~ Rep (z (RefFor m)))+ => DefaultMutable m (z Identity) (z (RefFor m)) where+ defaultThawRef = thawHKD+ defaultFreezeRef = freezeHKD+ defaultCopyRef = copyHKD+ defaultMoveRef = moveHKD+ defaultCloneRef = cloneHKD+ defaultUnsafeThawRef = unsafeThawHKD+ defaultUnsafeFreezeRef = unsafeFreezeHKD++instance (Traversable f, Mutable m a) => DefaultMutable m (f a) (TraverseRef m f a) where+ defaultThawRef = thawTraverse+ defaultFreezeRef = freezeTraverse+ defaultCopyRef = copyTraverse+ defaultMoveRef = moveTraverse+ defaultCloneRef = cloneTraverse+ defaultUnsafeThawRef = unsafeThawTraverse+ defaultUnsafeFreezeRef = unsafeFreezeTraverse++instance (Coercible s a, Mutable m a) => DefaultMutable m s (CoerceRef m s a) where+ defaultThawRef = thawCoerce+ defaultFreezeRef = freezeCoerce+ defaultCopyRef = copyCoerce+ defaultMoveRef = moveCoerce+ defaultCloneRef = cloneCoerce+ defaultUnsafeThawRef = unsafeThawCoerce+ defaultUnsafeFreezeRef = unsafeFreezeCoerce++instance Applicative m => DefaultMutable m a (ImmutableRef a) where+ defaultThawRef = thawImmutable+ defaultFreezeRef = freezeImmutable+ defaultCopyRef = copyImmutable+ defaultMoveRef = moveImmutable+ defaultCloneRef = cloneImmutable+ defaultUnsafeThawRef = thawImmutable+ defaultUnsafeFreezeRef = freezeImmutable++-- | A handy newtype wrapper that allows you to partially apply 'Ref'.+-- @'RefFor' m a@ is the same as @'Ref' m a@, but can be partially applied.+--+-- If used with 'X.HKD', you can treat this syntactically identically as+-- a @'Ref' m a@.+newtype RefFor m a = RefFor { getRefFor :: Ref m a }++deriving instance Eq (Ref m a) => Eq (RefFor m a)+deriving instance Ord (Ref m a) => Ord (RefFor m a)++-- | Use a @'RefFor' m a@ as if it were a @'Ref' m a@.+instance X.IsoHKD (RefFor m) a where+ type HKD (RefFor m) a = Ref m a+ unHKD = RefFor+ toHKD = getRefFor++-- | A 'Ref' that works for any instance of 'Traversable', by using the+-- fields of the 'Traversable' instance to /purely/ store mutable references.+--+-- Note that this really only makes complete sense if the 'Traversable' is+-- fixed-size, or you never modify the length of the traversable as you use+-- it as a reference.+--+-- If you /do/ modify the length, copying and modifying semantics can be+-- a bit funky:+--+-- * If copying a shorter item into a longer item ref, the "leftovers" items+-- in the longer item are unchanged.+-- * If copying a longer item into a shorter item ref, the leftover items+-- are unchanged.+--+-- @+-- ghci> r <- 'thawTraverse' [1..10]+-- ghci> 'copyTraverse' r [0,0,0,0]+-- ghci> 'freezeTraverse' r+-- [0,0,0,0,5,6,7,8,9,10]+-- ghci> 'copyTraverse' r [20..50]+-- ghci> 'freezeTraverse' r+-- [20,21,22,23,24,25,26,27,28,29]+-- @+--+newtype TraverseRef m f a = TraverseRef { getTraverseRef :: f (Ref m a) }++-- | Use a @'TraverseRef' m f a@ as if it were a @f ('Ref' m a)@+instance X.IsoHKD (TraverseRef m f) a where+ type HKD (TraverseRef m f) a = f (Ref m a)+ unHKD = TraverseRef+ toHKD = getTraverseRef++-- | Default 'thawRef' for 'TraverseRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'TraverseRef' as the+-- 'Ref'. However, it can be useful if you are using a @'TraverseRef'+-- m f a@ just as a normal data type, independent of the 'Ref' class. See+-- documentation for 'TraverseRef' for more information.+thawTraverse :: (Traversable f, Mutable m a) => f a -> m (TraverseRef m f a)+thawTraverse = fmap TraverseRef . traverse thawRef++-- | Default 'freezeRef' for 'TraverseRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'TraverseRef' as the+-- 'Ref'. However, it can be useful if you are using a @'TraverseRef'+-- m f a@ just as a normal data type, independent of the 'Ref' class. See+-- documentation for 'TraverseRef' for more information.+freezeTraverse :: (Traversable f, Mutable m a) => TraverseRef m f a -> m (f a)+freezeTraverse = traverse freezeRef . getTraverseRef++-- | Default 'copyRef' for 'TraverseRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'TraverseRef' as the+-- 'Ref'. However, it can be useful if you are using a @'TraverseRef'+-- m f a@ just as a normal data type, independent of the 'Ref' class. See+-- documentation for 'TraverseRef' for more information.+copyTraverse :: (Traversable f, Mutable m a) => TraverseRef m f a -> f a -> m ()+copyTraverse (TraverseRef rs) xs = evalStateT (traverse_ go rs) (toList xs)+ where+ go r = do+ x <- state $ maybe (Nothing, []) (first Just) . uncons+ lift $ mapM_ (copyRef r) x++-- | Default 'moveRef' for 'TraverseRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'TraverseRef' as the+-- 'Ref'. However, it can be useful if you are using a @'TraverseRef'+-- m f a@ just as a normal data type, independent of the 'Ref' class. See+-- documentation for 'TraverseRef' for more information.+moveTraverse+ :: (Traversable f, Mutable m a)+ => TraverseRef m f a -- ^ destination+ -> TraverseRef m f a -- ^ source+ -> m ()+moveTraverse (TraverseRef rs) (TraverseRef vs) = evalStateT (traverse_ go rs) (toList vs)+ where+ go r = do+ x <- state $ maybe (Nothing, []) (first Just) . uncons+ lift $ mapM_ (moveRef r) x++-- | Default 'cloneRef' for 'TraverseRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'TraverseRef' as the+-- 'Ref'. However, it can be useful if you are using a @'TraverseRef'+-- m f a@ just as a normal data type, independent of the 'Ref' class. See+-- documentation for 'TraverseRef' for more information.+cloneTraverse :: (Traversable f, Mutable m a) => TraverseRef m f a -> m (TraverseRef m f a)+cloneTraverse = fmap TraverseRef . traverse cloneRef . getTraverseRef++-- | Default 'unsafeThawRef' for 'TraverseRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'TraverseRef' as the+-- 'Ref'. However, it can be useful if you are using a @'TraverseRef'+-- m f a@ just as a normal data type, independent of the 'Ref' class. See+-- documentation for 'TraverseRef' for more information.+unsafeThawTraverse :: (Traversable f, Mutable m a) => f a -> m (TraverseRef m f a)+unsafeThawTraverse = fmap TraverseRef . traverse unsafeThawRef++-- | Default 'unsafeFreezeRef' for 'TraverseRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'TraverseRef' as the+-- 'Ref'. However, it can be useful if you are using a @'TraverseRef'+-- m f a@ just as a normal data type, independent of the 'Ref' class. See+-- documentation for 'TraverseRef' for more information.+unsafeFreezeTraverse :: (Traversable f, Mutable m a) => TraverseRef m f a -> m (f a)+unsafeFreezeTraverse = traverse unsafeFreezeRef . getTraverseRef++-- | A 'Ref' that works by using the 'Mutable' instance of an equivalent+-- type. This is useful for newtype wrappers, so you can use the+-- underlying data type's 'Mutable' instance.+--+-- @+-- newtype MyVec = MyVec ('V.Vector' Double)+--+-- instance 'Mutable' m MyVec where+-- type 'Ref' m MyVec = 'CoerceRef' m s ('V.Vector' Double)+-- @+--+-- The @Ref m MyVec@ uses the a @'MV.MVector' Double@ under the hood.+--+-- It's essentially a special case of 'GRef' for newtypes.+newtype CoerceRef m s a = CoerceRef { getCoerceRef :: Ref m a }++deriving instance Eq (Ref m a) => Eq (CoerceRef m s a)+deriving instance Ord (Ref m a) => Ord (CoerceRef m s a)++-- | Use a @'CoerceRef' m s a@ as if it were a @'Ref' m a@+instance X.IsoHKD (CoerceRef m s) a where+ type HKD (CoerceRef m s) a = Ref m a+ unHKD = CoerceRef+ toHKD = getCoerceRef++-- | Default 'thawRef' for 'CoerceRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'CoerceRef' as the 'Ref'.+-- However, it can be useful if you are using a @'CoerceRef' m s a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'CoerceRef' for more information.+thawCoerce :: (Coercible s a, Mutable m a) => s -> m (CoerceRef m s a)+thawCoerce = fmap CoerceRef . thawRef . coerce++-- | Default 'freezeRef' for 'CoerceRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'CoerceRef' as the 'Ref'.+-- However, it can be useful if you are using a @'CoerceRef' m s a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'CoerceRef' for more information.+freezeCoerce :: (Coercible s a, Mutable m a) => CoerceRef m s a -> m s+freezeCoerce = fmap coerce . freezeRef . getCoerceRef++-- | Default 'copyRef' for 'CoerceRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'CoerceRef' as the 'Ref'.+-- However, it can be useful if you are using a @'CoerceRef' m s a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'CoerceRef' for more information.+copyCoerce :: (Coercible s a, Mutable m a) => CoerceRef m s a -> s -> m ()+copyCoerce (CoerceRef r) = copyRef r . coerce++-- | Default 'moveRef' for 'CoerceRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'CoerceRef' as the 'Ref'.+-- However, it can be useful if you are using a @'CoerceRef' m s a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'CoerceRef' for more information.+moveCoerce :: Mutable m a => CoerceRef m s a -> CoerceRef m s a -> m ()+moveCoerce (CoerceRef r) (CoerceRef s) = moveRef r s++-- | Default 'cloneRef' for 'CoerceRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'CoerceRef' as the 'Ref'.+-- However, it can be useful if you are using a @'CoerceRef' m s a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'CoerceRef' for more information.+cloneCoerce :: Mutable m a => CoerceRef m s a -> m (CoerceRef m s a)+cloneCoerce = fmap CoerceRef . cloneRef . getCoerceRef++-- | Default 'unsafeThawRef' for 'CoerceRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'CoerceRef' as the 'Ref'.+-- However, it can be useful if you are using a @'CoerceRef' m s a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'CoerceRef' for more information.+unsafeThawCoerce :: (Coercible s a, Mutable m a) => s -> m (CoerceRef m s a)+unsafeThawCoerce = fmap CoerceRef . unsafeThawRef . coerce++-- | Default 'unsafeFreezeRef' for 'CoerceRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'CoerceRef' as the 'Ref'.+-- However, it can be useful if you are using a @'CoerceRef' m s a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'CoerceRef' for more information.+unsafeFreezeCoerce :: (Coercible s a, Mutable m a) => CoerceRef m s a -> m s+unsafeFreezeCoerce = fmap coerce . unsafeFreezeRef . getCoerceRef++-- | A "'Ref'" that can be used to give a default 'Mutable' instance that+-- is immutable. Nothing is allocated ever, all attempts to modify it will+-- be ignored, and 'freezeRef' will just get the original thawed value.+--+-- Really only exists to be used with 'Data.Mutable.Class.Immutable'.+newtype ImmutableRef a = ImmutableRef { getImmutableRef :: a }++-- | Use a @'ImmutableRef' a@ as if it were an @a@+instance X.IsoHKD ImmutableRef a where+ type HKD ImmutableRef a = a+ unHKD = ImmutableRef+ toHKD = getImmutableRef++-- | Default 'thawRef' for 'ImmutableRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'ImmutableRef' as the 'Ref'.+-- However, it can be useful if you are using a @'ImmutableRef' m s a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'ImmutableRef' for more information.+thawImmutable :: Applicative m => a -> m (ImmutableRef a)+thawImmutable = pure . ImmutableRef++-- | Default 'freezeRef' for 'ImmutableRef'. This will always return the+-- originally thawed value, ignoring all copies and writes.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'ImmutableRef' as the 'Ref'.+-- However, it can be useful if you are using a @'ImmutableRef' m s a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'ImmutableRef' for more information.+freezeImmutable :: Applicative m => ImmutableRef a -> m a+freezeImmutable = pure . getImmutableRef++-- | Default 'copyRef' for 'ImmutableRef'. This is a no-op and does+-- nothing, since freezing will always return the originally thawed value.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'ImmutableRef' as the 'Ref'.+-- However, it can be useful if you are using a @'ImmutableRef' m s a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'ImmutableRef' for more information.+copyImmutable :: Applicative m => ImmutableRef a -> a -> m ()+copyImmutable _ _ = pure ()++-- | Default 'moveRef' for 'ImmutableRef'. This is a no-op and does+-- nothing, since freezing will always return the originally thawed value.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'ImmutableRef' as the 'Ref'.+-- However, it can be useful if you are using a @'ImmutableRef' m s a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'ImmutableRef' for more information.+moveImmutable :: Applicative m => ImmutableRef a -> ImmutableRef a -> m ()+moveImmutable _ _ = pure ()++-- | Default 'cloneRef' for 'ImmutableRef'. 'freezeRef' on this value will+-- return the originally thawed value.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'ImmutableRef' as the 'Ref'.+-- However, it can be useful if you are using a @'ImmutableRef' m s a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'ImmutableRef' for more information.+cloneImmutable :: Applicative m => ImmutableRef a -> m (ImmutableRef a)+cloneImmutable = pure++++-- | Class for automatic generation of 'Ref' for 'Generic' instances. See+-- 'GRef' for more information.+class Monad m => GMutable m f where+ type GRef_ m f = (u :: k -> Type) | u -> f++ gThawRef_ :: f a -> m (GRef_ m f a)+ gFreezeRef_ :: GRef_ m f a -> m (f a)+ gCopyRef_ :: GRef_ m f a -> f a -> m ()+ gMoveRef_ :: GRef_ m f a -> GRef_ m f a -> m ()+ gCloneRef_ :: GRef_ m f a -> m (GRef_ m f a)+ gUnsafeThawRef_ :: f a -> m (GRef_ m f a)+ gUnsafeFreezeRef_ :: GRef_ m f a -> m (f a)++instance Mutable m c => GMutable m (K1 i c) where+ type GRef_ m (K1 i c) = K1 i (Ref m c)++ gThawRef_ = fmap K1 . thawRef . unK1+ gFreezeRef_ = fmap K1 . freezeRef . unK1+ gCopyRef_ (K1 v) (K1 x) = copyRef v x+ gMoveRef_ (K1 v) (K1 u) = moveRef v u+ gCloneRef_ = fmap K1 . cloneRef . unK1+ gUnsafeThawRef_ = fmap K1 . unsafeThawRef . unK1+ gUnsafeFreezeRef_ = fmap K1 . unsafeFreezeRef . unK1++instance Monad m => GMutable m U1 where+ type GRef_ m U1 = U1++ gThawRef_ _ = pure U1+ gFreezeRef_ _ = pure U1+ gCopyRef_ _ _ = pure ()+ gMoveRef_ _ _ = pure ()+ gCloneRef_ _ = pure U1+ gUnsafeThawRef_ _ = pure U1+ gUnsafeFreezeRef_ _ = pure U1++instance Monad m => GMutable m V1 where+ type GRef_ m V1 = V1++ gThawRef_ = \case {}+ gFreezeRef_ = \case {}+ gCopyRef_ = \case {}+ gMoveRef_ = \case {}+ gCloneRef_ = \case {}+ gUnsafeThawRef_ = \case {}+ gUnsafeFreezeRef_ = \case {}++instance (GMutable m f, GMutable m g) => GMutable m (f :*: g) where+ type GRef_ m (f :*: g) = GRef_ m f :*: GRef_ m g++ gThawRef_ (x :*: y) = (:*:) <$> gThawRef_ x <*> gThawRef_ y+ gFreezeRef_ (v :*: u) = (:*:) <$> gFreezeRef_ v <*> gFreezeRef_ u+ gCopyRef_ (v :*: u) (x :*: y) = gCopyRef_ v x *> gCopyRef_ u y+ gMoveRef_ (v :*: u) (v' :*: u') = gMoveRef_ v v' *> gMoveRef_ u u'+ gCloneRef_ (v :*: u) = (:*:) <$> gCloneRef_ v <*> gCloneRef_ u+ gUnsafeThawRef_ (x :*: y) = (:*:) <$> gUnsafeThawRef_ x <*> gUnsafeThawRef_ y+ gUnsafeFreezeRef_ (v :*: u) = (:*:) <$> gUnsafeFreezeRef_ v <*> gUnsafeFreezeRef_ u++instance GMutable m f => GMutable m (M1 i c f) where+ type GRef_ m (M1 i c f) = M1 i c (GRef_ m f)++ gThawRef_ = fmap M1 . gThawRef_ . unM1+ gFreezeRef_ = fmap M1 . gFreezeRef_ . unM1+ gCopyRef_ (M1 v) (M1 x) = gCopyRef_ v x+ gMoveRef_ (M1 v) (M1 u) = gMoveRef_ v u+ gCloneRef_ (M1 v) = M1 <$> gCloneRef_ v+ gUnsafeThawRef_ = fmap M1 . gUnsafeThawRef_ . unM1+ gUnsafeFreezeRef_ = fmap M1 . gUnsafeFreezeRef_ . unM1++-- | Wraps ':+:' in a mutable reference. Used internally to represent+-- generic sum references.+newtype MutSumF m f g a = MutSumF { getMutSumF :: MutVar (PrimState m) ((f :+: g) a) }++instance (GMutable m f, GMutable m g, PrimMonad m) => GMutable m (f :+: g) where+ type GRef_ m (f :+: g) = MutSumF m (GRef_ m f) (GRef_ m g)+ -- MutVar (PrimState m) :.: (GRef_ m f :+: GRef_ m g)++ gThawRef_ = \case+ L1 x -> fmap MutSumF . newMutVar . L1 =<< gThawRef_ x+ R1 x -> fmap MutSumF . newMutVar . R1 =<< gThawRef_ x+ gFreezeRef_ (MutSumF r) = readMutVar r >>= \case+ L1 v -> L1 <$> gFreezeRef_ v+ R1 u -> R1 <$> gFreezeRef_ u+ gCopyRef_ (MutSumF r) xy = readMutVar r >>= \case+ L1 v -> case xy of+ L1 x -> gCopyRef_ v x+ R1 y -> writeMutVar r . R1 =<< gThawRef_ y+ R1 u -> case xy of+ L1 x -> writeMutVar r . L1 =<< gThawRef_ x+ R1 y -> gCopyRef_ u y+ gMoveRef_ (MutSumF u) (MutSumF v) = readMutVar v >>= \case+ L1 vl -> readMutVar u >>= \case+ L1 ul -> gMoveRef_ ul vl+ R1 _ -> writeMutVar u . L1 =<< gCloneRef_ vl+ R1 vr -> readMutVar u >>= \case+ L1 _ -> writeMutVar u . R1 =<< gCloneRef_ vr+ R1 ur -> gMoveRef_ ur vr+ gCloneRef_ (MutSumF v) = readMutVar v >>= \case+ L1 u -> fmap MutSumF . newMutVar . L1 =<< gCloneRef_ u+ R1 u -> fmap MutSumF . newMutVar . R1 =<< gCloneRef_ u+ gUnsafeThawRef_ = \case+ L1 x -> fmap MutSumF . newMutVar . L1 =<< gUnsafeThawRef_ x+ R1 x -> fmap MutSumF . newMutVar . R1 =<< gUnsafeThawRef_ x+ gUnsafeFreezeRef_ (MutSumF r) = readMutVar r >>= \case+ L1 v -> L1 <$> gUnsafeFreezeRef_ v+ R1 u -> R1 <$> gUnsafeFreezeRef_ u+++-- | A 'Ref' for instances of 'GMutable', which are the "GHC.Generics"+-- combinators.+newtype GMutableRef m f a = GMutableRef { getGMutableRef :: GRef_ m f a }++deriving instance Eq (GRef_ m f a) => Eq (GMutableRef m f a)+deriving instance Ord (GRef_ m f a) => Ord (GMutableRef m f a)++thawGMutableRef :: GMutable m f => f a -> m (GMutableRef m f a)+thawGMutableRef = fmap GMutableRef . gThawRef_++freezeGMutableRef :: GMutable m f => GMutableRef m f a -> m (f a)+freezeGMutableRef = gFreezeRef_ . getGMutableRef++copyGMutableRef :: GMutable m f => GMutableRef m f a -> f a -> m ()+copyGMutableRef (GMutableRef r) = gCopyRef_ r++moveGMutableRef :: GMutable m f => GMutableRef m f a -> GMutableRef m f a -> m ()+moveGMutableRef (GMutableRef r) (GMutableRef s) = gMoveRef_ r s++cloneGMutableRef :: GMutable m f => GMutableRef m f a -> m (GMutableRef m f a)+cloneGMutableRef (GMutableRef r) = GMutableRef <$> gCloneRef_ r++unsafeThawGMutableRef :: GMutable m f => f a -> m (GMutableRef m f a)+unsafeThawGMutableRef = fmap GMutableRef . gUnsafeThawRef_++unsafeFreezeGMutableRef :: GMutable m f => GMutableRef m f a -> m (f a)+unsafeFreezeGMutableRef = gUnsafeFreezeRef_ . getGMutableRef++instance Mutable m c => Mutable m (K1 i c a) where+ type Ref m (K1 i c a) = GMutableRef m (K1 i c) a+ thawRef = thawGMutableRef+ freezeRef = freezeGMutableRef+ copyRef = copyGMutableRef+ moveRef = moveGMutableRef+ cloneRef = cloneGMutableRef+ unsafeThawRef = unsafeThawGMutableRef+ unsafeFreezeRef = unsafeFreezeGMutableRef++instance Monad m => Mutable m (U1 a) where+ type Ref m (U1 a) = GMutableRef m U1 a+ thawRef = thawGMutableRef+ freezeRef = freezeGMutableRef+ copyRef = copyGMutableRef+ moveRef = moveGMutableRef+ cloneRef = cloneGMutableRef+ unsafeThawRef = unsafeThawGMutableRef+ unsafeFreezeRef = unsafeFreezeGMutableRef++instance Monad m => Mutable m (V1 a) where+ type Ref m (V1 a) = GMutableRef m V1 a+ thawRef = thawGMutableRef+ freezeRef = freezeGMutableRef+ copyRef = copyGMutableRef+ moveRef = moveGMutableRef+ cloneRef = cloneGMutableRef+ unsafeThawRef = unsafeThawGMutableRef+ unsafeFreezeRef = unsafeFreezeGMutableRef++instance (GMutable m f, GMutable m g) => Mutable m ((f :*: g) a) where+ type Ref m ((f :*: g) a) = GMutableRef m (f :*: g) a+ thawRef = thawGMutableRef+ freezeRef = freezeGMutableRef+ copyRef = copyGMutableRef+ moveRef = moveGMutableRef+ cloneRef = cloneGMutableRef+ unsafeThawRef = unsafeThawGMutableRef+ unsafeFreezeRef = unsafeFreezeGMutableRef++instance (GMutable m f, GMutable m g, PrimMonad m) => Mutable m ((f :+: g) a) where+ type Ref m ((f :+: g) a) = GMutableRef m (f :+: g) a+ thawRef = thawGMutableRef+ freezeRef = freezeGMutableRef+ copyRef = copyGMutableRef+ moveRef = moveGMutableRef+ cloneRef = cloneGMutableRef+ unsafeThawRef = unsafeThawGMutableRef+ unsafeFreezeRef = unsafeFreezeGMutableRef+++-- | Automatically generate a piecewise mutable reference for any 'Generic'+-- instance.+--+-- @+-- -- | any 'Generic' instance+-- data MyType = MyType { mtInt :: Int, mtDouble :: Double }+-- deriving (Generic, Show)+--+-- instance Mutable m MyType where+-- type Ref m MyType = 'GRef' m MyType+-- @+--+-- @+-- ghci> r <- 'thawRef' (MyType 3 4.5)+-- ghci> 'freezeRef' r+-- MyType 3 4.5+-- ghci> 'Data.Mutable.Parts.freezePart' ('Data.Mutable.Parts.fieldMut' #mtInt) r+-- 3+-- ghci> 'Data.Mutable.Parts.copyPart' (fieldMut #mtDouble) 1.23+-- ghci> freezeRef r+-- MyType 3 1.23+-- @+--+-- Note that this is basically just a bunch of tupled refs for a product+-- type. For a sum type (with multiple constructors), an extra layer of+-- indirection is added to account for the dynamically changable shape.+--+-- See "Data.Mutable.Parts" and "Data.Mutable.Branches" for nice ways to+-- inspect and mutate the internals of this type (as demonstrated above).+--+-- If the facilities in those modules are not adequate, you can also+-- manually crack open 'GRef' and work with the internals. Getting the+-- /type/ of @'unGRef' \@MyType@ should allow you to navigate what is going+-- on, if you are familiar with "GHC.Generics". However, ideally, you+-- would never need to do this.+newtype GRef m a = GRef { unGRef :: GRef_ m (Rep a) () }++deriving instance Eq (GRef_ m (Rep a) ()) => Eq (GRef m a)+deriving instance Ord (GRef_ m (Rep a) ()) => Ord (GRef m a)++-- | Default 'thawRef' for 'GRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'GRef' as the 'Ref'.+-- However, it can be useful if you are using a @'GRef' m a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'GRef' for more information.+gThawRef+ :: (Generic a, GMutable m (Rep a))+ => a+ -> m (GRef m a)+gThawRef = fmap GRef . gThawRef_ . from++-- | Default 'freezeRef' for 'GRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'GRef' as the 'Ref'.+-- However, it can be useful if you are using a @'GRef' m a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'GRef' for more information.+gFreezeRef+ :: (Generic a, GMutable m (Rep a))+ => GRef m a+ -> m a+gFreezeRef = fmap to . gFreezeRef_ . unGRef++-- | Default 'copyRef' for 'GRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'GRef' as the 'Ref'.+-- However, it can be useful if you are using a @'GRef' m a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'GRef' for more information.+gCopyRef+ :: (Generic a, GMutable m (Rep a))+ => GRef m a+ -> a+ -> m ()+gCopyRef (GRef v) x = gCopyRef_ v (from x)++-- | Default 'moveRef' for 'GRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'GRef' as the 'Ref'.+-- However, it can be useful if you are using a @'GRef' m a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'GRef' for more information.+gMoveRef+ :: GMutable m (Rep a)+ => GRef m a+ -> GRef m a+ -> m ()+gMoveRef (GRef v) (GRef u) = gMoveRef_ v u++-- | Default 'cloneRef' for 'GRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'GRef' as the 'Ref'.+-- However, it can be useful if you are using a @'GRef' m a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'GRef' for more information.+gCloneRef+ :: GMutable m (Rep a)+ => GRef m a+ -> m (GRef m a)+gCloneRef (GRef v) = GRef <$> gCloneRef_ v++-- | Default 'unsafeThawRef' for 'GRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'GRef' as the 'Ref'.+-- However, it can be useful if you are using a @'GRef' m a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'GRef' for more information.+gUnsafeThawRef+ :: (Generic a, GMutable m (Rep a))+ => a+ -> m (GRef m a)+gUnsafeThawRef = fmap GRef . gUnsafeThawRef_ . from++-- | Default 'unsafeFreezeRef' for 'GRef'.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with 'GRef' as the 'Ref'.+-- However, it can be useful if you are using a @'GRef' m a@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'GRef' for more information.+gUnsafeFreezeRef+ :: (Generic a, GMutable m (Rep a))+ => GRef m a+ -> m a+gUnsafeFreezeRef = fmap to . gUnsafeFreezeRef_ . unGRef+++-- | Default 'thawRef' for the higher-kinded data pattern, a la+-- <https://reasonablypolymorphic.com/blog/higher-kinded-data/>.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with @z ('RefFor' m)@ as the 'Ref'.+-- However, it can be useful if you are using a @z ('RefFor' m)@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'Mutable' for more information.+thawHKD+ :: forall z m.+ ( Generic (z Identity)+ , Generic (z (RefFor m))+ , GMutable m (Rep (z Identity))+ , GRef_ m (Rep (z Identity)) ~ Rep (z (RefFor m))+ )+ => z Identity+ -> m (z (RefFor m))+thawHKD = fmap to . gThawRef_ . from++-- | Default 'freezeRef' for the higher-kinded data pattern, a la+-- <https://reasonablypolymorphic.com/blog/higher-kinded-data/>.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with @z ('RefFor' m)@ as the 'Ref'.+-- However, it can be useful if you are using a @z ('RefFor' m)@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'Mutable' for more information.+freezeHKD+ :: forall z m.+ ( Generic (z Identity)+ , Generic (z (RefFor m))+ , GMutable m (Rep (z Identity))+ , GRef_ m (Rep (z Identity)) ~ Rep (z (RefFor m))+ )+ => z (RefFor m)+ -> m (z Identity)+freezeHKD = fmap to . gFreezeRef_ . from++-- | Default 'copyRef' for the higher-kinded data pattern, a la+-- <https://reasonablypolymorphic.com/blog/higher-kinded-data/>.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with @z ('RefFor' m)@ as the 'Ref'.+-- However, it can be useful if you are using a @z ('RefFor' m)@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'Mutable' for more information.+copyHKD+ :: forall z m.+ ( Generic (z Identity)+ , Generic (z (RefFor m))+ , GMutable m (Rep (z Identity))+ , GRef_ m (Rep (z Identity)) ~ Rep (z (RefFor m))+ )+ => z (RefFor m)+ -> z Identity+ -> m ()+copyHKD r x = gCopyRef_ (from r) (from x)++-- | Default 'moveRef' for the higher-kinded data pattern, a la+-- <https://reasonablypolymorphic.com/blog/higher-kinded-data/>.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with @z ('RefFor' m)@ as the 'Ref'.+-- However, it can be useful if you are using a @z ('RefFor' m)@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'Mutable' for more information.+moveHKD+ :: forall z m.+ ( Generic (z (RefFor m))+ , GMutable m (Rep (z Identity))+ , GRef_ m (Rep (z Identity)) ~ Rep (z (RefFor m))+ )+ => z (RefFor m)+ -> z (RefFor m)+ -> m ()+moveHKD r x = gMoveRef_ (from r) (from x)++-- | Default 'cloneRef' for the higher-kinded data pattern, a la+-- <https://reasonablypolymorphic.com/blog/higher-kinded-data/>.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with @z ('RefFor' m)@ as the 'Ref'.+-- However, it can be useful if you are using a @z ('RefFor' m)@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'Mutable' for more information.+cloneHKD+ :: forall z m.+ ( Generic (z (RefFor m))+ , GMutable m (Rep (z Identity))+ , GRef_ m (Rep (z Identity)) ~ Rep (z (RefFor m))+ )+ => z (RefFor m)+ -> m (z (RefFor m))+cloneHKD = fmap to . gCloneRef_ . from++-- | Default 'unsafeThawRef' for the higher-kinded data pattern, a la+-- <https://reasonablypolymorphic.com/blog/higher-kinded-data/>.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with @z ('RefFor' m)@ as the 'Ref'.+-- However, it can be useful if you are using a @z ('RefFor' m)@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'Mutable' for more information.+unsafeThawHKD+ :: forall z m.+ ( Generic (z Identity)+ , Generic (z (RefFor m))+ , GMutable m (Rep (z Identity))+ , GRef_ m (Rep (z Identity)) ~ Rep (z (RefFor m))+ )+ => z Identity+ -> m (z (RefFor m))+unsafeThawHKD = fmap to . gUnsafeThawRef_ . from++-- | Default 'unsafeFreezeRef' for the higher-kinded data pattern, a la+-- <https://reasonablypolymorphic.com/blog/higher-kinded-data/>.+--+-- You likely won't ever use this directly, since it is automatically+-- provided if you have a 'Mutable' instance with @z ('RefFor' m)@ as the 'Ref'.+-- However, it can be useful if you are using a @z ('RefFor' m)@ just as+-- a normal data type, independent of the 'Ref' class. See documentation+-- for 'Mutable' for more information.+unsafeFreezeHKD+ :: forall z m.+ ( Generic (z Identity)+ , Generic (z (RefFor m))+ , GMutable m (Rep (z Identity))+ , GRef_ m (Rep (z Identity)) ~ Rep (z (RefFor m))+ )+ => z (RefFor m)+ -> m (z Identity)+unsafeFreezeHKD = fmap to . gUnsafeFreezeRef_ . from
+ src/Data/Mutable/Parts.hs view
@@ -0,0 +1,656 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module : Data.Mutable.Parts+-- Copyright : (c) Justin Le 2020+-- License : BSD3+--+-- Maintainer : justin@jle.im+-- Stability : experimental+-- Portability : non-portable+--+-- 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.+--+module Data.Mutable.Parts (+ MutPart(..)+ , withPart+ , freezePart, copyPart+ , movePartInto, movePartOver, movePartWithin+ , clonePart, unsafeFreezePart+ , modifyPart, modifyPart'+ , updatePart, updatePart'+ , modifyPartM, modifyPartM'+ , updatePartM, updatePartM'+ -- * Built-in 'MutPart'+ , compMP+ , idMP+ , mutFst, mutSnd+ -- ** Field+ , FieldMut(..), withField, mutField, Label(..)+ -- ** Position+ , PosMut(..), withPos, mutPos+ -- ** HList+ , TupleMut(..), withTuple+ -- ** Other+ , hkdMutParts, HKDMutParts+ , mutRec+ , coerceRef, withCoerceRef+ , MapRef+ ) where++import Data.Coerce+import Data.Kind+import Data.Mutable.Class+import Data.Mutable.Instances+import Data.Vinyl hiding (HList)+import Data.Vinyl.Functor+import GHC.Generics+import GHC.TypeLits+import qualified Control.Category as C+import qualified Data.GenericLens.Internal as GL+import qualified Data.Generics.Internal.Profunctor.Lens as GLP+import qualified Data.Generics.Product.Fields as GL+import qualified Data.Generics.Product.Positions as GL+import qualified Data.Vinyl.TypeLevel as V+import qualified Data.Vinyl.XRec as X+++-- | A @'MutPart' m s a@ is a way to "zoom into" an @a@, as a part of+-- a mutable reference on @s@. This allows you to only modify a single+-- @a@ part of the @s@, without touching the rest. It's spiritually+-- similar to a @Lens' s a@.+--+-- If 'Data.Mutable.Branches.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 -> 'Data.Vector.MVector' s a -> a -> m ()@ from+-- "Data.Vector.Mutable" --- @write 3 :: 'Data.Vector.MVector' s a -> a ->+-- m ()@, for instance, lets you modify a specific part of the vector+-- without touching the rest.+--+-- 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' m (a, b) a+-- 'mutSnd' :: MutPart m (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.+newtype MutPart m s a = MutPart { getMutPart :: Ref m s -> Ref m a }++-- | Compose two 'MutPart's one after the other.+--+-- Note this is also available (albeit flipped in arguments) through the+-- 'C.Category' instance.+compMP :: MutPart m a b -> MutPart m b c -> MutPart m a c+compMP (MutPart f) (MutPart g) = MutPart (g . f)+infixr 9 `compMP`++-- | The identity 'MutPart': simply focus into the same type itself.+--+-- Note this is also available through the 'C.Category' instance.+idMP :: MutPart m a a+idMP = MutPart id++instance C.Category (MutPart m) where+ id = idMP+ (.) = flip compMP++instance X.IsoHKD (MutPart m s) a++-- | 'MutPart' into the first field of a tuple reference.+mutFst :: MutPart m (a, b) a+mutFst = MutPart fst++-- | 'MutPart' into the second field of a tuple reference.+mutSnd :: MutPart m (a, b) b+mutSnd = MutPart snd++-- | Using a 'MutPart', perform a function on a @'Ref' m s@ as if you had+-- a @'Ref' m a@.+withPart+ :: MutPart m s a -- ^ How to zoom into an @a@ from an @s@+ -> Ref m s -- ^ The larger reference of @s@+ -> (Ref m a -> m r) -- ^ What do do with the smaller sub-reference of @a@+ -> m r+withPart mp x f = f (getMutPart mp x)++-- | With a 'MutPart', read out a specific part of a 'Ref'.+freezePart :: Mutable m a => MutPart m s a -> Ref m s -> m a+freezePart mp = freezeRef . getMutPart mp++-- | With a 'MutPart', overwrite into a specific part of a 'Ref'.+copyPart :: Mutable m a => MutPart m s a -> Ref m s -> a -> m ()+copyPart mp = copyRef . getMutPart mp++-- | 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 m MyType where+-- type Ref m MyType = GRef m 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+-- @+movePartInto+ :: Mutable m a+ => MutPart m s a+ -> Ref m s -- ^ bigger type (destination)+ -> Ref m a -- ^ smaller type (source)+ -> m ()+movePartInto mp = moveRef . getMutPart mp++-- | 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 m MyType where+-- type Ref m MyType = GRef m MyType+-- @+--+-- @+-- ghci> x <- thawRef $ MyType 3 4.5+-- ghci> y <- thawRef $ 100+-- ghci> movePartOver (fieldMut #mtInt) y x+-- ghci> freezeRef y+-- 3+-- @+movePartOver+ :: Mutable m a+ => MutPart m s a+ -> Ref m a -- ^ smaller type (destination)+ -> Ref m s -- ^ bigger type (source)+ -> m ()+movePartOver mp r = moveRef r . getMutPart mp++-- | 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 m MyType where+-- type Ref m MyType = GRef m 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+-- @+movePartWithin+ :: Mutable m a+ => MutPart m s a+ -> Ref m s -- ^ destination+ -> Ref m s -- ^ source+ -> m ()+movePartWithin mp r v = moveRef (getMutPart mp r) (getMutPart mp v)++-- | Clone out a subvalue of a larger 'Ref'.+clonePart+ :: Mutable m a+ => MutPart m s a+ -> Ref m s+ -> m (Ref m a)+clonePart mp = cloneRef . getMutPart mp++-- | 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 'V.Vector').+--+-- This is safe as long as you never again modify the mutable+-- reference, since it can potentially directly mutate the frozen value+-- magically.+unsafeFreezePart :: Mutable m a => MutPart m s a -> Ref m s -> m a+unsafeFreezePart mp = unsafeFreezeRef . getMutPart mp++++-- | With a 'MutPart', modify a specific part of a 'Ref' with a pure+-- function.+modifyPart :: Mutable m a => MutPart m s a -> Ref m s -> (a -> a) -> m ()+modifyPart mp = modifyRef . getMutPart mp++-- | 'modifyPart', but forces the result before storing it back in the+-- reference.+modifyPart' :: Mutable m a => MutPart m s a -> Ref m s -> (a -> a) -> m ()+modifyPart' mp = modifyRef' . getMutPart mp++-- | 'updateRef', under a 'MutPart' to only modify a specific part of+-- a 'Ref'.+updatePart :: Mutable m a => MutPart m s a -> Ref m s -> (a -> (a, b)) -> m b+updatePart mp = updateRef . getMutPart mp++-- | 'updatePart', but forces the result before storing it back in the+-- reference.+updatePart' :: Mutable m a => MutPart m s a -> Ref m s -> (a -> (a, b)) -> m b+updatePart' mp = updateRef' . getMutPart mp++-- | With a 'MutPart', modify a specific part of a 'Ref' with a monadic+-- function. Uses 'copyRef' into the reference after the action is+-- completed.+modifyPartM :: Mutable m a => MutPart m s a -> Ref m s -> (a -> m a) -> m ()+modifyPartM mp = modifyRefM . getMutPart mp++-- | 'modifyPartM', but forces the result before storing it back in the+-- reference.+modifyPartM' :: Mutable m a => MutPart m s a -> Ref m s -> (a -> m a) -> m ()+modifyPartM' mp = modifyRefM' . getMutPart mp++-- | 'updateRefM', under a 'MutPart' to only modify a specific part of+-- a 'Ref'. 'copyRef' into the reference after the action is completed.+updatePartM :: Mutable m a => MutPart m s a -> Ref m s -> (a -> m (a, b)) -> m b+updatePartM mp = updateRefM . getMutPart mp++-- | 'updatePartM', but forces the result before storing it back in the+-- reference.+updatePartM' :: Mutable m a => MutPart m s a -> Ref m s -> (a -> m (a, b)) -> m b+updatePartM' mp = updateRefM' . getMutPart mp++-- | A 'MutPart' for a field in a vinyl 'Data.Vinyl.Rec', automatically+-- generated as the first field with a matching type. This is polymorphic+-- to work over both 'Data.Vinyl.Rec' and 'Data.Vinyl.ARec'.+--+-- @+-- ghci> r <- 'thawRef' $ [1,2,3] 'V.:&' [True, False] :& 'V.RNil'+-- ghci> modifyPart (mutRec @Bool) r reverse+-- ghci> freezeRef r+-- [1,2,3] :& [False, True] :& RNil+-- @+mutRec+ :: forall a as f rec m.+ ( Ref m (rec f as) ~ rec (RecRef m f) as+ , RecElem rec a a as as (V.RIndex a as)+ , RecElemFCtx rec (RecRef m f)+ )+ => MutPart m (rec f as) (f a)+mutRec = MutPart $ getRecRef . rget @a @as @(RecRef m f) @rec++-- | A 'MutPart' to get into a 'CoerceRef'.+coerceRef :: (Ref m s ~ CoerceRef m s a) => MutPart m s a+coerceRef = MutPart coerce++-- | Handy wrapper over @'getMutPart' 'coerceRef'@.+withCoerceRef+ :: CoerceRef m s a+ -> (Ref m a -> m r)+ -> m r+withCoerceRef x f = f (coerce x)++-- | Typeclass used to implement 'hkdMutParts'. See documentation of+-- 'hkdMutParts' for more information.+class (Mutable m (z Identity), Ref m (z Identity) ~ z (RefFor m)) => HKDMutParts m z i o where+ hkdMutParts_ :: (z (RefFor m) -> i a) -> o a++instance (Mutable m (z Identity), Ref m (z Identity) ~ z (RefFor m)) => HKDMutParts m z (K1 i (RefFor m c)) (K1 i (MutPart m (z Identity) c)) where+ hkdMutParts_ f = K1 $ MutPart $ getRefFor . unK1 . f++instance (Mutable m (z Identity), Ref m (z Identity) ~ z (RefFor m)) => HKDMutParts m z U1 U1 where+ hkdMutParts_ _ = U1++instance (Mutable m (z Identity), Ref m (z Identity) ~ z (RefFor m), TypeError ('Text "Cannot use hkdMutParts for uninhabited types: " ':<>: 'ShowType z)) => HKDMutParts m z V1 V1 where+ hkdMutParts_ _ = undefined++instance HKDMutParts m z i o => HKDMutParts m z (M1 a b i) (M1 a b o) where+ hkdMutParts_ f = M1 $ hkdMutParts_ @m (unM1 . f)++instance (HKDMutParts m z i o, HKDMutParts m z i' o') => HKDMutParts m z (i :*: i') (o :*: o') where+ hkdMutParts_ f = hkdMutParts_ @m ((\(x:*:_)->x) . f) :*: hkdMutParts_ @m ((\(_:*:y)->y) . f)++instance (Mutable m (z Identity), Ref m (z Identity) ~ z (RefFor m), TypeError ('Text "Cannot use hkdMutParts for sum types: " ':<>: 'ShowType z)) => HKDMutParts m z (i :+: i') o where+ hkdMutParts_ _ = undefined++-- | 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 (MyTypeF 'Identity') where+-- type Ref (MyTypeF 'Identity') = MyTypeF ('RefFor' m)+--+-- mx :: MutPart m (MyTypeF Identity) ('V.Vector' Int)+-- my :: MutPart m (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.+hkdMutParts+ :: forall z m.+ ( Generic (z (RefFor m))+ , Generic (z (MutPart m (z Identity)))+ , HKDMutParts m z (Rep (z (RefFor m))) (Rep (z (MutPart m (z Identity))))+ )+ => z (MutPart m (z Identity))+hkdMutParts = to $ hkdMutParts_ @m @z from++-- | 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".+class (Mutable m s, Mutable m a) => FieldMut (fld :: Symbol) m s a | fld s -> a where+ -- | 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 m MyType where+ -- type Ref m MyType = 'GRef' m 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.+ fieldMut+ :: Label fld -- ^ field label (usually given using OverloadedLabels, @#blah)+ -> MutPart m s a++instance+ ( Mutable m s+ , Mutable m a+ , Ref m s ~ GRef m s+ , GL.GLens' (HasTotalFieldPSym fld) (GRef_ m (Rep s)) (Ref m a)+ , GL.HasField' fld s a+ )+ => FieldMut fld m s a where+ fieldMut _ = MutPart $ GLP.view (GL.glens @(HasTotalFieldPSym fld)) . unGRef++data HasTotalFieldPSym :: Symbol -> GL.TyFun (Type -> Type) (Maybe Type)+type instance GL.Eval (HasTotalFieldPSym sym) tt = GL.HasTotalFieldP sym tt++-- | A helpful wrapper over @'withPart' ('fieldMut' #blah)@. Create+-- a 'fieldMut' and directly use it.+withField+ :: FieldMut fld m s a+ => Label fld -- ^ field label (usually given using OverloadedLabels, @#blah)+ -> Ref m s -- ^ Larger record reference+ -> (Ref m a -> m b) -- ^ What to do with the mutable field+ -> m b+withField l = withPart (fieldMut l)++-- | A helpful wrapper around @'getMutPart' ('fieldMut' #blah)@. Directly+-- use a 'fieldMut' to access a mutable field.+mutField+ :: forall fld m s a. FieldMut fld m s a+ => Label fld -- ^ field label (usually given using OverloadedLabels, @#blah)+ -> Ref m s -- ^ Larger record reference+ -> Ref m a -- ^ Internal mutable field+mutField = getMutPart . fieldMut @_ @m++-- | 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".+class (Mutable m s, Mutable m a) => PosMut (i :: Nat) m s a | i s -> a where+ -- | 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 m MyType where+ -- type Ref m MyType = 'GRef' m 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.+ posMut :: MutPart m s a++instance+ ( Mutable m s+ , Mutable m a+ , Ref m s ~ GRef m s+ , gref ~ Fst (Traverse (GRef_ m (GL.CRep s)) 1)+ , Coercible (GRef_ m (Rep s) ()) (gref ())+ , GL.GLens' (HasTotalPositionPSym i) gref (Ref m a)+ , GL.HasPosition' i s a+ )+ => PosMut i m s a where+ posMut = MutPart $ GLP.view (GL.glens @(HasTotalPositionPSym i) @gref) . coerce @_ @(gref ()) . unGRef++data HasTotalPositionPSym :: Nat -> GL.TyFun (Type -> Type) (Maybe Type)+type instance GL.Eval (HasTotalPositionPSym t) tt = GL.HasTotalPositionP t tt++-- | A helpful wrapper over @'withPart' ('posMut' \@n)@. Create+-- a 'posMut' and directly use it.+withPos+ :: forall i m s a r. PosMut i m s a+ => Ref m s -- ^ Larger record reference+ -> (Ref m a -> m r) -- ^ What to do with the mutable field+ -> m r+withPos = withPart (posMut @i)++-- | A helpful wrapper around @'getMutPart' ('posMut' \@n)@. Directly+-- use a 'posMut' to access a mutable field.+mutPos+ :: forall i m s a. PosMut i m s a+ => Ref m s -- ^ Larger record reference+ -> Ref m a -- ^ Internal mutable field+mutPos = getMutPart (posMut @i @m)++-- | 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".+class (Mutable m s, Mutable m a) => TupleMut m s a | s -> a where+ -- | 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 m MyType where+ -- type Ref m MyType = 'GRef' m 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.+ tupleMut :: MutPart m s a++instance+ ( Mutable m s+ , Mutable m a+ , Ref m s ~ GRef m s+ , GL.GIsList (GRef_ m (Rep s)) (GRef_ m (Rep s)) (MapRef m as) (MapRef m as)+ , GL.GIsList (Rep s) (Rep s) as as+ , GL.ListTuple a as+ , GL.ListTuple b (MapRef m as)+ , Ref m a ~ b+ )+ => TupleMut m s a where+ tupleMut = MutPart $ GL.listToTuple+ . GLP.view GL.glist+ . unGRef++-- | A helpful wrapper over @'withPart' 'tupleMut'@. Directly operate on+-- the items in the data type, getting the references as a tuple. See+-- 'tupleMut' for more details on when this should work.+--+-- @+-- data MyType = MyType Int Double+-- deriving (Generic, Show)+--+-- instance Mutable m MyType where+-- type Ref m MyType = 'GRef' m 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+-- @+withTuple+ :: TupleMut m s a+ => Ref m s -- ^ Larger record reference+ -> (Ref m a -> m r) -- ^ What to do with each mutable field. The+ -- @'Ref' m a@ will be a tuple of every field's ref.+ -> m r+withTuple = withPart tupleMut+++-- stuff from generic-lens that wasn't exported++type G = Type -> Type++type family Traverse (a :: G) (n :: Nat) :: (G, Nat) where+ Traverse (M1 mt m s) n+ = Traverse1 (M1 mt m) (Traverse s n)+ Traverse (l :+: r) n+ = '(Fst (Traverse l n) :+: Fst (Traverse r n), n)+ Traverse (l :*: r) n+ = TraverseProd (:*:) (Traverse l n) r+ Traverse (K1 _ p) n+ = '(K1 (GL.Pos n) p, n + 1)+ Traverse U1 n+ = '(U1, n)++type family Traverse1 (w :: G -> G) (z :: (G, Nat)) :: (G, Nat) where+ Traverse1 w '(i, n) = '(w i, n)++-- | For products, we first traverse the left-hand side, followed by the second+-- using the counter returned by the left traversal.+type family TraverseProd (c :: G -> G -> G) (a :: (G, Nat)) (r :: G) :: (G, Nat) where+ TraverseProd w '(i, n) r = Traverse1 (w i) (Traverse r n)++type family Fst (p :: (a, b)) :: a where+ Fst '(a, b) = a