├── .gitignore ├── .tintin.yml ├── .travis.yml ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── bench └── bench.hs ├── doc ├── 01-getting-started.md ├── 02-mutable-and-ref.md ├── 03-automatic-instance-options.md ├── 04-instance-wrappers.md ├── 05-mutable-parts.md ├── 06-mutable-branches.md ├── 07-benchmarks.md ├── 08-resources.md └── index.md ├── package.yaml ├── src └── Data │ ├── Mutable.hs │ └── Mutable │ ├── Branches.hs │ ├── Class.hs │ ├── Instances.hs │ ├── Internal.hs │ ├── Internal │ └── TH.hs │ └── Parts.hs ├── stack.yaml └── stack.yaml.lock /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | mutable.cabal 3 | bench-results 4 | /dist-newstyle 5 | .ghc* 6 | *.dump-* 7 | *~ 8 | -------------------------------------------------------------------------------- /.tintin.yml: -------------------------------------------------------------------------------- 1 | color: bronze 2 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | script: 2 | - | 3 | set -ex 4 | case "$BUILD" in 5 | stack) 6 | stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps 7 | ;; 8 | cabal) 9 | cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 10 | 11 | ORIGDIR=$(pwd) 12 | for dir in $PACKAGES 13 | do 14 | cd $dir 15 | cabal check || [ "$CABALVER" == "1.16" ] 16 | cabal sdist 17 | PKGVER=$(cabal info . | awk '{print $2;exit}') 18 | SRC_TGZ=$PKGVER.tar.gz 19 | cd dist 20 | tar zxfv "$SRC_TGZ" 21 | cd "$PKGVER" 22 | cabal configure --enable-tests --ghc-options -O0 23 | cabal build 24 | if [ "$CABALVER" = "1.16" ] || [ "$CABALVER" = "1.18" ]; then 25 | cabal test 26 | else 27 | cabal test --show-details=streaming --log=/dev/stdout 28 | fi 29 | cd $ORIGDIR 30 | done 31 | ;; 32 | esac 33 | set +ex 34 | matrix: 35 | include: 36 | - env: BUILD=cabal GHCVER=8.6.5 CABALVER=2.4 HAPPYVER=1.19.5 ALEXVER=3.1.7 37 | addons: 38 | apt: 39 | sources: 40 | - hvr-ghc 41 | packages: 42 | - cabal-install-2.4 43 | - ghc-8.6.5 44 | - happy-1.19.5 45 | - alex-3.1.7 46 | compiler: ': #GHC 8.6.5' 47 | - env: BUILD=stack ARGS="" 48 | addons: 49 | apt: 50 | packages: 51 | - libgmp-dev 52 | compiler: ': #stack default' 53 | - env: BUILD=stack ARGS="--resolver lts-14" 54 | addons: 55 | apt: 56 | packages: 57 | - libgmp-dev 58 | compiler: ': #stack 8.6.5' 59 | - env: BUILD=stack ARGS="--resolver nightly" 60 | addons: 61 | apt: 62 | packages: 63 | - libgmp-dev 64 | compiler: ': #stack nightly' 65 | - env: BUILD=stack ARGS="" 66 | os: osx 67 | compiler: ': #stack default osx' 68 | - env: BUILD=stack ARGS="--resolver lts-14" 69 | os: osx 70 | compiler: ': #stack 8.6.5 osx' 71 | - env: BUILD=stack ARGS="--resolver nightly" 72 | os: osx 73 | compiler: ': #stack nightly osx' 74 | allow_failures: 75 | - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 76 | - env: BUILD=stack ARGS="--resolver nightly" 77 | install: 78 | - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo 79 | '?')]" 80 | - if [ -f configure.ac ]; then autoreconf -i; fi 81 | - | 82 | set -ex 83 | case "$BUILD" in 84 | stack) 85 | # Add in extra-deps for older snapshots, as necessary 86 | # 87 | # This is disabled by default, as relying on the solver like this can 88 | # make builds unreliable. Instead, if you have this situation, it's 89 | # recommended that you maintain multiple stack-lts-X.yaml files. 90 | 91 | #stack --no-terminal --install-ghc $ARGS test --bench --dry-run || ( \ 92 | # stack --no-terminal $ARGS build cabal-install && \ 93 | # stack --no-terminal $ARGS solver --update-config) 94 | 95 | # Build the dependencies 96 | stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies 97 | ;; 98 | cabal) 99 | cabal --version 100 | travis_retry cabal update 101 | 102 | # Get the list of packages from the stack.yaml file. Note that 103 | # this will also implicitly run hpack as necessary to generate 104 | # the .cabal files needed by cabal-install. 105 | PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@') 106 | 107 | cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 108 | ;; 109 | esac 110 | set +ex 111 | cache: 112 | directories: 113 | - $HOME/.ghc 114 | - $HOME/.cabal 115 | - $HOME/.stack 116 | - $TRAVIS_BUILD_DIR/.stack-work 117 | before_install: 118 | - unset CC 119 | - CABALARGS="" 120 | - if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi 121 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:/opt/alex/$ALEXVER/bin:/opt/happy/$HAPPYVER/bin:$HOME/.cabal/bin:$PATH 122 | - mkdir -p ~/.local/bin 123 | - | 124 | if [ `uname` = "Darwin" ] 125 | then 126 | travis_retry curl --insecure -L https://get.haskellstack.org/stable/osx-x86_64.tar.gz | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin 127 | else 128 | travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 129 | fi 130 | 131 | # Use the more reliable S3 mirror of Hackage 132 | mkdir -p $HOME/.cabal 133 | echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config 134 | echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config 135 | language: generic 136 | sudo: false 137 | 138 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | Changelog 2 | ========= 3 | 4 | Version 0.2.2.0 5 | --------------- 6 | 7 | *July 9, 2020* 8 | 9 | 10 | 11 | * Bugfix: *Generics* mechanisms for `MutBranch` for data types with more than 12 | two constructors fixed. 13 | 14 | Version 0.2.1.0 15 | --------------- 16 | 17 | *July 6, 2020* 18 | 19 | 20 | 21 | * Use TH to generate tuple instances for `Mutable` up to 12. 22 | * Use TH to generate `ListRefTuple` instances for lists up to length 12. 23 | Previously the instances up to the maximum length of `Mutable` tuple 24 | instances were missing. 25 | 26 | Version 0.2.0.0 27 | --------------- 28 | 29 | *July 5, 2020* 30 | 31 | 32 | 33 | * Demonadification: Revamp the typeclass system to be parameterized on the 34 | `s` `PrimState` state token, and not the monad itself. 35 | 36 | Version 0.1.0.1 37 | --------------- 38 | 39 | *February 11, 2020* 40 | 41 | 42 | 43 | * Update to work with *generic-lens-2.0.0.0* and *generic-lens-core-2.0.0.0*. 44 | 45 | Version 0.1.0.0 46 | --------------- 47 | 48 | *January 23, 2020* 49 | 50 | 51 | 52 | * Initial release 53 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Justin Le (c) 2020 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Justin Le nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [mutable][docs] 2 | =============== 3 | 4 | [![mutable on Hackage](https://img.shields.io/hackage/v/mutable.svg?maxAge=86400)](https://hackage.haskell.org/package/mutable) 5 | [![Build Status](https://travis-ci.org/mstksg/mutable.svg?branch=master)](https://travis-ci.org/mstksg/mutable) 6 | 7 | **[Documentation and Walkthrough][docs]** 8 | 9 | [docs]: https://mutable.jle.im 10 | 11 | **[Introductory Blog Post][blog]** 12 | 13 | [blog]: https://blog.jle.im/entry/introducing-the-mutable-library.html 14 | 15 | Beautiful Mutable Values 16 | ------------------------ 17 | 18 | **Mutability can be awesome!** 19 | 20 | Take back the power of **mutable objects** with all the **safety** and explicit 21 | state of Haskell. Associate and generate "piecewise-mutable" versions for your 22 | composite data types in a composable and automatic way. Think of it like a 23 | "generalized `MVector` for all ADTs". It also leverages GHC Generics to make 24 | working with piecewise mutability as simple as possible. 25 | 26 | Making piecewise updates on your giant composite data types (like artificial 27 | neural networks or game states in your game loop) got you down because they 28 | require re-allocating the entire value? Tired of requiring a full deep copy 29 | every time you make a small change, and want to be able to build mutable 30 | versions of your types automatically in composable ways? This is the package 31 | for you. 32 | 33 | Useful for a situation where you have a record with many fields (or many nested 34 | records) that you want to use for efficient mutable in-place algorithms. This 35 | library lets you do efficient "piecewise" mutations (operations that only edit 36 | one field), and also efficient entire-datatype copies/updates, as well, in many 37 | cases. 38 | 39 | Check out the [documentation home page][docs], [haddock reference][haddock], 40 | [introductory blog post on insights and lessons learned][blog], or read below 41 | for motivation and high-level descriptions. 42 | 43 | [haddock]: https://hackage.haskell.org/package/mutable 44 | 45 | Motivation 46 | ---------- 47 | 48 | ### Piecewise-Mutable 49 | 50 | For a simple motivating example where in-place piecewise mutations might be 51 | better, consider a large vector. 52 | 53 | Let's say you only want to edit the first item in a vector, multiple times. 54 | This is extremely inefficient with a pure vector: 55 | 56 | ```haskell 57 | addFirst :: Vector Double -> Vector Double 58 | addFirst xs = iterate incr xs !! 1000000 59 | where 60 | incr v = v V.// [(0, (v V.! 0) + 1)] 61 | ``` 62 | 63 | That's because `addFirst` will copy over the entire vector for every step 64 | --- every single item, even if not modified, will be copied one million times. 65 | It is `O(n*l)` in memory updates --- it is very bad for long vectors or large 66 | matrices. 67 | 68 | However, this is extremely efficient with a mutable vector: 69 | 70 | ```haskell 71 | addFirst :: Vector Double -> Vector Double 72 | addFirst xs = runST $ do 73 | v <- V.thaw xs 74 | replicateM_ 1000000 $ do 75 | MV.modify v 0 (+ 1) 76 | V.freeze v 77 | ``` 78 | 79 | (running this in `ST`, the mutable memory monad that comes with GHC) 80 | 81 | This is because all of the other items in the vector are kept the same and not 82 | copied-over over the course of one million updates. It is `O(n+l)` in memory 83 | updates. It is very good even for long vectors or large matrices. 84 | 85 | (Of course, this situation is somewhat contrived, but it isolates a problem that 86 | many programs face. A more common situation might be that you have two 87 | functions that each modify different items in a vector in sequence, and you 88 | want to run them many times interleaved, or one after the other.) 89 | 90 | ### Composite Datatype 91 | 92 | That all works for `MVector`, but let's say you have a simple composite data 93 | type that is two vectors: 94 | 95 | ```haskell 96 | data TwoVec = TV { tv1 :: Vector Double 97 | , tv2 :: Vector Double 98 | } 99 | deriving Generic 100 | ``` 101 | 102 | Is there a nice "piecewise-mutable" version of this? You *could* break up 103 | `TwoVec` manually into its pieces and treat each piece independently, but that method 104 | isn't composable. If only there was some equivalent of `MVector` for 105 | `TwoVec`...and some equivalent of `MV.modify`. 106 | 107 | That's where this library comes in. 108 | 109 | ```haskell 110 | instance Mutable s TwoVec where 111 | type Ref s TwoVec = GRef s TwoVec 112 | ``` 113 | 114 | This gives us `thawRef :: TwoVec -> m (GRef s TwoVec)`, where `GRef s TwoVec` 115 | is a mutable version of `TwoVec`, like how `MVector s Double` is a mutable 116 | version of `Vector Double`. It stores each field `tv1` and `tv2` as a seaprate 117 | `MVector` in memory that can be modified independently. 118 | 119 | Now we can write: 120 | 121 | ```haskell 122 | addFirst :: TwoVec -> TwoVec 123 | addFirst xs = runST $ do 124 | v <- thawRef xs 125 | replicateM_ 1000000 $ do 126 | withField #tv1 v $ \u -> 127 | MV.modify u 0 (+ 1) 128 | freezeRef v 129 | ``` 130 | 131 | This will in-place edit only the first item in the `tv1` field one million 132 | times, without ever needing to copy over the contents `tv2`. Basically, it 133 | gives you a version of `TwoVec` that you can modify in-place piecewise. You 134 | can compose two functions that each work piecewise on `TwoVec`: 135 | 136 | ```haskell 137 | mut1 :: Ref s TwoVec -> ST s () 138 | mut1 v = do 139 | withField #tv1 v $ \u -> 140 | MV.modify u 0 (+ 1) 141 | MV.modify u 1 (+ 2) 142 | withField #tv2 v $ \u -> 143 | MV.modify u 2 (+ 3) 144 | MV.modify u 3 (+ 4) 145 | 146 | mut2 :: Ref s TwoVec -> ST s () 147 | mut2 v = do 148 | withField #tv1 v $ \u -> 149 | MV.modify u 4 (+ 1) 150 | MV.modify u 5 (+ 2) 151 | withField #tv2 v $ \u -> 152 | MV.modify u 6 (+ 3) 153 | MV.modify u 7 (+ 4) 154 | 155 | doAMillion :: TwoVec -> TwoVec 156 | doAMillion xs = runST $ do 157 | v <- thawRef xs 158 | replicateM_ 1000000 $ do 159 | mut1 v 160 | mut2 v 161 | freezeRef v 162 | ``` 163 | 164 | This is a type of composition and interleaving that cannot be achieved by 165 | simply breaking down `TwoVec` and running functions that work purely on each of 166 | the two vectors individually. 167 | 168 | Mutable Sum Types 169 | ----------------- 170 | 171 | There is also support for mutable sum types, as well. Here is the automatic 172 | definition of a *[mutable linked list][ll]*: 173 | 174 | [ll]: https://en.wikipedia.org/wiki/Linked_list 175 | 176 | ```haskell 177 | data List a = Nil | Cons a (List a) 178 | deriving (Show, Generic) 179 | infixr 5 `Cons` 180 | 181 | instance Mutable s a => Mutable s (List a) where 182 | type Ref s (List a) = GRef s (List a) 183 | ``` 184 | 185 | We can write a function to "pop" out the top value and shift the rest of the 186 | list up: 187 | 188 | ```haskell 189 | popStack 190 | :: Mutable s a 191 | => Ref s (List a) 192 | -> ST s (Maybe a) 193 | popStack xs = do 194 | c <- projectBranch (constrMB #_Cons) xs 195 | forM c $ \(y, ys) -> do 196 | o <- freezeRef y 197 | moveRef xs ys 198 | pure o 199 | ``` 200 | 201 | ```haskell 202 | ghci> runST $ do 203 | r <- thawRef $ 1 `Cons` 2 `Cons` 3 `Cons` Nil 204 | y <- popStack r 205 | (y,) <$> freezeRef r 206 | -- => (Just 1, 2 `Cons` 3 `Cons` Nil) 207 | ``` 208 | 209 | Show me the numbers 210 | ------------------- 211 | 212 | Here are some benchmark cases --- only bars of the same color are comparable, 213 | and shorter bars are better (performance-wise). 214 | 215 | ![Benchmarks](https://i.imgur.com/S95TuiM.png) 216 | 217 | There are four situations here, compared and contrasted between pure and 218 | mutable versions 219 | 220 | 1. A large ADT with 256 fields, generated by repeated nestings of `data V4 a = 221 | V4 !a !a !a !a` 222 | 223 | 1. Updating only a single part (one field out of 256) 224 | 2. Updating the entire ADT (all 256 fields) 225 | 226 | 2. A composite data type of four `Vector`s of 500k elements each, so 2 million 227 | elements total. 228 | 229 | 1. Updating only a single part (one item out of 2 million) 230 | 2. Updating all elements of all four vectors (all 2 million items) 231 | 232 | We can see four conclusions: 233 | 234 | 1. For a large ADT, updating a single field (or multiple fields, interleaved) 235 | is going to be faster with *mutable*. This speedup is between x4 and x5, 236 | suggesting it is a speedup arising from the fact that the top-level type 237 | has four fields. 238 | 2. For a large ADT, updating the whole ADT (so just replacing the entire 239 | thing, no actual copies) is faster just as a pure value by a large factor 240 | (which is a big testament to GHC). 241 | 3. For a small ADT with huge vectors, updating a single field is *much* faster 242 | with *mutable*. 243 | 4. For a small ADT with huge vectors, updating the entire value (so, the 244 | entire vectors and entire ADT) is actually faster with *mutable* as well. 245 | 246 | Interestingly, the "update entire structure" case (which should be the 247 | worst-case for *mutable* and the best-case for pure values) actually becomes 248 | faster with *mutable* when you get to the region of *many* values... somewhere 249 | between 256 and 2 million, apparently. However, this may just be from the 250 | efficiency of modifying vectors sequentially. 251 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /bench/bench.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE DeriveFoldable #-} 4 | {-# LANGUAGE DeriveFunctor #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | {-# LANGUAGE DeriveTraversable #-} 7 | {-# LANGUAGE DerivingVia #-} 8 | {-# LANGUAGE FlexibleContexts #-} 9 | {-# LANGUAGE FlexibleInstances #-} 10 | {-# LANGUAGE LambdaCase #-} 11 | {-# LANGUAGE MultiParamTypeClasses #-} 12 | {-# LANGUAGE NumericUnderscores #-} 13 | {-# LANGUAGE OverloadedLabels #-} 14 | {-# LANGUAGE QuantifiedConstraints #-} 15 | {-# LANGUAGE RankNTypes #-} 16 | {-# LANGUAGE ScopedTypeVariables #-} 17 | {-# LANGUAGE TemplateHaskell #-} 18 | {-# LANGUAGE TypeApplications #-} 19 | {-# LANGUAGE TypeApplications #-} 20 | {-# LANGUAGE TypeFamilies #-} 21 | {-# LANGUAGE TypeOperators #-} 22 | {-# OPTIONS_GHC -fno-warn-orphans #-} 23 | {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} 24 | 25 | import Control.Category ((.)) 26 | import Control.DeepSeq 27 | import Control.Monad.ST 28 | import Control.Monad.Trans.Class 29 | import Control.Monad.Trans.Cont 30 | import Control.Monad.Trans.State 31 | import Criterion.Main 32 | import Criterion.Types 33 | import Data.Foldable 34 | import Data.Mutable 35 | import Data.Time 36 | import Data.Vector (Vector) 37 | import Data.Vinyl.Functor 38 | import GHC.Generics 39 | import Lens.Micro 40 | import Lens.Micro.TH 41 | import Prelude hiding ((.)) 42 | import System.Directory 43 | import qualified Data.Vector as V 44 | import qualified Data.Vector.Mutable as MV 45 | 46 | data V4 a = V4 { _v4X :: !a 47 | , _v4Y :: !a 48 | , _v4Z :: !a 49 | , _v4W :: !a 50 | } 51 | deriving (Show, Generic, Functor, Foldable, Traversable) 52 | 53 | instance NFData a => NFData (V4 a) 54 | instance Mutable s a => Mutable s (V4 a) where 55 | type Ref s (V4 a) = GRef s (V4 a) 56 | instance Applicative V4 where 57 | pure x = V4 x x x x 58 | V4 a b c d <*> V4 x y z w = V4 (a x) (b y) (c z) (d w) 59 | makeLenses 'V4 60 | 61 | newtype V256 a = V256 { _v256 :: V4 (V4 (V4 (V4 a))) } 62 | deriving (Show, Generic, Functor, Foldable, Traversable) 63 | deriving Applicative via (V4 :.: V4 :.: V4 :.: V4) 64 | instance NFData a => NFData (V256 a) 65 | instance Mutable s a => Mutable s (V256 a) where 66 | type Ref s (V256 a) = CoerceRef s (V256 a) (V4 (V4 (V4 (V4 a)))) 67 | makeLenses 'V256 68 | 69 | -- HKD variant of V4 70 | data V4F a f = V4F { _vf4X :: !(f a) 71 | , _vf4Y :: !(f a) 72 | , _vf4Z :: !(f a) 73 | , _vf4W :: !(f a) 74 | } 75 | deriving (Show, Generic) 76 | instance NFData (f a) => NFData (V4F a f) 77 | instance Mutable s a => Mutable s (V4F a Identity) where 78 | type Ref s (V4F a Identity) = V4F a (RefFor s) 79 | 80 | -- HKD variant of V256 81 | newtype V256F a = V256F { _v256F :: V4F (V4F (V4F (V4F a Identity) Identity) Identity) Identity } 82 | deriving (Show, Generic) 83 | instance NFData a => NFData (Identity a) 84 | instance NFData a => NFData (V256F a) 85 | instance Mutable s a => Mutable s (V256F a) where 86 | type Ref s (V256F a) = CoerceRef s (V256F a) (V4F (V4F (V4F (V4F a Identity) Identity) Identity) Identity) 87 | 88 | 89 | type ADT = V256 Double 90 | type ADTF = V256F Double 91 | type Vec = V4 (Vector Double) 92 | type VecF = V4F (Vector Double) Identity 93 | 94 | pureLoop :: (a -> a) -> Int -> a -> a 95 | pureLoop f n = go 0 96 | where 97 | go !i !x 98 | | i < n = go (i + 1) (f x) 99 | | otherwise = x 100 | 101 | modifyPartPure :: Int -> ADT -> ADT 102 | modifyPartPure = pureLoop $ over (v256 . v4X . v4X . v4X . v4X) (+1) 103 | 104 | modifyWholePure :: Int -> ADT -> ADT 105 | modifyWholePure = pureLoop $ fmap (+ 1) 106 | 107 | modifyPartPureV :: Int -> Vec -> Vec 108 | modifyPartPureV = pureLoop $ over v4X $ \v -> v V.// [(0, (v V.! 0) + 1)] 109 | 110 | modifyWholePureV :: Int -> Vec -> Vec 111 | modifyWholePureV = pureLoop $ (fmap . fmap) (+ 1) 112 | 113 | 114 | 115 | 116 | mutLoop :: (forall s. Mutable s a) => (forall s. Ref s a -> ST s ()) -> Int -> a -> a 117 | mutLoop f n x0 = runST $ do 118 | r <- thawRef x0 119 | let go !i 120 | | i < n = do 121 | f r 122 | go (i + 1) 123 | | otherwise = pure () 124 | go 0 125 | unsafeFreezeRef r 126 | 127 | modifyPartMut :: (forall s. Mutable s a) => (forall s. MutPart s a Double) -> Int -> a -> a 128 | modifyPartMut f = mutLoop $ \r -> modifyPart' f r (+1) 129 | 130 | modifyWholeMut :: (forall s b. Mutable s b => Ref s (V4 b) -> ContT () (ST s) (Ref s b)) -> Int -> ADT -> ADT 131 | modifyWholeMut f = mutLoop $ \r -> 132 | withAllRefV256 f r $ \s -> 133 | modifyRef s (+ 1) 134 | 135 | modifyWholeMutHKD :: Int -> ADTF -> ADTF 136 | modifyWholeMutHKD = mutLoop $ \r -> 137 | withAllRefV256HKD r $ \s -> 138 | modifyRef s (+ 1) 139 | 140 | modifyPartMutV :: (forall s. Mutable s a) => (forall s. MutPart s a (Vector Double)) -> Int -> a -> a 141 | modifyPartMutV f = mutLoop $ \r -> withPart f r $ \mv -> 142 | (MV.write mv 0 $!) . (+ 1) =<< MV.read mv 0 143 | 144 | modifyWholeMutV :: (forall s. Mutable s a) => (forall s. Ref s a -> ContT () (ST s) (MV.MVector s Double)) -> Int -> a -> a 145 | modifyWholeMutV f = mutLoop $ \r -> runContT (f r) $ \mv -> do 146 | forM_ [0 .. MV.length mv - 1] $ \i -> 147 | (MV.write mv i $!) . (+ 1) =<< MV.read mv i 148 | 149 | main :: IO () 150 | main = do 151 | t <- getZonedTime 152 | let tstr = formatTime defaultTimeLocale "%Y%m%d-%H%M%S" t 153 | createDirectoryIfMissing True "bench-results" 154 | defaultMainWith defaultConfig 155 | { reportFile = Just $ "bench-results/mutable-bench_" ++ tstr ++ ".html" 156 | , timeLimit = 10 157 | } [ 158 | bgroup "adt-256" [ 159 | bgroup "part-50M" 160 | [ bench "pure" $ nf (modifyPartPure 50_000_000) bigADT 161 | -- , bench "mutable" $ nf (modifyPartMut (partRep (fieldMut #_v4X)) 50_000_000) bigADT 162 | , bgroup "mutable" [ 163 | bench "field" $ nf (modifyPartMut (partRep (fieldMut #_v4X)) 50_000_000) bigADT 164 | , bench "pos" $ nf (modifyPartMut (partRep (posMut @1 )) 50_000_000) bigADT 165 | , bench "tuple" $ nf (modifyPartMut (partRep firstTuple ) 50_000_000) bigADT 166 | , bench "hkd" $ nf (modifyPartMut modPartHKD 50_000_000) bigADTF 167 | ] 168 | ] 169 | , bgroup "whole-20K" 170 | [ bench "pure" $ nf (modifyWholePure 20_000) bigADT 171 | -- , bench "mutable" $ nf (modifyWholeMut withAllRefV4Field 20_000) bigADT 172 | , bgroup "mutable" [ 173 | bench "field" $ nf (modifyWholeMut withAllRefV4Field 20_000) bigADT 174 | , bench "pos" $ nf (modifyWholeMut withAllRefV4Pos 20_000) bigADT 175 | , bench "tuple" $ nf (modifyWholeMut withAllRefV4Tuple 20_000) bigADT 176 | , bench "hkd" $ nf (modifyWholeMutHKD 20_000) bigADTF 177 | ] 178 | ] 179 | ] 180 | , bgroup "vector-2M" [ 181 | bgroup "part-100" 182 | [ bench "pure" $ nf (modifyPartPureV 100) bigVec 183 | -- , bench "mutable" $ nf (modifyPartMutV (fieldMut #_v4X) 100) bigVec 184 | , bgroup "mutable" [ 185 | bench "field" $ nf (modifyPartMutV (fieldMut #_v4X) 100) bigVec 186 | , bench "pos" $ nf (modifyPartMutV (posMut @1 ) 100) bigVec 187 | , bench "tuple" $ nf (modifyPartMutV (firstTuple ) 100) bigVec 188 | , bench "hkd" $ nf (modifyPartMutV (_vf4X vfParts) 100) bigVecF 189 | ] 190 | ] 191 | , bgroup "whole-3" 192 | [ bench "pure" $ nf (modifyWholePureV 3) bigVec 193 | -- , bench "mutable" $ nf (modifyWholeMutV withAllRefV4Field 3) bigVec 194 | , bgroup "mutable" [ 195 | bench "field" $ nf (modifyWholeMutV withAllRefV4Field 3) bigVec 196 | , bench "pos" $ nf (modifyWholeMutV withAllRefV4Pos 3) bigVec 197 | , bench "tuple" $ nf (modifyWholeMutV withAllRefV4Tuple 3) bigVec 198 | , bench "hkd" $ nf (modifyWholeMutV withAllRefV4HKD 3) bigVecF 199 | ] 200 | ] 201 | ] 202 | ] 203 | where 204 | bigADT :: ADT 205 | !bigADT = populate $ pure () 206 | bigADTF :: ADTF 207 | !bigADTF = toADTF bigADT 208 | bigVec :: Vec 209 | !bigVec = getCompose . populate . Compose $ pure (V.replicate 500_000 ()) 210 | bigVecF :: VecF 211 | !bigVecF = toVF bigVec 212 | 213 | 214 | 215 | toADTF :: ADT -> ADTF 216 | toADTF = V256F 217 | . toVF . fmap (toVF . fmap (toVF . fmap toVF)) 218 | . _v256 219 | 220 | toVF :: V4 a -> V4F a Identity 221 | toVF (V4 a b c d) = V4F (Identity a) (Identity b) (Identity c) (Identity d) 222 | 223 | vfParts :: forall s a. Mutable s a => V4F a (MutPart s (V4F a Identity)) 224 | vfParts = hkdMutParts @(V4F a) 225 | 226 | partRep :: Mutable s a => (forall b. Mutable s b => MutPart s (V4 b) b) -> MutPart s (V256 a) a 227 | partRep f = f . f . f . f . coerceRef 228 | 229 | firstTuple :: Mutable s a => MutPart s (V4 a) a 230 | firstTuple = MutPart (\(x,_,_,_) -> x) . tupleMut 231 | 232 | modPartHKD :: Mutable s a => MutPart s (V256F a) a 233 | modPartHKD = _vf4X vfParts 234 | . _vf4X vfParts 235 | . _vf4X vfParts 236 | . _vf4X vfParts 237 | . coerceRef 238 | 239 | 240 | 241 | withAllRefV4Field :: (Mutable s a, Monad m) => Ref s (V4 a) -> ContT () m (Ref s a) 242 | withAllRefV4Field r = ContT $ \f -> do 243 | withPart (fieldMut #_v4X) r f 244 | withPart (fieldMut #_v4Y) r f 245 | withPart (fieldMut #_v4Z) r f 246 | withPart (fieldMut #_v4W) r f 247 | 248 | withAllRefV4Pos :: (Mutable s a, Monad m) => Ref s (V4 a) -> ContT () m (Ref s a) 249 | withAllRefV4Pos r = ContT $ \f -> do 250 | withPart (posMut @1) r f 251 | withPart (posMut @2) r f 252 | withPart (posMut @3) r f 253 | withPart (posMut @4) r f 254 | 255 | withAllRefV4Tuple :: (Mutable s a, Monad m) => Ref s (V4 a) -> ContT () m (Ref s a) 256 | withAllRefV4Tuple r = ContT $ \f -> 257 | withTuple r $ \(x, y, z, w) -> do 258 | f x 259 | f y 260 | f z 261 | f w 262 | 263 | withAllRefV4HKD :: forall m s a. (Mutable s a, Monad m) => V4F a (RefFor s) -> ContT () m (Ref s a) 264 | withAllRefV4HKD r = ContT $ \f -> do 265 | withPart (_vf4X vfParts) r f 266 | withPart (_vf4Y vfParts) r f 267 | withPart (_vf4Z vfParts) r f 268 | withPart (_vf4W vfParts) r f 269 | 270 | withAllRefV256 271 | :: (Mutable s a, Monad m) 272 | => (forall b. Mutable s b => Ref s (V4 b) -> ContT () m (Ref s b)) 273 | -> Ref s (V256 a) 274 | -> (Ref s a -> m ()) 275 | -> m () 276 | withAllRefV256 a r f = flip runContT pure $ do 277 | s <- a =<< a =<< a =<< a 278 | =<< ContT (withPart coerceRef r) 279 | lift $ f s 280 | 281 | 282 | withAllRefV256HKD :: (Mutable s a, Monad m) => Ref s (V256F a) -> (Ref s a -> m ()) -> m () 283 | withAllRefV256HKD r f = flip runContT pure $ do 284 | s <- withAllRefV4HKD 285 | =<< withAllRefV4HKD 286 | =<< withAllRefV4HKD 287 | =<< withAllRefV4HKD 288 | =<< ContT (withPart coerceRef r) 289 | lift $ f s 290 | 291 | populate :: Traversable f => f () -> f Double 292 | populate = flip evalState 0 . traverse go 293 | where 294 | go _ = state $ \i -> (fromInteger i, i + 1) 295 | 296 | -------------------------------------------------------------------------------- /doc/01-getting-started.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Getting Started 3 | --- 4 | 5 | Getting Started 6 | =============== 7 | 8 | ```haskell top hide 9 | {-# LANGUAGE DeriveGeneric #-} 10 | {-# LANGUAGE FlexibleInstances #-} 11 | {-# LANGUAGE MultiParamTypeClasses #-} 12 | {-# LANGUAGE OverloadedLabels #-} 13 | {-# LANGUAGE TupleSections #-} 14 | {-# LANGUAGE TypeFamilies #-} 15 | 16 | import Control.Monad 17 | import Data.Mutable 18 | import Data.Primitive.MutVar 19 | import GHC.Generics 20 | ``` 21 | 22 | If you have a data type like: 23 | 24 | ```haskell top 25 | import qualified Data.Vector as V 26 | import qualified Data.Vector.Mutable as MV 27 | 28 | data MyType = MT 29 | { mtInt :: Int 30 | , mtDouble :: Double 31 | , mtVec :: V.Vector Double 32 | } 33 | deriving (Show, Generic) 34 | ``` 35 | 36 | Then you can give it an automatically derived mutable version: 37 | 38 | ```haskell top 39 | instance Mutable s MyType where 40 | type Ref s MyType = GRef s MyType 41 | ``` 42 | 43 | `Ref s MyType` is now a "mutable `MyType`", like how `MVector s a` is a 44 | "mutable `Vector a`". 45 | 46 | We now have some nice operations: 47 | 48 | Whole-wise operations 49 | --------------------- 50 | 51 | Sometimes you just want to operate on the whole `MyType`. Well, you now have: 52 | 53 | ```haskell 54 | -- | Allocate a mutable 'MyType' in 'ST' 55 | thawRef 56 | :: MyType 57 | -> ST s (Ref s MyType) 58 | 59 | -- | "Freeze" a mutable 'MyType' 60 | freezeRef 61 | :: Ref s MyType 62 | -> ST s MyType 63 | 64 | -- | Overwrite a mutable 'MyType' with the contents of a pure one. 65 | copyRef 66 | :: Ref s MyType 67 | -> MyType 68 | -> ST s () 69 | 70 | -- | Run an updating function on a whole 'MyType' 71 | modifyRef 72 | :: Ref s MyType 73 | -> (MyType -> MyType) 74 | -> ST s () 75 | ``` 76 | 77 | These actions are the types specialized `ST`, the mutable memory monad that 78 | comes with GHC. In truth, the types of these are more polymorphic and are 79 | generalized to work for all mutable monads with `PrimMonad` instance. The 80 | fully general types are: 81 | 82 | ```haskell 83 | -- | Allocate a mutable 'MyType' in the monad m 84 | thawRef 85 | :: (PrimMonad m, PrimState m ~ s) 86 | => MyType 87 | -> m (Ref s MyType) 88 | 89 | -- | "Freeze" a mutable 'MyType' 90 | freezeRef 91 | :: (PrimMonad m, PrimState m ~ s) 92 | => Ref s MyType 93 | -> m MyType 94 | 95 | -- | Overwrite a mutable 'MyType' with the contents of a pure one. 96 | copyRef 97 | :: (PrimMonad m, PrimState m ~ s) 98 | => Ref s MyType 99 | -> MyType 100 | -> m () 101 | 102 | -- | Run an updating function on a whole 'MyType' 103 | modifyRef 104 | :: (PrimMonad m, PrimState m ~ s) 105 | => Ref s MyType 106 | -> (MyType -> MyType) 107 | -> m () 108 | ``` 109 | 110 | Piecewise Operations 111 | -------------------- 112 | 113 | This is nice, but we really the juicy stuff: a way to modify each part 114 | individually. For that, we have two main mechanisms: the field name based 115 | ones (using `-XOverloadedLabels`), and the position based ones (using 116 | `-XTypeApplications`). We have the continuation-based combinators: 117 | 118 | ```haskell 119 | -- | Do something with the 'Int' field 120 | withField #mtInt 121 | :: (PrimMonad m, PrimState m ~ s) 122 | => Ref s MyType 123 | -> (MutVar s Int -> m r) 124 | -> m r 125 | 126 | -- | Do something with the 'Vector' field 127 | withField #mtVec 128 | :: (PrimMonad m, PrimState m ~ s) 129 | => Ref s MyType 130 | -> (MVector s Double -> m r) 131 | -> m r 132 | 133 | -- | Do something with the second field, the Double 134 | withPos @2 135 | :: (PrimMonad m, PrimState m ~ s) 136 | => Ref s MyType 137 | -> (MutVar s Double -> m r) 138 | -> m r 139 | 140 | -- | Do something with a tuple of each ref in the type 141 | withTuple 142 | :: (PrimMonad m, PrimState m ~ s) 143 | => Ref s MyType 144 | -> ((MutVar s Int, MutVar s Double, MVector s Double) -> m r) 145 | -> m r 146 | ``` 147 | 148 | And the `MutPart`-based ones, which yield a `MutPart s b a` (a way to "zoom 149 | into" a mutable `a`, if you have a mutable `b`), which can be used with 150 | functions like `modifyPart` and `freezePart`: 151 | 152 | ```haskell 153 | -- | Data type to "focus in" on the 'mtDouble' field in a 'MyType' 154 | fieldMut #mtDouble 155 | :: MutPart s MyType Double 156 | 157 | -- | Modify the 'Double' in the mutable 'MyType' 158 | modifyPart (fieldMut #mtDouble) 159 | :: Ref s MyType 160 | -> (Double -> Double) 161 | -> m () 162 | ``` 163 | 164 | ```haskell 165 | -- | Data type to "focus in" on the first item in a 'MyType' 166 | posMut @1 167 | :: MutPart s MyType Int 168 | 169 | -- | Read out the 'Int' in the mutable 'MyType' 170 | freezePart (posMut @1) 171 | :: Ref s MyPart 172 | -> s Int 173 | ``` 174 | 175 | 176 | Sum Types 177 | --------- 178 | 179 | We can get `GRef` for sum types too. As shown earlier, we get a mutable linked 180 | list type for free, and a nice "pop" function if we utilize `constrMB`: 181 | 182 | ```haskell top 183 | data List a = Nil | Cons a (List a) 184 | deriving (Show, Generic) 185 | infixr 5 `Cons` 186 | 187 | instance Mutable s a => Mutable s (List a) where 188 | type Ref s (List a) = GRef s (List a) 189 | 190 | consBranch 191 | :: Mutable s a 192 | => MutBranch s (List a) (a, List a) 193 | consBranch = constrMB #_Cons 194 | 195 | popStack 196 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 197 | => Ref s (List a) 198 | -> m (Maybe a) 199 | popStack xs = do 200 | c <- projectBranch consBranch xs 201 | forM c $ \(y, ys) -> do 202 | o <- freezeRef y 203 | moveRef xs ys 204 | pure o 205 | ``` 206 | 207 | [Read on](/02-mutable-and-ref.html) for more information on how the library 208 | works, or jump right into the library with **[Haddock Documentation][docs]**! 209 | 210 | [docs]: https://hackage.haskell.org/package/mutable 211 | -------------------------------------------------------------------------------- /doc/02-mutable-and-ref.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Mutable and Ref 3 | --- 4 | 5 | Mutable and Ref 6 | =============== 7 | 8 | ```haskell top hide 9 | {-# LANGUAGE DeriveGeneric #-} 10 | {-# LANGUAGE FlexibleInstances #-} 11 | {-# LANGUAGE MultiParamTypeClasses #-} 12 | {-# LANGUAGE OverloadedLabels #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | 15 | import Control.Monad 16 | import Data.Mutable 17 | import Data.Primitive.MutVar 18 | import GHC.Generics 19 | import qualified Data.Vector as V 20 | import qualified Data.Vector.Mutable as MV 21 | ``` 22 | 23 | Let's go over the high level view of what's going on. Conceptually, the entire 24 | library revolves around the `Mutable` typeclass and the `Ref` associated type. 25 | 26 | ```haskell 27 | class Mutable s a where 28 | type Ref s a = v | v -> a s 29 | 30 | thawRef :: (PrimMonad m, PrimState m ~ s) => a -> m (Ref s a) 31 | freezeRef :: (PrimMonad m, PrimState m ~ s) => Ref s a -> m a 32 | copyRef :: (PrimMonad m, PrimState m ~ s) => Ref s a -> a -> m () 33 | 34 | -- ... plus some more methods that can be implemented using 35 | -- the others in most cases 36 | ``` 37 | 38 | An instance of `Mutable s a` is an `a` that has a "mutable version" that can be 39 | updated/mutated in a "mutable `PrimMonad m`" (like `IO` or `ST`) that has a 40 | state token `s`. 41 | 42 | The (injective) type family `Ref` associates every type `a` with its "mutable 43 | version". 44 | 45 | (A quick note on `PrimMonad` --- it comes from the *[primitive][]* library and 46 | is used across the ecosystem; it's a typeclass that abstracts over all "impure" 47 | monads like `IO`, `ST s`, `ReaderT r IO`, etc. You can think of it as an 48 | expanded version of `MonadIO` to also include monads that use `ST s`. 49 | `PrimState` is what you give to `MutVar` and `MVector` to make things "work 50 | properly") 51 | 52 | [primitive]: https://hackage.haskell.org/package/primitive 53 | 54 | For example, for *[Vector][]*, the "mutable version" is an *[MVector][]*: 55 | 56 | [Vector]: https://hackage.haskell.org/package/vector/docs/Data-Vector.html 57 | [MVector]: https://hackage.haskell.org/package/vector/docs/Data-Vector-Mutable.html 58 | 59 | ```haskell 60 | class Mutable s (Vector a) where 61 | type Ref s (Vector a) = MVector s a 62 | 63 | thawRef = V.thaw 64 | freezeRef = V.freeze 65 | copyRef = V.copy 66 | ``` 67 | 68 | For simple non-composite data types like `Int`, you can just use a 69 | *[MutVar][]* (a polymorphic version of `IORef`/`STRef`): 70 | 71 | [MutVar]: https://hackage.haskell.org/package/primitive/docs/Data-Primitive-MutVar.html 72 | 73 | ```haskell 74 | class Mutable s Int where 75 | type Ref s Int = MutVar s Int 76 | 77 | thawRef = newMutVar 78 | freezeRef = readMutVar 79 | copyRef = writeMutVar 80 | 81 | class Mutable s Double where 82 | type Ref s Int = MutVar s Double 83 | 84 | thawRef = newMutVar 85 | freezeRef = readMutVar 86 | copyRef = writeMutVar 87 | ``` 88 | 89 | All we are doing so far is associating a type with its "mutable" version. But, 90 | what happens if we had some composite type? 91 | 92 | ```haskell top 93 | data MyType = MT 94 | { mtInt :: Int 95 | , mtDouble :: Double 96 | , mtVec :: V.Vector Double 97 | } 98 | deriving (Show, Generic) 99 | ``` 100 | 101 | We might imagine making a piecewise-mutable version of it, where each field is 102 | its own mutable reference: 103 | 104 | ```haskell 105 | data MyTypeRef s = MTR 106 | { mtrInt :: MutVar s Int 107 | , mtrDouble :: MutVar s Double 108 | , mtrVec :: MV.MVector s Double 109 | } 110 | 111 | instance Mutable s MyType where 112 | type Ref s MyType = MyTypeRef s 113 | 114 | thawRef (MT x y z) = MTR <$> newMutVar x 115 | <*> newMutVar y 116 | <*> V.thaw z 117 | 118 | freezeRef (MTR x y z) = MT <$> readMutVar x 119 | <*> readMutVar y 120 | <*> V.freeze z 121 | 122 | copyRef (MTR a b c) (MT x y z) = do 123 | writeMutVar a x 124 | writeMutVar b y 125 | V.copy c z 126 | ``` 127 | 128 | But, this is pretty tedious to write for every single data type we have. What 129 | if we could instead automatically derive a reference type? 130 | 131 | Well, we're in luck. If `MyType` is an instance of `Generic`, then we can just 132 | write: 133 | 134 | ```haskell 135 | instance Mutable s MyType where 136 | type Ref MyType = GRef s MyType 137 | ``` 138 | 139 | We can now leave the rest of the typeclass body blank...and the *mutable* 140 | library will do the rest for us! 141 | 142 | * `GRef s MyType` is an automatically derived type that is equivalent to 143 | the `MyTypeRef` that we wrote earlier. It leverages the power of GHC 144 | generics and typeclasses. Every field of type `X` turns into a field of 145 | type `Ref s X`. This "does the right thing" as long as all your fields are 146 | instances of `Mutable`. 147 | * The mechanisms in `DefaultMutable` will automatically fill in the rest of 148 | the typeclass for you. 149 | 150 | -------------------------------------------------------------------------------- /doc/03-automatic-instance-options.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Automatic Instance Options 3 | --- 4 | 5 | Automatic Instance Options 6 | ========================== 7 | 8 | ```haskell top hide 9 | {-# LANGUAGE DeriveFoldable #-} 10 | {-# LANGUAGE DeriveFunctor #-} 11 | {-# LANGUAGE DeriveGeneric #-} 12 | {-# LANGUAGE DeriveTraversable #-} 13 | {-# LANGUAGE FlexibleInstances #-} 14 | {-# LANGUAGE LambdaCase #-} 15 | {-# LANGUAGE MultiParamTypeClasses #-} 16 | {-# LANGUAGE OverloadedLabels #-} 17 | {-# LANGUAGE StandaloneDeriving #-} 18 | {-# LANGUAGE TypeFamilies #-} 19 | 20 | import Control.Monad 21 | import Control.Monad.ST 22 | import Data.Mutable 23 | import Data.Primitive.MutVar 24 | import Data.Vinyl.Functor 25 | import Data.Vinyl.XRec 26 | import GHC.Generics 27 | import Inliterate.Import 28 | import qualified Data.Vector as V 29 | import qualified Data.Vector.Mutable as MV 30 | ``` 31 | 32 | As previously seen, any type with a `Generic` instance can be given an instance 33 | automatically. However, this might not always be the behavior you want for 34 | your values. This library offers a few alternative automatic behaviors for 35 | what you want your mutable value to be like. Of course, you can always just 36 | define all your semantics and data types by hand (like what was done in 37 | `MyTypeRef` in the previous section). 38 | 39 | Picking an automatic derived behavior is as easy as specifying what the `Ref` 40 | instance is: 41 | 42 | ```haskell 43 | instance Mutable s MyType where 44 | type Ref s MyType = .... 45 | ``` 46 | 47 | If you set the `Ref` to a known "auto-derivable" type, then the library will 48 | automatically infer what you want. Here are the options. 49 | 50 | Whole-wise Mutation 51 | ------------------- 52 | 53 | You don't want any piecewise mutation. Treat your object as an inseparable 54 | block, and any mutations are done over the entire data type. 55 | 56 | This is the *default* behavior --- it is mostly useful for "primitive", 57 | non-composite data types like `Int`: 58 | 59 | ```haskell top 60 | data WholeType = WT { wtInt :: Int, wtDouble :: Double } 61 | 62 | instance Mutable s WholeType 63 | ``` 64 | 65 | If you just leave the instance blank, this will be the automatic default 66 | behavior. You can also be explicit: 67 | 68 | ```haskell 69 | instance Mutable s WholeType where 70 | type Ref s WholeType = MutVar s WholeType 71 | ``` 72 | 73 | and that would do the same thing. 74 | 75 | Generic Instance 76 | ---------------- 77 | 78 | This is the main thing the library is useful for. Get an automatic 79 | "piecewise-mutable" form of any ADT with a `Generic` instance. 80 | 81 | Dispatch this behavior by using `GRef s X` as your type's `Ref`: 82 | 83 | ```haskell top 84 | data MyType = MT 85 | { mtInt :: Int 86 | , mtDouble :: Double 87 | , mtVec :: V.Vector Double 88 | } 89 | deriving Generic 90 | 91 | instance Mutable s MyType where 92 | type Ref s MyType = GRef s MyType 93 | ``` 94 | 95 | The data type `GRef s MyType` is essentially equivalent to the same type as 96 | `MyType` with all the fields replaced with their mutable versions. That is, 97 | `GRef s MyType` is equivalent to `MyTypeRef`, if we wanted to define it 98 | manually: 99 | 100 | ```haskell 101 | data MyTypeRef s = MTR 102 | { mtrInt :: MutVar s Int 103 | , mtrDouble :: MutVar s Double 104 | , mtrVec :: MV.MVector s Double 105 | } 106 | 107 | instance Mutable s MyType where 108 | type Ref s MyType = MyTypeRef s 109 | 110 | thawRef (MT x y z) = MTR <$> newMutVar x 111 | <*> newMutVar y 112 | <*> V.thaw z 113 | 114 | freezeRef (MTR x y z) = MT <$> readMutVar x 115 | <*> readMutVar y 116 | <*> V.freeze z 117 | 118 | copyRef (MTR a b c) (MT x y z) = do 119 | writeMutVar a x 120 | writeMutVar b y 121 | V.copy c z 122 | ``` 123 | 124 | The above snippet is the equivalent code to what is generated in the simple 125 | line 126 | 127 | ```haskell 128 | instance Mutable s MyType where 129 | type Ref s MyType = GRef s MyType 130 | ``` 131 | 132 | The semantics for mutability is that a record type essentially becomes a record 133 | of mutable values, which can all be updated independently. 134 | 135 | ### Updating each part independently 136 | 137 | For `GRef`, you can update each part independently by using features from 138 | `FieldMut` and `PosMut`. See [Getting Started](/01-getting-started.html) for a 139 | summary on how to use these. 140 | 141 | ### Sum Types 142 | 143 | `GRef` also works for sum types, as well. For sum types, an extra layer of 144 | indirection is added: at the top level is a `MutVar` containing a reference to 145 | the contents of a constructor. For example: 146 | 147 | ```haskell top 148 | data IntOrBool = IBInt Int 149 | | IBBool Bool 150 | deriving Generic 151 | 152 | instance Mutable s IntOrBool where 153 | type Ref s IntOrBool = GRef s IntOrBool 154 | ``` 155 | 156 | then we get to "access" each potential branch with `constrMB`: 157 | 158 | ```haskell top 159 | ibInt :: MutBranch s IntOrBool Int 160 | ibInt = constrMB #_IBInt 161 | 162 | ibBool :: MutBranch s IntOrBool Bool 163 | ibBool = constrMB #_IBBool 164 | ``` 165 | 166 | The combinators in the *[Data.Mutable.Branches][DMB]* module are intended for usage 167 | with mutable sum types like this. See the [mutable 168 | branches](/06-mutable-branches.html) module for more information, and an actual 169 | useful example --- mutable linked lists. 170 | 171 | [DMB]: https://hackage.haskell.org/package/mutable/docs/Data-Mutable-Branches.html 172 | 173 | Newtyped Instances 174 | ------------------ 175 | 176 | If you have a newtype, you can give it a `Mutable` instance based on the 177 | underlying type by using `CoerceRef` 178 | 179 | ```haskell top 180 | newtype VecD = VecD (V.Vector Double) 181 | 182 | instance Mutable s VecD where 183 | type Ref s VecD = CoerceRef s VecD (V.Vector Double) 184 | ``` 185 | 186 | This will appropriately have `VecD` be using `MVector` as its mutable version. 187 | 188 | To get an instance for a newtype `X` wrapping underlying type `Y` using the 189 | `Mutable` instance for `Y`, use `CoerceRef s X Y`. 190 | 191 | You can access the underlying `Ref` using `coerceRef` or `withCoerceRef`: 192 | 193 | ```haskell 194 | withCoerceRef 195 | :: Ref s VecD 196 | -> (MV.Vector s Double -> m r) 197 | -> m r 198 | 199 | freezePart coerceRef 200 | :: Ref s VecD 201 | -> m (V.Vector Double) 202 | ``` 203 | 204 | Traversable Instances 205 | --------------------- 206 | 207 | Any "fixed-length" `Traversable` instance can be used as a mutable reference by 208 | just swapping out all its leaves for `Ref`. You can use `TraverseRef`: 209 | 210 | ```haskell top 211 | data V4 a = V4 a a a a 212 | deriving (Functor, Foldable, Traversable) 213 | 214 | instance Mutable s a => Mutable s (V4 a) where 215 | type Ref s (V4 a) = TraverseRef s V4 a 216 | ``` 217 | 218 | 219 | Basically, this just uses `V4 (Ref s a)` as your mutable reference: 220 | 221 | ```haskell 222 | getTraverseRef 223 | :: Ref s (V4 a) 224 | -> V4 (Ref s a) 225 | ``` 226 | 227 | so you can directly access the parts by just accessing your `Traversable` 228 | instance normally --- no need for any fancy `MutPart` shenanigans. 229 | 230 | Note that this still technically works for a non-fixed-length `Traversable` 231 | instance (like lists and vectors), but `copy` semantics can get a bit wonky. 232 | See the documentation for more details. 233 | 234 | Higher-Kinded Data 235 | ------------------ 236 | 237 | Sandy Maguire's [Higher-Kinded Data][hkd] pattern is seriously one of my 238 | favorite things ever in Haskell, and it works nicely with `Mutable` as well. 239 | 240 | [hkd]: https://reasonablypolymorphic.com/blog/higher-kinded-data/ 241 | 242 | ```haskell top 243 | data MyTypeF f = MTF 244 | { mtfInt :: HKD f Int 245 | , mtfDouble :: HKD f Double 246 | , mtfVec :: HKD f (V.Vector Double) 247 | } 248 | deriving Generic 249 | 250 | type MyType' = MyTypeF Identity 251 | 252 | instance Mutable s MyType' where 253 | type Ref s MyType' = MyTypeF (RefFor s) 254 | ```` 255 | 256 | ```haskell top hide 257 | deriving instance Show (MyTypeF Identity) 258 | instance AskInliterate (MyTypeF Identity) 259 | ``` 260 | 261 | 262 | In this style, `MyType'` behaves exactly like `MyType` from above: 263 | 264 | ```haskell 265 | MTF 3 4.5 (V.fromList [1..100]) 266 | :: MyType' 267 | ``` 268 | 269 | But now, `MyTypeF (RefFor s)` literally has mutable references as its fields. 270 | You can pattern match to get `rI :: MutVar s Int`, `rD :: MutVar s Double`, and 271 | `rV :: MVector s Double` 272 | 273 | ```haskell 274 | MTF rI rD rV :: MyTypeF (RefFor s) 275 | ``` 276 | 277 | and the accessors work as well: 278 | 279 | ```haskell 280 | mtfVec 281 | :: (PrimState m ~ s) 282 | -> MyTypeF (RefFor s) 283 | -> MVector s Double 284 | ``` 285 | 286 | You can use it like: 287 | 288 | ```haskell top 289 | doStuff :: MyType' -> MyType' 290 | doStuff x = runST $ do 291 | r@(MTF rI rD rV) <- thawRef x 292 | 293 | replicateM_ 1000 $ do 294 | 295 | -- rI is just the 'Int' ref 296 | modifyMutVar rI (+ 1) 297 | 298 | -- rV is the 'MVector' 299 | MV.modify rV (+1) 0 300 | 301 | freezeRef r 302 | ``` 303 | 304 | ```haskell eval 305 | doStuff $ MTF 0 19.3 (V.fromList [1..12]) 306 | ``` 307 | 308 | This makes it all really syntactically easy to access the internal parts 309 | directly as `Ref`s. 310 | -------------------------------------------------------------------------------- /doc/04-instance-wrappers.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Instance Wrappers 3 | --- 4 | 5 | Instance Wrappers 6 | ================= 7 | 8 | ```haskell top hide 9 | {-# LANGUAGE DeriveFoldable #-} 10 | {-# LANGUAGE DeriveFunctor #-} 11 | {-# LANGUAGE DeriveGeneric #-} 12 | {-# LANGUAGE DeriveTraversable #-} 13 | {-# LANGUAGE FlexibleInstances #-} 14 | {-# LANGUAGE LambdaCase #-} 15 | {-# LANGUAGE MultiParamTypeClasses #-} 16 | {-# LANGUAGE OverloadedLabels #-} 17 | {-# LANGUAGE StandaloneDeriving #-} 18 | {-# LANGUAGE TypeFamilies #-} 19 | 20 | import Control.Monad 21 | import Control.Monad.ST 22 | import Data.Mutable 23 | import Data.Primitive.MutVar 24 | import Data.Vinyl.Functor 25 | import Data.Vinyl.XRec 26 | import GHC.Generics 27 | import Inliterate.Import 28 | import qualified Data.Vector as V 29 | import qualified Data.Vector.Mutable as MV 30 | ``` 31 | 32 | The following newtype wrappers can imbue types with an automatic `Mutable` 33 | instance, with different behaviors. They are useful in one of these two 34 | situations: 35 | 36 | *One*, if your type comes from an external library, and you still want to use 37 | it as a `Mutable`, these newtype wrappers can be used to treat an external data 38 | type as if it had a `Mutable` instance without actually giving them an orphan 39 | `Mutable` instance. 40 | 41 | For example, if an external library offered 42 | 43 | ```haskell top 44 | newtype VecD = VecD (V.Vector Double) 45 | ``` 46 | 47 | and you don't want to give `VecD` an orphan instance, then you can use 48 | `CoerceMut VecD (V.Vector Double)`, instead. This has a proper `Mutable` 49 | instance utilizes `MVector`, as it should. 50 | 51 | *Two*, if you are leveraging `GRef` to build an automatic mutable version of 52 | your data type but want to override the "default" behavior of a component. 53 | 54 | For example, let's say you had a composite type: 55 | 56 | ```haskell 57 | data MyType = MT 58 | { mtInt :: Int 59 | , mtDoube :: Double 60 | , mtString :: String 61 | } 62 | deriving Generic 63 | 64 | instance Mutable s MyType where 65 | type Ref s MyType = GRef s MyType 66 | ``` 67 | 68 | This leverages the `Mutable` instances of `Int`, `Double`, and `String`. 69 | However, the normal `Mutable` instance for `String` isn't too great: it uses a 70 | mutable linked list (since it's a type alias for `[Char]`), which is a bit 71 | over-kill. We can use the `VarMut` newtype wrapper to instead treat `String` 72 | as a single object to be modified whole-wise instead of piecewise: 73 | 74 | ```haskell top 75 | data MyType = MT 76 | { mtInt :: Int 77 | , mtDoube :: Double 78 | , mtString :: VarMut String 79 | } 80 | deriving Generic 81 | 82 | instance Mutable s MyType where 83 | type Ref s MyType = GRef s MyType 84 | ``` 85 | 86 | Now `Ref s MyType` is a composite data type of a `MutVar s Int`, a `MutVar s 87 | Double`, and `MutVar s String`. `VarMut` overrides with a "whole-wise 88 | mutation" instance. 89 | 90 | VarMut 91 | ------ 92 | 93 | Overrides with (or provides) "whole-wise" mutation, eliminating any piecewise 94 | granularity. 95 | 96 | The type `VarMut String` is a whole-wise mutating reference, and is essentially 97 | `MutVar s String`. The example above shows a situation where this might be 98 | useful. 99 | 100 | CoerceMut 101 | --------- 102 | 103 | Overrides with (or provides) a mutation in terms of some equivalent type 104 | (usually, a newtype unwrapped version). Usually useful for providing an 105 | instance for external types. To repeat the example above: 106 | 107 | ```haskell 108 | newtype VecD = VecD (V.Vector Double) 109 | ``` 110 | 111 | Then `CoerceMut VecD (V.Vector Double)` has a `Mutable` instance that uses 112 | `MVector` underneath. 113 | 114 | TraverseMut 115 | ----------- 116 | 117 | Overrides with (or provides) a mutation in terms of a type's `Traversable` 118 | instance. See the information on `TraverseRef` in [the previous 119 | section](/03-automatic-instance-options.html) for more information on the 120 | details for how this instance works. 121 | 122 | For example, the `Mutable` instance for `Vector a` is an `MVector s a`, where 123 | each item is included in its "pure" form. But wouldn't it be nice if we 124 | instead had a mutable `Vector a` instead be `Vector (Ref s a)`, where every 125 | slot contains a mutable value? 126 | 127 | You can get that behavior with `TraverseMut Vector a`. 128 | 129 | Immutable 130 | --------- 131 | 132 | This wrapper is typically used to override the mutation of a specific field 133 | when using generic derivation. 134 | 135 | For example, looking at the type from above: 136 | 137 | ```haskell 138 | data MyType = MT 139 | { mtInt :: Int 140 | , mtDoube :: Double 141 | , mtString :: String 142 | } 143 | deriving Generic 144 | ``` 145 | 146 | Let's say you reaaaalllly don't want that `mtString` field to be mutable. 147 | Like, at all. You don't want to allocate anything, and you want all copies 148 | into it to be ignored and all freezes to return the original `String`. 149 | 150 | In that case, you can use `Immutable`: 151 | 152 | ```haskell 153 | data MyType = MT 154 | { mtInt :: Int 155 | , mtDoube :: Double 156 | , mtString :: Immutable String 157 | } 158 | deriving Generic 159 | 160 | instance Mutable s MyType where 161 | type Ref s MyType = GRef s MyType 162 | ``` 163 | 164 | And now `Ref s MyType` will basically be a tupling of `MutVar s Int`, `MutVar s 165 | Double`, and an immutable `String`. If you try to modify it, modifications 166 | will be ignored. Freezing a `Ref s MyType` will get the original string back. 167 | 168 | This does break a lot of the expectations of mutability, but sometimes this 169 | can be useful for low-level optimizations or hacks. 170 | -------------------------------------------------------------------------------- /doc/05-mutable-parts.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Mutable Parts 3 | --- 4 | 5 | Mutable Parts 6 | ============= 7 | 8 | ```haskell top hide 9 | {-# LANGUAGE DeriveFoldable #-} 10 | {-# LANGUAGE DeriveFunctor #-} 11 | {-# LANGUAGE DeriveGeneric #-} 12 | {-# LANGUAGE DeriveTraversable #-} 13 | {-# LANGUAGE FlexibleInstances #-} 14 | {-# LANGUAGE LambdaCase #-} 15 | {-# LANGUAGE MultiParamTypeClasses #-} 16 | {-# LANGUAGE OverloadedLabels #-} 17 | {-# LANGUAGE StandaloneDeriving #-} 18 | {-# LANGUAGE TypeFamilies #-} 19 | 20 | import Control.Monad 21 | import Control.Monad.ST 22 | import Data.Mutable 23 | import Data.Primitive.MutVar 24 | import Data.Vinyl.Functor 25 | import Data.Vinyl.XRec 26 | import GHC.Generics 27 | import Inliterate.Import 28 | import qualified Data.Vector as V 29 | import qualified Data.Vector.Mutable as MV 30 | ``` 31 | 32 | The *[Data.Mutable.Parts][DMP]* module has some mechanisms for accessing specific 33 | parts of mutable references, to take full advantage of piecewise-mutability. 34 | 35 | [DMP]: https://hackage.haskell.org/package/mutable/docs/Data-Mutable-Parts.html 36 | 37 | The main data type is `MutPart`: 38 | 39 | ```haskell 40 | data MutPart s b a = MutPart { getMutPart :: Ref s b -> Ref s a } 41 | ``` 42 | 43 | You can sort of imagine `MutPart s b a` as spiritually similar to a `Lens' b 44 | a`: it's a way to access and modify an `a` "inside" some `b`. It allows you to 45 | access or modify an `a` part of the `b`, without touching the rest of the `b`. 46 | 47 | Usage 48 | ----- 49 | 50 | Once you *have* a `MutPart`, you can use it with some simple utilities: 51 | 52 | ```haskell 53 | -- | With a 'MutPart', read out a specific part of a 'Ref'. 54 | freezePart :: Mutable s a => MutPart s b a -> Ref s b -> m a 55 | 56 | -- | With a 'MutPart', overwrite into a specific part of a 'Ref'. 57 | copyPart :: Mutable s a => MutPart s b a -> Ref s b -> a -> m () 58 | 59 | -- | With a 'MutPart', modify a specific part of a 'Ref' with a pure 60 | -- function. 61 | modifyPart :: Mutable s a => MutPart s b a -> Ref s b -> (a -> a) -> m () 62 | ``` 63 | 64 | `freezePart`, `copyPart`, and `modifyPart` act like "focused" versions of 65 | `freezeRef`, `copyRef`, and `modifyRef`. There's also a continuation-like 66 | combinator to work directly with the smaller sub-reference: 67 | 68 | ```haskell 69 | -- | Using a 'MutPart', perform a function on a `Ref s b` as if you had 70 | -- a `Ref s a`. 71 | withPart 72 | :: MutPart s b a -- ^ How to zoom into an `a` from an `s` 73 | -> Ref s b -- ^ The larger reference of `s` 74 | -> (Ref s a -> m r) -- ^ What do do with the smaller sub-reference of `a` 75 | -> m r 76 | ``` 77 | 78 | `MutPart`s also have a `Category` instance, so you can compose them with `.` 79 | from *Control.Category*. 80 | 81 | Examples 82 | -------- 83 | 84 | The rest of the module offers different useful `MutPart`s to be used in 85 | different situations. 86 | 87 | For example, with our favorite example type: 88 | 89 | ```haskell top 90 | data MyType = MT 91 | { mtInt :: Int 92 | , mtDouble :: Double 93 | , mtVec :: V.Vector Double 94 | } 95 | deriving (Show, Generic) 96 | 97 | instance Mutable s MyType where 98 | type Ref s MyType = GRef s MyType 99 | ``` 100 | 101 | We are able to access each field: 102 | 103 | ```haskell 104 | fieldMut #mtInt :: MutPart s MyType Int 105 | fieldMut #mtDouble :: MutPart s MyType Double 106 | fieldMut #mtVec :: MutPart s MyType (V.Vector Double) 107 | ``` 108 | 109 | and also each position: 110 | 111 | ```haskell 112 | posMut @1 :: MutPart s MyType Int 113 | posMut @2 :: MutPart s MyType Double 114 | posMut @3 :: MutPart s MyType (V.Vector Double) 115 | ``` 116 | 117 | We can also get a `MutPart` into a view of your data type as a tuple: 118 | 119 | ```haskell 120 | tupleMut :: MutPart s MyType (Int, Double, V.Vector Double) 121 | ``` 122 | 123 | Because the instance of `Ref` for tuples, this just turns a `Ref s MyType` into 124 | a `(MutVar s Int, MutVar s Double, MVector s Double)`. This is arguably easier 125 | to use continuation-style, so there is a nice helper `withTuple = withPart 126 | tupleMut` 127 | 128 | ```haskell 129 | withTuple 130 | :: (PrimMonad m, PrimState m ~ s) 131 | => MutPart s MyType 132 | -> ((MutVar s Int, MutVar s Double, MVector s Double) -> m r) 133 | -> m r 134 | ``` 135 | 136 | Another way of generating `MutPart`s for your record types is if you are using 137 | Sandy Maguire's [Higher-Kinded Data][hkd] pattern (like mentioned in [Automatic 138 | Instance Options](/03-automatic-instance-options.html)), you can use 139 | `hkdMutParts`: 140 | 141 | [hkd]: https://reasonablypolymorphic.com/blog/higher-kinded-data/ 142 | 143 | ```haskell top 144 | data MyTypeF f = MTF 145 | { mtfInt :: HKD f Int 146 | , mtfDouble :: HKD f Double 147 | , mtfVec :: HKD f (V.Vector Double) 148 | } 149 | deriving Generic 150 | 151 | type MyType' = MyTypeF Identity 152 | 153 | instance Mutable s MyType' where 154 | type Ref s MyType' = MyTypeF (RefFor s) 155 | ```` 156 | 157 | ```haskell 158 | MTF mpInt mpDouble mpVec = hkdMutParts @MyTypeF 159 | ``` 160 | 161 | That will give you `mpInt :: MutPart s MyType Int`, `mpDouble :: MutPart s 162 | MyType Double`, and `mpVec :: MutPart s MyType (V.Vector Double)`, in a way 163 | that is nice to pattern match out of. You can also access the 164 | `MutPart`s: 165 | 166 | ```haskell 167 | mpInt :: MutPart s MyType Int 168 | mpInt = mtfInt (hkdMutParts @MyTypeF) 169 | ``` 170 | -------------------------------------------------------------------------------- /doc/06-mutable-branches.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Mutable Branches 3 | --- 4 | 5 | Mutable Branches 6 | ================= 7 | 8 | ```haskell top hide 9 | {-# LANGUAGE DeriveFoldable #-} 10 | {-# LANGUAGE DeriveFunctor #-} 11 | {-# LANGUAGE DeriveGeneric #-} 12 | {-# LANGUAGE DeriveTraversable #-} 13 | {-# LANGUAGE FlexibleInstances #-} 14 | {-# LANGUAGE LambdaCase #-} 15 | {-# LANGUAGE MultiParamTypeClasses #-} 16 | {-# LANGUAGE OverloadedLabels #-} 17 | {-# LANGUAGE StandaloneDeriving #-} 18 | {-# LANGUAGE TypeFamilies #-} 19 | 20 | import Control.Monad 21 | import Control.Monad.ST 22 | import Data.Mutable 23 | import Data.Primitive.MutVar 24 | import Data.Vinyl.Functor 25 | import Data.Vinyl.XRec 26 | import GHC.Generics 27 | import Inliterate.Import 28 | import qualified Data.Vector as V 29 | import qualified Data.Vector.Mutable as MV 30 | ``` 31 | 32 | The `MutPart` abstraction lets us "zoom into" a smaller part of a 33 | piecewise-mutable product type. But what about sum types? 34 | 35 | Let's look at *[Data.Mutable.Branches][DMB]* to tackle this. 36 | 37 | [DMB]: https://hackage.haskell.org/package/mutable/docs/Data-Mutable-Branches.html 38 | 39 | Conceptually, mutable sum types are a completely different beast. A mutable 40 | product type is just a (pure) tuple of its mutable fields. 41 | 42 | A mutable *sum type* is actually a mutable reference to *one of its possible 43 | branches*. 44 | 45 | For example, let's consider a simple sum type: 46 | 47 | ```haskell top 48 | data IntOrBool = IBInt Int 49 | | IBBool Bool 50 | ``` 51 | 52 | Its mutable version would be: 53 | 54 | ```haskell 55 | newtype IntOrBoolRef s = IBR 56 | { getIBR :: MutVar s (Either (MutVar s Int) (MutVar s Bool)) 57 | } 58 | ``` 59 | 60 | It's a mutable reference to *either* a mutable `Int` or a mutable `Bool`. 61 | 62 | This is probably *most useful* when thinking about recursive types, like lists: 63 | 64 | ```haskell top 65 | data List a = Nil | Cons a (List a) 66 | deriving (Show, Generic) 67 | 68 | instance Mutable s a => Mutable s (List a) where 69 | type Ref s (List a) = GRef s (List a) 70 | ``` 71 | 72 | The `GRef s (List a)` is now a *[mutable linked list][ll]* --- the good old 73 | fashioned data type that people learn to implement in Java or C++ or what have 74 | you. It's a reference to a cell that is either a `Nil` cell or a `Cons` cell 75 | with a reference to an `a` and a reference to another list cell. 76 | 77 | [ll]: https://en.wikipedia.org/wiki/Linked_list 78 | 79 | The main tool to work with mutable branches is to use the `MutBranch` data 80 | type, from *[Data.Mutable.Branches][DMB]*, which specifies which "branch" on mutable 81 | sum type to work with. In the case of `IntOrBool`, it we might have a 82 | `MutBranch s IntOrBool Int` for the `Int` case and a `MutBranch s IntOrBool 83 | Bool` for the `Bool` case. In the case of `List`, since it has a `Generic` 84 | instance, we can use `constrMB` to create a `MutBranch` based on the 85 | constructor name. 86 | 87 | ```haskell top 88 | nilBranch 89 | :: Mutable s a 90 | => MutBranch s (List a) () 91 | nilBranch = constrMB #_Nil 92 | 93 | consBranch 94 | :: Mutable s a 95 | => MutBranch s (List a) (a, List a) 96 | consBranch = constrMB #_Cons 97 | ``` 98 | 99 | `nilBranch` represents the `Nil` constructor (containing nothing, `()`), and 100 | `consBranch` represents the `Cons` constructor (containing a mutable `(a, List 101 | a)`). 102 | 103 | Note that due to limitations in OverloadedLabels, we're required to add that 104 | underscore before the constructor name. (If your constructor is an operator, 105 | you'd have to do something like `constrMB (CLabel @":")`). 106 | 107 | The simplest way to use a `MutBranch` is to check if a reference is currently 108 | on that branch, with `hasBranch`: 109 | 110 | ```haskell top 111 | -- | Check if a mutable linked list is currently empty 112 | isEmpty 113 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 114 | => Ref s (List a) 115 | -> m Bool 116 | isEmpty = hasBranch nilBranch 117 | ``` 118 | 119 | Using the API of *[Data.Mutable.Branches][DMB]*, we can write a function to "pop" a 120 | mutable linked list, giving us the first value and shifting the rest of the 121 | list up. 122 | 123 | 124 | ```haskell top 125 | popStack 126 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 127 | => Ref s (List a) 128 | -> m (Maybe a) 129 | popStack xs = do 130 | c <- projectBranch consBranch xs 131 | forM c $ \(y, ys) -> do 132 | o <- freezeRef y 133 | moveRef xs ys 134 | pure o 135 | ``` 136 | 137 | And here is a function to concatenate a second linked list to the end of a 138 | first one. 139 | 140 | ```haskell top 141 | concatLists 142 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 143 | => Ref s (List a) 144 | -> Ref s (List a) 145 | -> m () 146 | concatLists l1 l2 = do 147 | c <- projectBranch consBranch l1 148 | case c of 149 | Nothing -> moveRef l1 l2 150 | Just (_, xs) -> concatLists xs l2 151 | ``` 152 | 153 | The main benefit of using this library --- with `GRef` and `MutBranch`, are a 154 | set of automatically generated type-safe tools for dealing with mutable 155 | options. 156 | 157 | -------------------------------------------------------------------------------- /doc/07-benchmarks.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Benchmarks 3 | --- 4 | 5 | Benchmarks 6 | ========== 7 | 8 | All of this is only ivory tower stuff until we get into hard numbers of 9 | performance, right? Agreed! Here are some benchmarks comparing a "pure" 10 | situation with the piecewise mutable one. 11 | 12 | The theoretical "best case" of piecewise-mutable (and worst case of pure) is 13 | when you only modify a small part of a data type repeatedly. This forces 14 | many unnecessary copies in the pure form. 15 | 16 | The theoretical "worst case" of piecewise-mutable (and best case of pure) is if 17 | you only ever modify the *entire* data type. 18 | 19 | Both of these situations are tested below: 20 | 21 | (Only bars of the same color are comparable, and shorter bars are better, 22 | performance-wise) 23 | 24 | ![Benchmarks](https://i.imgur.com/S95TuiM.png) 25 | 26 | There are four setups here, compared and contrasted between pure and mutable 27 | versions. 28 | 29 | 1. A large ADT with 256 fields, generated by repeated nestings of `data V4 a = 30 | V4 !a !a !a !a` 31 | 32 | 1. Updating only a single part (one field out of 256) 33 | 2. Updating the entire ADT (all 256 fields) 34 | 35 | 2. A composite data type of four `Vector`s of 500k elements each, so 2 million 36 | elements total. 37 | 38 | 1. Updating only a single part (one item out of 2 million) 39 | 2. Updating all elements of all four vectors (all 2 million items) 40 | 41 | We can see four conclusions: 42 | 43 | 1. For a large ADT, updating a single field (or multiple fields, interleaved) 44 | is going to be faster with *mutable*. This speedup is between x4 and x5, 45 | suggesting it is a speedup arising from the fact that the top-level type 46 | has four fields. 47 | 2. For a large ADT, updating the whole ADT (so just replacing the entire 48 | thing, no actual copies) is faster just as a pure value by a large factor 49 | (which is a big testament to GHC). 50 | 3. For a small ADT with huge vectors, updating a single field is *much* faster 51 | with *mutable*. 52 | 4. For a small ADT with huge vectors, updating the entire value (so, the 53 | entire vectors and entire ADT) is actually faster with *mutable* as well. 54 | 55 | Interestingly, the "update entire structure" case (which should be the 56 | worst-case for *mutable* and the best-case for pure values) actually becomes 57 | faster with *mutable* when you get to the region of *many* values... somewhere 58 | between 16 and 2 million, apparently. However, this may just be from the 59 | efficiency of modifying vectors sequentially. 60 | -------------------------------------------------------------------------------- /doc/08-resources.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Resources 3 | --- 4 | 5 | Resources 6 | ========= 7 | 8 | Thank you for reading! Hope you enjoy using the library! If you do anything 9 | interesting with it, I'd love to hear about it! :) 10 | 11 | For a full comprehensive API summary, see the [Haddock Documentation][docs]. 12 | To report bugs or ask long-form questions or file a feature request, check out 13 | the [Issue Tracker][issues] on github. 14 | 15 | [docs]: https://hackage.haskell.org/package/mutable 16 | [issues]: https://github.com/mstksg/mutable/issues 17 | 18 | You can also try to contact the me [@mstk][twitter] on twitter, or find 19 | him idling on [freenode #haskell][irc]! 20 | 21 | [twitter]: https://twitter.com/mstk 22 | [irc]: https://wiki.haskell.org/IRC_channel 23 | -------------------------------------------------------------------------------- /doc/index.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Home 3 | --- 4 | 5 | Beautiful Mutable Values 6 | ======================== 7 | 8 | [![mutable on Hackage](https://img.shields.io/hackage/v/mutable.svg?maxAge=86400)](https://hackage.haskell.org/package/mutable) 9 | [![Build Status](https://travis-ci.org/mstksg/mutable.svg?branch=master)](https://travis-ci.org/mstksg/mutable) 10 | 11 | ```haskell top hide 12 | {-# LANGUAGE DeriveGeneric #-} 13 | {-# LANGUAGE FlexibleInstances #-} 14 | {-# LANGUAGE MultiParamTypeClasses #-} 15 | {-# LANGUAGE OverloadedLabels #-} 16 | {-# LANGUAGE TupleSections #-} 17 | {-# LANGUAGE TypeFamilies #-} 18 | 19 | import Control.Monad 20 | import Control.Monad.ST 21 | import Data.Foldable 22 | import GHC.Generics 23 | import Inliterate.Import 24 | import Data.Mutable 25 | import qualified Data.Vector as V 26 | import qualified Data.Vector.Mutable as MV 27 | ``` 28 | 29 | **Mutability can be awesome!** 30 | 31 | Take back the power of **mutable objects** with all the **safety** and explicit 32 | state of Haskell. Associate and generate "piecewise-mutable" versions for your 33 | composite data types in a composable and automatic way. Think of it like a 34 | "generalized `MVector` for all ADTs". It also leverages GHC Generics to make 35 | working with piecewise mutability as simple as possible. 36 | 37 | Making piecewise updates on your giant composite data types (like artificial 38 | neural networks or game states in your game loop) got you down because they 39 | require re-allocating the entire value? Tired of requiring a full deep copy 40 | every time you make a small change, and want to be able to build mutable 41 | versions of your types automatically in composable ways? This is the package 42 | for you. 43 | 44 | ```haskell top 45 | data MyType = MT 46 | { mtInt :: Int 47 | , mtDouble :: Double 48 | , mtVec :: V.Vector Double 49 | } 50 | deriving (Show, Generic) 51 | 52 | instance Mutable s MyType where 53 | type Ref s MyType = GRef s MyType 54 | ``` 55 | 56 | ```haskell top hide 57 | instance AskInliterate MyType 58 | ``` 59 | 60 | The type `Ref s MyType` is now a "mutable `MyType`", just like how `MVector s 61 | a` is a "mutable `Vector a`". You have: 62 | 63 | ```haskell 64 | thawRef :: MyType -> ST s (Ref s MyType) 65 | freezeRef :: Ref s MyType -> ST s MyType 66 | ``` 67 | 68 | (These actions are in `ST`, the mutable memory monad that comes with GHC. The 69 | real types of these are more polymorphic and are generalized to work for all 70 | mutable monads with `PrimMonad` instance.) 71 | 72 | You can use `thawRef` to allocate a mutable `MyType` that essentially consists 73 | of a mutable `Int`, a mutable `Double`, and a mutable `Vector` (an `MVector`) 74 | all tupled together. You can edit these pieces in isolation, and then 75 | `freezeRef` it all back together: 76 | 77 | ```haskell top 78 | doStuff :: MyType -> MyType 79 | doStuff x = runST $ do 80 | r <- thawRef x 81 | 82 | replicateM_ 1000 $ do 83 | 84 | -- modify the Int in `mtInt` 85 | modifyPart (fieldMut #mtInt) r (+ 1) 86 | 87 | -- the `mtVec` field is now an MVector 88 | withField #mtVec r $ \v -> 89 | MV.modify v (+1) 0 90 | 91 | freezeRef r 92 | ``` 93 | 94 | ```haskell eval 95 | doStuff $ MT 0 19.3 (V.fromList [1..12]) 96 | ``` 97 | 98 | If you were to do this normally with pure values, this would be extremely 99 | expensive, especially if `mtVec` is a huge vector --- it would require copying 100 | every item in the entire vector every step, being *O(n \* l)* , with *n* number 101 | of repetitions and *l* length of vector and number of fields. With mutable 102 | vectors and mutable cells, this now becomes *O(n + l)*. 103 | 104 | The main motivation for this library is to implement *automatically derivable* 105 | piecewise-mutable references for the purposes of mutation-heavy algorithms, 106 | like artificial neural networks. In the end, you're able to have an Artificial 107 | Neural Network (which can have huuuuge vectors) and being able to do piecewise 108 | updates on them (automatically) without having to copy over the entire network 109 | every training step. 110 | 111 | There is also support for mutable sum types, as well. Here is the automatic 112 | definition of a *[mutable linked list][ll]*: 113 | 114 | [ll]: https://en.wikipedia.org/wiki/Linked_list 115 | 116 | ```haskell top 117 | data List a = Nil | Cons a (List a) 118 | deriving (Show, Generic) 119 | infixr 5 `Cons` 120 | 121 | instance Mutable s a => Mutable s (List a) where 122 | type Ref s (List a) = GRef s (List a) 123 | ``` 124 | 125 | ```haskell top hide 126 | instance Show a => AskInliterate (List a) 127 | ``` 128 | 129 | 130 | We can write a function to "pop" out the top value and shift the rest of the 131 | list up: 132 | 133 | ```haskell top 134 | popStack 135 | :: Mutable s a 136 | => Ref s (List a) 137 | -> ST s (Maybe a) 138 | popStack xs = do 139 | c <- projectBranch (constrMB #_Cons) xs 140 | forM c $ \(y, ys) -> do 141 | o <- freezeRef y 142 | moveRef xs ys 143 | pure o 144 | ``` 145 | 146 | ```haskell eval 147 | runST $ do 148 | r <- thawRef $ 1 `Cons` 2 `Cons` 3 `Cons` Nil 149 | y <- popStack r 150 | (y,) <$> freezeRef r 151 | ```` 152 | 153 | Check out **[the getting started page](/01-getting-started.html)**, or the **[Haddock 154 | Documentation][docs]** to jump right in! You can also read [my introductory 155 | blog post][blog] about the motivations for this library and things I learned 156 | while developing it. 157 | 158 | [docs]: https://hackage.haskell.org/package/mutable 159 | [blog]: https://blog.jle.im/entry/introducing-the-mutable-library.html 160 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: mutable 2 | version: 0.2.2.0 3 | github: mstksg/mutable 4 | license: BSD3 5 | author: Justin Le 6 | maintainer: justin@jle.im 7 | copyright: (c) Justin Le 2020 8 | tested-with: GHC >= 8.6 && < 8.10 9 | 10 | extra-source-files: 11 | - README.md 12 | - CHANGELOG.md 13 | 14 | # Metadata used when publishing your package 15 | synopsis: Automatic piecewise-mutable references for your types 16 | category: Data 17 | 18 | # To avoid duplicated efforts in documentation and dealing with the 19 | # complications of embedding Haddock markup inside cabal files, it is 20 | # common to point users to the README.md file. 21 | description: | 22 | Associate and generate "piecewise-mutable" versions for your composite data 23 | types. Think of it like a "generalized MVector for all ADTs". 24 | 25 | Useful for a situation where you have a record with many fields (or many nested 26 | records) that you want to use for efficient mutable in-place algorithms. This 27 | library lets you do efficient "piecewise" mutations (operations that only edit 28 | one field), and also efficient entire-datatype copies/updates, as well, in many 29 | cases. 30 | 31 | See for official introduction and documentation, 32 | or jump right in by importing "Data.Mutable". 33 | 34 | ghc-options: 35 | - -Wall 36 | - -Wcompat 37 | - -Wredundant-constraints 38 | - -Werror=incomplete-patterns 39 | 40 | library: 41 | source-dirs: src 42 | other-modules: 43 | - Data.Mutable.Internal 44 | - Data.Mutable.Internal.TH 45 | dependencies: 46 | - base >= 4.12 && < 5 47 | - generic-lens >= 2.0 48 | - generic-lens-core >= 2.0 49 | - primitive >= 0.6.4 50 | - template-haskell 51 | - transformers 52 | - vector 53 | - vinyl 54 | 55 | benchmarks: 56 | mutable-bench: 57 | main: bench.hs 58 | source-dirs: bench 59 | ghc-options: 60 | - -threaded 61 | - -rtsopts 62 | - -with-rtsopts=-N 63 | - -O2 64 | dependencies: 65 | - base >= 4.12 && < 5 66 | - criterion 67 | - deepseq 68 | - directory 69 | - microlens 70 | - microlens-th 71 | - mutable 72 | - time 73 | - transformers 74 | - vector 75 | - vinyl 76 | 77 | # executables: 78 | # mutable-exe: 79 | # main: Main.hs 80 | # source-dirs: app 81 | # ghc-options: 82 | # - -threaded 83 | # - -rtsopts 84 | # - -with-rtsopts=-N 85 | # dependencies: 86 | # - mutable 87 | 88 | # tests: 89 | # mutable-test: 90 | # main: Spec.hs 91 | # source-dirs: test 92 | # ghc-options: 93 | # - -threaded 94 | # - -rtsopts 95 | # - -with-rtsopts=-N 96 | # dependencies: 97 | # - mutable 98 | -------------------------------------------------------------------------------- /src/Data/Mutable.hs: -------------------------------------------------------------------------------- 1 | 2 | -- | 3 | -- Module : Data.Mutable.Class 4 | -- Copyright : (c) Justin Le 2020 5 | -- License : BSD3 6 | -- 7 | -- Maintainer : justin@jle.im 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- Main entrypoint of the package. Abstract over different types for 12 | -- piecewise-mutable references of values. 13 | -- 14 | -- See for a comprehensive introduction. 15 | module Data.Mutable ( 16 | Mutable(..) 17 | , modifyRef, modifyRef' 18 | , updateRef, updateRef' 19 | , RefFor(..) 20 | -- * Instances 21 | , DefaultMutable 22 | , GRef 23 | , MutVar 24 | , CoerceRef(..) 25 | , TraverseRef(..) 26 | , GMutableRef(..) 27 | , RecRef(..) 28 | , HListRef(..) 29 | , UnitRef(..) 30 | , VoidRef 31 | -- * Providing/overriding instances 32 | , VarMut(..) 33 | , CoerceMut(..) 34 | , TraverseMut(..) 35 | , Immutable(..) 36 | -- * Parts 37 | , MutPart(..) 38 | , withPart 39 | , freezePart, copyPart 40 | , movePartInto, movePartOver, movePartWithin 41 | , clonePart, unsafeFreezePart 42 | , modifyPart, modifyPart' 43 | , updatePart, updatePart' 44 | -- ** Built-in 'MutPart' 45 | -- *** Field 46 | , FieldMut(..), withField, mutField, Label(..) 47 | -- *** Position 48 | , PosMut(..), withPos, mutPos 49 | -- *** Tuple 50 | , TupleMut(..), withTuple 51 | -- *** Higher-Kinded Data 52 | , hkdMutParts, HKDMutParts 53 | -- *** Other 54 | , mutFst, mutSnd 55 | , mutRec 56 | , coerceRef, withCoerceRef 57 | -- * Branches 58 | , MutBranch(..) 59 | , thawBranch 60 | , freezeBranch 61 | , moveBranch 62 | , copyBranch 63 | , cloneBranch 64 | , hasBranch, hasn'tBranch 65 | , unsafeThawBranch 66 | , unsafeFreezeBranch 67 | , withBranch, withBranch_ 68 | , modifyBranch, modifyBranch' 69 | , updateBranch, updateBranch' 70 | -- ** Built-in 'MutBranch' 71 | -- *** Using GHC Generics 72 | , constrMB, CLabel(..), GMutBranchConstructor, MapRef 73 | -- *** For common types 74 | , nilMB, consMB 75 | , nothingMB, justMB 76 | , leftMB, rightMB 77 | -- * Re-exports 78 | , PrimMonad, PrimState 79 | ) where 80 | 81 | import Control.Monad.Primitive 82 | import Data.Mutable.Branches 83 | import Data.Mutable.Class 84 | import Data.Mutable.Instances 85 | import Data.Mutable.Parts 86 | import Data.Primitive.MutVar 87 | 88 | -------------------------------------------------------------------------------- /src/Data/Mutable/Branches.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE AllowAmbiguousTypes #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE FunctionalDependencies #-} 6 | {-# LANGUAGE GADTs #-} 7 | {-# LANGUAGE LambdaCase #-} 8 | {-# LANGUAGE OverloadedLabels #-} 9 | {-# LANGUAGE RankNTypes #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TypeApplications #-} 12 | {-# LANGUAGE TypeFamilyDependencies #-} 13 | {-# LANGUAGE TypeInType #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | {-# LANGUAGE UndecidableInstances #-} 16 | 17 | 18 | -- | 19 | -- Module : Data.Mutable.MutBranch 20 | -- Copyright : (c) Justin Le 2020 21 | -- License : BSD3 22 | -- 23 | -- Maintainer : justin@jle.im 24 | -- Stability : experimental 25 | -- Portability : non-portable 26 | -- 27 | -- Tools for working with potential branches of piecewise-mutable 28 | -- values. 29 | -- 30 | -- If "Data.Mutable.Parts" is for product types, then 31 | -- "Data.Mutable.Branches" is for sum types. 32 | -- 33 | -- See for an 34 | -- introduction to this module. 35 | module Data.Mutable.Branches ( 36 | MutBranch(..) 37 | , thawBranch 38 | , freezeBranch 39 | , hasBranch, hasn'tBranch 40 | , moveBranch 41 | , copyBranch 42 | , cloneBranch 43 | , unsafeThawBranch 44 | , unsafeFreezeBranch 45 | , withBranch, withBranch_ 46 | , modifyBranch, modifyBranch' 47 | , updateBranch, updateBranch' 48 | , modifyBranchM, modifyBranchM' 49 | , updateBranchM, updateBranchM' 50 | -- * Built-in 'MutBranch' 51 | , compMB, idMB 52 | -- ** Using GHC Generics 53 | , constrMB, CLabel(..), GMutBranchConstructor, MapRef 54 | -- ** For common types 55 | , nilMB, consMB 56 | , nothingMB, justMB 57 | , leftMB, rightMB 58 | ) where 59 | 60 | import Control.Monad 61 | import Control.Monad.Primitive 62 | import Data.Generics.Product.Internal.HList 63 | import Data.Maybe 64 | import Data.Mutable.Class 65 | import Data.Mutable.Instances 66 | import Data.Mutable.Internal 67 | import Data.Primitive.MutVar 68 | import GHC.Generics 69 | import GHC.OverloadedLabels 70 | import GHC.TypeLits 71 | import qualified Data.GenericLens.Internal as GL 72 | import qualified Data.Generics.Internal.Profunctor.Lens as GLP 73 | 74 | -- | A @'MutBranch' s b a@ represents the information that @b@ could 75 | -- potentially be an @a@. Similar in spirit to a @Prism' b a@. 76 | -- 77 | -- @'MutBranch' s b a@ means that @a@ is one potential option that @b@ 78 | -- could be in, or that @b@ is a sum type and @a@ is one of the 79 | -- branches/constructors. 80 | -- 81 | -- See for an 82 | -- introduction to this module. 83 | -- 84 | -- If 'Data.Mutable.Parts.MutPart' is for product types, then 'MutBranch' 85 | -- is for sum types. 86 | -- 87 | -- In this case, "branch" means "potential option". For example, the 88 | -- branches of 'Either' are 'Left' and 'Right'. 89 | -- 90 | -- The simplest way to make these is by using 'constrMB'. For instance, to 91 | -- get the two branches of an 'Either': 92 | -- 93 | -- @ 94 | -- constrMB #_Left :: MutBranch s (Either a b) a 95 | -- constrMB #_Right :: MutBranch s (Either a b) b 96 | -- @ 97 | -- 98 | -- @ 99 | -- ghci> r <- 'thawRef' (Left 10) 100 | -- ghci> 'freezeBranch' ('constrMB' #_Left) r 101 | -- Just 10 102 | -- ghci> freezeBranch (constrMB #_Right) r 103 | -- Nothing 104 | -- @ 105 | -- 106 | -- It uses OverloadedLabels, but requires an underscore before the 107 | -- constructor name due to limitations in the extension. 108 | -- 109 | -- One nice way to /use/ these is with 'withBranch_': 110 | -- 111 | -- @ 112 | -- ghci> r <- 'thawRef' (Just 10) 113 | -- ghci> 'withBranch_' (constrMB #_Just) $ \i -> -- @i@ is an Int ref 114 | -- .. modifyRef i (+ 1) 115 | -- ghci> 'freezeRef' r 116 | -- Just 11 117 | -- @ 118 | -- 119 | -- @ 120 | -- ghci> r <- thawRef Nothing 121 | -- ghci> withBranch_ (constrMB #_Just) $ \i -> -- @i@ is an Int ref 122 | -- .. modifyRef i (+ 1) 123 | -- ghci> freezeRef r 124 | -- Nothing 125 | -- @ 126 | -- 127 | -- Perhaps the most useful usage of this abstraction is for recursive data 128 | -- types. 129 | -- 130 | -- @ 131 | -- data List a = Nil | Cons a (List a) 132 | -- deriving Generic 133 | -- 134 | -- instance Mutable s a => 'Mutable' s (List a) where 135 | -- type Ref s (List a) = 'GRef' s (List a) 136 | -- @ 137 | -- 138 | -- @'GRef' s (List a)@ is now a mutable linked list! Once we make the 139 | -- 'MutBranch' for the nil and cons cases: 140 | -- 141 | -- @ 142 | -- nilBranch :: MutBranch s (List a) () 143 | -- nilBranch = constrMB #_Nil 144 | -- 145 | -- consBranch :: MutBranch s (List a) (a, List a) 146 | -- consBranch = constrMB #_Cons 147 | -- @ 148 | -- 149 | -- 150 | -- Here is a function to check if a linked list is currently empty: 151 | -- 152 | -- @ 153 | -- isEmpty 154 | -- :: (PrimMonad m, Mutable s a) 155 | -- => Ref s (List a) 156 | -- -> m Bool 157 | -- isEmpty = hasBranch nilBranch 158 | -- @ 159 | -- 160 | -- Here is one to "pop" a mutable linked list, giving us the first value 161 | -- and shifting the rest of the list up. 162 | -- 163 | -- @ 164 | -- popStack 165 | -- :: (PrimMonad m, Mutable s a) 166 | -- => Ref s (List a) 167 | -- -> m (Maybe a) 168 | -- popStack r = do 169 | -- c <- projectBranch consBranch r 170 | -- case c of 171 | -- Nothing -> pure Nothing 172 | -- Just (x, xs) -> do 173 | -- moveRef r xs 174 | -- Just <$> freezeRef x 175 | -- @ 176 | -- 177 | -- And here is a function to concatenate a second linked list to the end of a 178 | -- first one. 179 | -- 180 | -- @ 181 | -- concatLists 182 | -- :: (PrimMonad m, Mutable s a) 183 | -- => Ref s (List a) 184 | -- -> Ref s (List a) 185 | -- -> m () 186 | -- concatLists l1 l2 = do 187 | -- c <- projectBranch consBranch l1 188 | -- case c of 189 | -- Nothing -> moveRef l1 l2 190 | -- Just (_, xs) -> concatLists xs l2 191 | -- @ 192 | data MutBranch s b a = MutBranch 193 | { -- | With a 'MutBranch', attempt to get the mutable contents of 194 | -- a branch of a mutable 195 | -- @s@, if possible. 196 | -- 197 | -- @ 198 | -- ghci> r <- thawRef (Left 10) 199 | -- ghci> s <- projectBranch (constrMB #_Left) r 200 | -- ghci> case s of Just s' -> freezeRef s' 201 | -- 10 202 | -- @ 203 | -- 204 | -- @ 205 | -- ghci> r <- thawRef (Right True) 206 | -- ghci> s <- projectBranch (constrMB #_Left) r 207 | -- ghci> case s of Nothing -> "it was Right" 208 | -- "it was Right" 209 | -- @ 210 | projectBranch :: forall m. (PrimMonad m, PrimState m ~ s) => Ref s b -> m (Maybe (Ref s a)) 211 | -- | Embed an @a@ ref as a part of a larger @s@ ref. Note that this 212 | -- /does not copy or clone/: any mutations to the @a@ ref will be 213 | -- reflected in the @s@ ref, as long as the @s@ ref maintains the 214 | -- reference. 215 | -- 216 | -- @ 217 | -- ghci> r <- thawRef 100 218 | -- ghci> s <- embedBranch (constMB #_Left) r 219 | -- ghci> freezeRef s 220 | -- Left 100 221 | -- ghci> modifyRef r (+ 1) 222 | -- ghci> freezeRef s 223 | -- Left 101 224 | -- @ 225 | -- 226 | -- Any mutations on @s@ (as long as they keep the same branch) will 227 | -- also affect @a@: 228 | -- 229 | -- @ 230 | -- ghci> copyRef s (Left 0) 231 | -- ghci> freezeRef r 232 | -- 0 233 | -- @ 234 | -- 235 | -- However, "switching branches" on an 'Either' ref will cause it to 236 | -- loose the original reference: 237 | -- 238 | -- @ 239 | -- ghci> copyRef s (Right True) 240 | -- ghci> copyRef s (Left 999) 241 | -- ghci> freezeRef r 242 | -- 0 243 | -- @ 244 | , embedBranch :: forall m. (PrimMonad m, PrimState m ~ s) => Ref s a -> m (Ref s b) 245 | } 246 | 247 | -- | Compose two 'MutBranch's, to drill down on what is being focused. 248 | compMB :: MutBranch s a b -> MutBranch s b c -> MutBranch s a c 249 | compMB mb1 mb2 = MutBranch 250 | { projectBranch = projectBranch mb1 >=> \case 251 | Nothing -> pure Nothing 252 | Just s -> projectBranch mb2 s 253 | , embedBranch = embedBranch mb1 <=< embedBranch mb2 254 | } 255 | 256 | -- | An identity 'MutBranch', treating the item itself as a whole branch. 257 | -- 'cloneBranch' will always "match". 258 | idMB :: MutBranch s a a 259 | idMB = MutBranch (pure . Just) pure 260 | 261 | -- | With a 'MutBranch', thaw an @a@ into a mutable @s@ on that branch. 262 | -- 263 | -- @ 264 | -- ghci> r <- 'thawBranch' ('constrMB' #_Left) 10 265 | -- ghci> 'freezeRef' r 266 | -- Left 10 267 | -- @ 268 | thawBranch 269 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 270 | => MutBranch s b a 271 | -> a 272 | -> m (Ref s b) 273 | thawBranch mb = embedBranch mb <=< thawRef 274 | 275 | -- | With a 'MutBranch', read out a specific @a@ branch of an @s@, if it exists. 276 | -- 277 | -- @ 278 | -- ghci> r <- 'thawRef' (Left 10) 279 | -- ghci> 'freezeBranch' ('constrMB' #_Left) r 280 | -- Just 10 281 | -- ghci> freezeBranch (constrMB #_Right) r 282 | -- Nothing 283 | -- @ 284 | freezeBranch 285 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 286 | => MutBranch s b a -- ^ How to check if is @s@ is an @a@ 287 | -> Ref s b -- ^ Structure to read out of 288 | -> m (Maybe a) 289 | freezeBranch mb = mapM freezeRef <=< projectBranch mb 290 | 291 | -- | Check if an @s@ is currently a certain branch @a@. 292 | hasBranch 293 | :: (PrimMonad m, PrimState m ~ s) 294 | => MutBranch s b a 295 | -> Ref s b 296 | -> m Bool 297 | hasBranch mb = fmap isJust . projectBranch mb 298 | 299 | -- | Check if an @s@ is /not/ currently a certain branch @a@. 300 | hasn'tBranch 301 | :: (PrimMonad m, PrimState m ~ s) 302 | => MutBranch s b a 303 | -> Ref s b 304 | -> m Bool 305 | hasn'tBranch mb = fmap isNothing . projectBranch mb 306 | 307 | -- | With a 'MutBranch', /set/ @s@ to have the branch @a@. 308 | -- 309 | -- @ 310 | -- ghci> r <- 'thawRef' (Left 10) 311 | -- ghci> 'copyBranch' ('constrMB' #_Left) r 5678 312 | -- ghci> 'freezeRef' r 313 | -- Left 5678 314 | -- ghci> copyBranch (constrMB #_Right) r True 315 | -- ghci> freezeRef r 316 | -- Right True 317 | -- @ 318 | copyBranch 319 | :: (Mutable s b, Mutable s a, PrimMonad m, PrimState m ~ s) 320 | => MutBranch s b a -- ^ How to check if @s@ is an @a@ 321 | -> Ref s b -- ^ Structure to write into 322 | -> a -- ^ Value to set @s@ to be 323 | -> m () 324 | copyBranch mb r = moveBranch mb r <=< thawRef 325 | 326 | -- | With a 'MutBranch', overwrite an @s@ as an @a@, on that branch. 327 | -- 328 | -- @ 329 | -- ghci> r <- thawRef (Left 10) 330 | -- ghci> s <- thawRef 100 331 | -- ghci> moveBranch (constrMB #_Left) r s 332 | -- ghci> freezeRef r 333 | -- Left 100 334 | -- ghci> t <- thawRef True 335 | -- ghci> moveBranch (constrMB #_Right) r t 336 | -- ghci> freezeRef r 337 | -- Right True 338 | -- @ 339 | moveBranch 340 | :: (Mutable s b, PrimMonad m, PrimState m ~ s) 341 | => MutBranch s b a 342 | -> Ref s b 343 | -> Ref s a 344 | -> m () 345 | moveBranch mb r = moveRef r <=< embedBranch mb 346 | 347 | -- | With a 'MutBranch', attempt to clone out a branch of a mutable 348 | -- @s@, if possible. 349 | -- 350 | -- @ 351 | -- ghci> r <- thawRef (Left 10) 352 | -- ghci> s <- cloneBranch (constrMB #_Left) 353 | -- ghci> case s of Just s' -> freezeRef s' 354 | -- 10 355 | -- @ 356 | -- 357 | -- @ 358 | -- ghci> r <- thawRef (Right True) 359 | -- ghci> s <- cloneBranch (constrMB #_Left) 360 | -- ghci> case s of Nothing -> "it was Right" 361 | -- "it was Right" 362 | -- @ 363 | cloneBranch 364 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 365 | => MutBranch s b a -- ^ How to check if @s@ is an @a@ 366 | -> Ref s b -- ^ Structure to read out of 367 | -> m (Maybe (Ref s a)) 368 | cloneBranch mb = mapM cloneRef <=< projectBranch mb 369 | 370 | -- | A non-copying version of 'freezeBranch' that can be more efficient 371 | -- for types where the mutable representation is the same as the immutable 372 | -- one (like 'V.Vector'). 373 | -- 374 | -- This is safe as long as you never again modify the mutable 375 | -- reference, since it can potentially directly mutate the frozen value 376 | -- magically. 377 | unsafeFreezeBranch 378 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 379 | => MutBranch s b a -- ^ How to check if is @s@ is an @a@ 380 | -> Ref s b -- ^ Structure to read out of 381 | -> m (Maybe a) 382 | unsafeFreezeBranch mb = mapM unsafeFreezeRef <=< projectBranch mb 383 | 384 | -- | A non-copying version of 'thawBranch' that can be more efficient for 385 | -- types where the mutable representation is the same as the immutable one 386 | -- (like 'V.Vector'). 387 | -- 388 | -- This is safe as long as you never again use the original pure value, 389 | -- since it can potentially directly mutate it. 390 | unsafeThawBranch 391 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 392 | => MutBranch s b a 393 | -> a 394 | -> m (Ref s b) 395 | unsafeThawBranch mb = embedBranch mb <=< unsafeThawRef 396 | 397 | 398 | -- | With a 'MutBranch', if an @s@ is on the @a@ branch, perform an action 399 | -- on the @a@ reference and overwrite the @s@ with the modified @a@. 400 | -- Returns the result of the action, if @a@ was found. 401 | -- 402 | -- @ 403 | -- ghci> r <- 'thawRef' (Just 10) 404 | -- ghci> 'withBranch_' ('constrMB' #_Just) $ \i -> -- @i@ is an Int ref 405 | -- .. 'modifyRef' i (+ 1) 406 | -- ghci> 'freezeRef' r 407 | -- Just 11 408 | -- @ 409 | -- 410 | -- @ 411 | -- ghci> r <- thawRef Nothing 412 | -- ghci> withBranch_ (constrMB #_Just) $ \i -> -- @i@ is an Int ref 413 | -- .. modifyRef i (+ 1) 414 | -- ghci> freezeRef r 415 | -- Nothing 416 | -- @ 417 | withBranch 418 | :: (PrimMonad m, PrimState m ~ s) 419 | => MutBranch s b a -- ^ How to check if is @s@ is an @a@ 420 | -> Ref s b -- ^ Structure to read out of and write into 421 | -> (Ref s a -> m r) -- ^ Action to perform on the @a@ branch of @s@ 422 | -> m (Maybe r) 423 | withBranch mb r f = mapM f =<< projectBranch mb r 424 | 425 | -- | 'withBranch', but discarding the returned value. 426 | withBranch_ 427 | :: (PrimMonad m, PrimState m ~ s) 428 | => MutBranch s b a -- ^ How to check if is @s@ is an @a@ 429 | -> Ref s b -- ^ Structure to read out of and write into 430 | -> (Ref s a -> m r) -- ^ Action to perform on the @a@ branch of @s@ 431 | -> m () 432 | withBranch_ mb r = void . withBranch mb r 433 | 434 | -- | With a 'MutBranch', run a pure function over a potential branch @a@ of 435 | -- @s@. If @s@ is not on that branch, leaves @s@ unchanged. 436 | -- 437 | -- @ 438 | -- ghci> r <- 'thawRef' (Just 10) 439 | -- ghci> 'modifyBranch' ('constrMB' #_Just) r (+ 1) 440 | -- ghci> freezeRef r 441 | -- Just 11 442 | -- @ 443 | -- 444 | -- @ 445 | -- ghci> r <- thawRef Nothing 446 | -- ghci> modifyBranch (constrMB #_Just) r (+ 1) 447 | -- ghci> freezeRef r 448 | -- Nothing 449 | -- @ 450 | modifyBranch 451 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 452 | => MutBranch s b a -- ^ How to check if @s@ is an @a@ 453 | -> Ref s b -- ^ Structure to read out of and write into 454 | -> (a -> a) -- ^ Pure function modifying @a@ 455 | -> m () 456 | modifyBranch mb r f = withBranch_ mb r (`modifyRef` f) 457 | 458 | -- | 'modifyBranch', but forces the result before storing it back in the 459 | -- reference. 460 | modifyBranch' 461 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 462 | => MutBranch s b a -- ^ How to check if @s@ is an @a@ 463 | -> Ref s b -- ^ Structure to read out of and write into 464 | -> (a -> a) -- ^ Pure function modifying @a@ 465 | -> m () 466 | modifyBranch' mb r f = withBranch_ mb r (`modifyRef'` f) 467 | 468 | -- | 'modifyBranch' but for a monadic function. Uses 'copyRef' into the 469 | -- reference after the action is completed. 470 | modifyBranchM 471 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 472 | => MutBranch s b a -- ^ How to check if @s@ is an @a@ 473 | -> Ref s b -- ^ Structure to read out of and write into 474 | -> (a -> m a) -- ^ Monadic function modifying @a@ 475 | -> m () 476 | modifyBranchM mb r f = withBranch_ mb r (`modifyRefM` f) 477 | 478 | -- | 'modifyBranchM', but forces the result before storing it back in the 479 | -- reference. 480 | modifyBranchM' 481 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 482 | => MutBranch s b a -- ^ How to check if @s@ is an @a@ 483 | -> Ref s b -- ^ Structure to read out of and write into 484 | -> (a -> m a) -- ^ Monadic function modifying @a@ 485 | -> m () 486 | modifyBranchM' mb r f = withBranch_ mb r (`modifyRefM'` f) 487 | 488 | -- | With a 'MutBranch', run a pure function over a potential branch @a@ of 489 | -- @s@. The function returns the updated @a@ and also an output value to 490 | -- observe. If @s@ is not on that branch, leaves @s@ unchanged. 491 | -- 492 | -- @ 493 | -- ghci> r <- 'thawRef' (Just 10) 494 | -- ghci> 'updateBranch' ('constrMB' #_Just) r $ \i -> (i + 1, show i) 495 | -- Just "10" 496 | -- ghci> 'freezeRef' r 497 | -- Just 11 498 | -- @ 499 | -- 500 | -- @ 501 | -- ghci> r <- thawRef Nothing 502 | -- ghci> updateBranch (constrMB #_Just) r $ \i -> (i + 1, show i) 503 | -- Nothing 504 | -- ghci> freezeRef r 505 | -- Nothing 506 | -- @ 507 | updateBranch 508 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 509 | => MutBranch s b a -- ^ How to check if @s@ is an @a@ 510 | -> Ref s b -- ^ Structure to read out of and write into 511 | -> (a -> (a, r)) 512 | -> m (Maybe r) 513 | updateBranch mb r f = withBranch mb r (`updateRef` f) 514 | 515 | -- | 'updateBranch', but forces the result before storing it back in the 516 | -- reference. 517 | updateBranch' 518 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 519 | => MutBranch s b a -- ^ How to check if @s@ is an @a@ 520 | -> Ref s b -- ^ Structure to read out of and write into 521 | -> (a -> (a, r)) 522 | -> m (Maybe r) 523 | updateBranch' mb r f = withBranch mb r (`updateRef'` f) 524 | 525 | -- | 'updateBranch' but for a monadic function. Uses 'copyRef' into the 526 | -- reference after the action is completed. 527 | updateBranchM 528 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 529 | => MutBranch s b a -- ^ How to check if @s@ is an @a@ 530 | -> Ref s b -- ^ Structure to read out of and write into 531 | -> (a -> m (a, r)) 532 | -> m (Maybe r) 533 | updateBranchM mb r f = withBranch mb r (`updateRefM` f) 534 | 535 | -- | 'updateBranchM', but forces the result before storing it back in the 536 | -- reference. 537 | updateBranchM' 538 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 539 | => MutBranch s b a -- ^ How to check if @s@ is an @a@ 540 | -> Ref s b -- ^ Structure to read out of and write into 541 | -> (a -> m (a, r)) 542 | -> m (Maybe r) 543 | updateBranchM' mb r f = withBranch mb r (`updateRefM'` f) 544 | 545 | 546 | 547 | -- | A version of 'Data.Vinyl.Derived.Label' that removes an underscore at 548 | -- the beginning when used with -XOverloadedLabels. Used to specify 549 | -- constructors, since labels are currently not able to start with capital 550 | -- letters. 551 | data CLabel (ctor :: Symbol) = CLabel 552 | 553 | instance (ctor_ ~ AppendSymbol "_" ctor) => IsLabel ctor_ (CLabel ctor) where 554 | fromLabel = CLabel 555 | 556 | 557 | 558 | -- | Typeclass powering 'constrMB' using GHC Generics. 559 | -- 560 | -- Heavily inspired by "Data.Generics.Sum.Constructors". 561 | class (GMutable s f, Mutable s a) => GMutBranchConstructor (ctor :: Symbol) s f a | ctor f -> a where 562 | gmbcProj :: (PrimMonad m, PrimState m ~ s) => CLabel ctor -> GRef_ s f x -> m (Maybe (Ref s a)) 563 | gmbcEmbed :: (PrimMonad m, PrimState m ~ s) => CLabel ctor -> Ref s a -> m (GRef_ s f x) 564 | 565 | instance 566 | ( GMutable s f 567 | , Mutable s a 568 | , GIsList (GRef_ s f) (GRef_ s f) (MapRef s as) (MapRef s as) 569 | , GIsList f f as as 570 | , ListTuple a a as as 571 | , ListRefTuple s b as 572 | , Ref s a ~ b 573 | ) 574 | => GMutBranchConstructor ctor s (M1 C ('MetaCons ctor fixity fields) f) a where 575 | gmbcProj _ = pure . Just 576 | . GLP.view (glist . tupledRef @s @b @as) 577 | . unM1 578 | gmbcEmbed _ = pure 579 | . M1 580 | . GLP.view (GL.fromIso (glist . tupledRef @s @b @as)) 581 | 582 | 583 | instance GMutBranchConstructor ctor m f a => GMutBranchConstructor ctor m (M1 D meta f) a where 584 | gmbcProj lb = gmbcProj lb . unM1 585 | gmbcEmbed lb = fmap M1 . gmbcEmbed lb 586 | 587 | instance 588 | ( Mutable s a 589 | , GMutBranchSum ctor (GL.HasCtorP ctor l) s l r a 590 | ) 591 | => GMutBranchConstructor ctor s (l :+: r) a where 592 | gmbcProj = gmbsProj @ctor @(GL.HasCtorP ctor l) 593 | gmbcEmbed = gmbsEmbed @ctor @(GL.HasCtorP ctor l) 594 | 595 | 596 | class ( GMutable s l 597 | , GMutable s r 598 | , Mutable s a 599 | ) => GMutBranchSum (ctor :: Symbol) (contains :: Bool) s l r a | ctor l r -> a where 600 | gmbsProj 601 | :: (PrimMonad m, PrimState m ~ s) 602 | => CLabel ctor 603 | -> MutSumF s (GRef_ s l) (GRef_ s r) x 604 | -> m (Maybe (Ref s a)) 605 | gmbsEmbed 606 | :: (PrimMonad m, PrimState m ~ s) 607 | => CLabel ctor 608 | -> Ref s a 609 | -> m (MutSumF s (GRef_ s l) (GRef_ s r) x) 610 | 611 | instance 612 | ( GMutable s r 613 | , GMutBranchConstructor ctor s l a 614 | , GIsList (GRef_ s l) (GRef_ s l) (MapRef s as) (MapRef s as) 615 | , GIsList l l as as 616 | , ListTuple a a as as 617 | , ListRefTuple s b as 618 | , Ref s a ~ b 619 | ) 620 | => GMutBranchSum ctor 'True s l r a where 621 | gmbsProj lb (MutSumF r) = readMutVar r >>= \case 622 | L1 x -> gmbcProj lb x 623 | R1 _ -> pure Nothing 624 | gmbsEmbed _ = fmap MutSumF . newMutVar . L1 625 | . GLP.view (GL.fromIso (glist . tupledRef @s @b @as)) 626 | 627 | instance 628 | ( GMutable s l 629 | , GMutBranchConstructor ctor s r a 630 | , Ref s a ~ b 631 | ) 632 | => GMutBranchSum ctor 'False s l r a where 633 | gmbsProj lb (MutSumF r) = readMutVar r >>= \case 634 | L1 _ -> pure Nothing 635 | R1 x -> gmbcProj lb x 636 | gmbsEmbed lb r = do 637 | gr <- gmbcEmbed lb r 638 | MutSumF <$> newMutVar (R1 gr) 639 | 640 | 641 | -- | Create a 'MutBranch' for any data type with a 'Generic' instance by 642 | -- specifying the constructor name using OverloadedLabels 643 | -- 644 | -- @ 645 | -- ghci> r <- 'thawRef' (Left 10) 646 | -- ghci> 'freezeBranch' ('constrMB' #_Left) r 647 | -- Just 10 648 | -- ghci> freezeBranch (constrMB #_Right) r 649 | -- Nothing 650 | -- @ 651 | -- 652 | -- Note that due to limitations in OverloadedLabels, you must prefix the 653 | -- constructor name with an undescore. 654 | -- 655 | -- There also isn't currently any way to utilize OverloadedLabels with 656 | -- operator identifiers, so using it with operator constructors (like @:@ 657 | -- and @[]@) requires explicit TypeApplications: 658 | -- 659 | -- @ 660 | -- -- | 'MutBranch' focusing on the cons case of a list 661 | -- consMB :: (PrimMonad m, Mutable s a) => MutBranch s [a] (a, [a]) 662 | -- consMB = 'constrMB' ('CLabel' @":") 663 | -- @ 664 | constrMB 665 | :: forall ctor s b a. 666 | ( Ref s b ~ GRef s b 667 | , GMutBranchConstructor ctor s (Rep b) a 668 | ) 669 | => CLabel ctor 670 | -> MutBranch s b a 671 | constrMB l = MutBranch 672 | { projectBranch = gmbcProj l . unGRef 673 | , embedBranch = fmap GRef . gmbcEmbed l 674 | } 675 | 676 | -- | 'MutBranch' focusing on the nil case of a list 677 | nilMB :: Mutable s a => MutBranch s [a] () 678 | nilMB = constrMB (CLabel @"[]") 679 | 680 | -- | 'MutBranch' focusing on the cons case of a list 681 | consMB :: Mutable s a => MutBranch s [a] (a, [a]) 682 | consMB = constrMB (CLabel @":") 683 | 684 | -- | 'MutBranch' focusing on the 'Nothing' case of a 'Maybe' 685 | nothingMB :: Mutable s a => MutBranch s (Maybe a) () 686 | nothingMB = constrMB #_Nothing 687 | 688 | -- | 'MutBranch' focusing on the 'Just' case of a 'Maybe' 689 | justMB :: Mutable s a => MutBranch s (Maybe a) a 690 | justMB = constrMB #_Just 691 | 692 | -- | 'MutBranch' focusing on the 'Left' case of an 'Either' 693 | leftMB :: (Mutable s a, Mutable s b) => MutBranch s (Either a b) a 694 | leftMB = constrMB #_Left 695 | 696 | -- | 'MutBranch' focusing on the 'Right' case of an 'Either' 697 | rightMB :: (Mutable s a, Mutable s b) => MutBranch s (Either a b) b 698 | rightMB = constrMB #_Right 699 | -------------------------------------------------------------------------------- /src/Data/Mutable/Class.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE AllowAmbiguousTypes #-} 2 | {-# LANGUAGE DeriveFoldable #-} 3 | {-# LANGUAGE DeriveFunctor #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | {-# LANGUAGE DeriveTraversable #-} 6 | {-# LANGUAGE FlexibleContexts #-} 7 | {-# LANGUAGE FlexibleInstances #-} 8 | {-# LANGUAGE GADTs #-} 9 | {-# LANGUAGE MultiParamTypeClasses #-} 10 | {-# LANGUAGE RankNTypes #-} 11 | {-# LANGUAGE ScopedTypeVariables #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeFamilyDependencies #-} 14 | {-# LANGUAGE TypeInType #-} 15 | {-# LANGUAGE TypeOperators #-} 16 | {-# LANGUAGE UndecidableInstances #-} 17 | 18 | -- | 19 | -- Module : Data.Mutable.Class 20 | -- Copyright : (c) Justin Le 2020 21 | -- License : BSD3 22 | -- 23 | -- Maintainer : justin@jle.im 24 | -- Stability : experimental 25 | -- Portability : non-portable 26 | -- 27 | -- Provides the 'Mutable' typeclass and various helpers. See 28 | -- "Data.Mutable" for the main "entrypoint". Many of the datatypes used 29 | -- for 'Ref' instances are defined in "Data.Mutable.Instances" 30 | module Data.Mutable.Class ( 31 | Mutable(..) 32 | , copyRefWhole, moveRefWhole, cloneRefWhole 33 | , modifyRef, modifyRef' 34 | , updateRef, updateRef' 35 | , modifyRefM, modifyRefM' 36 | , updateRefM, updateRefM' 37 | , RefFor(..) 38 | , DefaultMutable(..) 39 | -- * Providing and overwriting instances 40 | , VarMut(..) 41 | , CoerceMut(..) 42 | , TraverseMut(..) 43 | , Immutable(..) 44 | -- * Util 45 | , MapRef 46 | ) where 47 | 48 | import Control.Monad 49 | import Control.Monad.Primitive 50 | import Data.Coerce 51 | import Data.Mutable.Instances 52 | import Data.Mutable.Internal 53 | import Data.Primitive.MutVar 54 | import GHC.Generics 55 | import qualified Data.Vinyl.XRec as X 56 | 57 | -- | Apply a pure function on an immutable value onto a value stored in 58 | -- a mutable reference. 59 | modifyRef 60 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 61 | => Ref s a 62 | -> (a -> a) 63 | -> m () 64 | modifyRef v f = copyRef v . f =<< freezeRef v 65 | {-# INLINE modifyRef #-} 66 | 67 | -- | 'modifyRef', but forces the result before storing it back in the 68 | -- reference. 69 | modifyRef' 70 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 71 | => Ref s a 72 | -> (a -> a) 73 | -> m () 74 | modifyRef' v f = (copyRef v $!) . f =<< freezeRef v 75 | {-# INLINE modifyRef' #-} 76 | 77 | -- | Apply a monadic function on an immutable value onto a value stored in 78 | -- a mutable reference. Uses 'copyRef' into the reference after the 79 | -- action is completed. 80 | modifyRefM 81 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 82 | => Ref s a 83 | -> (a -> m a) 84 | -> m () 85 | modifyRefM v f = copyRef v =<< f =<< freezeRef v 86 | {-# INLINE modifyRefM #-} 87 | 88 | -- | 'modifyRefM', but forces the result before storing it back in the 89 | -- reference. 90 | modifyRefM' 91 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 92 | => Ref s a 93 | -> (a -> m a) 94 | -> m () 95 | modifyRefM' v f = (copyRef v $!) =<< f =<< freezeRef v 96 | {-# INLINE modifyRefM' #-} 97 | 98 | -- | Apply a pure function on an immutable value onto a value stored in 99 | -- a mutable reference, returning a result value from that function. 100 | updateRef 101 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 102 | => Ref s a 103 | -> (a -> (a, b)) 104 | -> m b 105 | updateRef v f = do 106 | (x, y) <- f <$> freezeRef v 107 | copyRef v x 108 | return y 109 | 110 | -- | 'updateRef', but forces the updated value before storing it back in the 111 | -- reference. 112 | updateRef' 113 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 114 | => Ref s a 115 | -> (a -> (a, b)) 116 | -> m b 117 | updateRef' v f = do 118 | (x, y) <- f <$> freezeRef v 119 | x `seq` copyRef v x 120 | return y 121 | 122 | -- | Apply a monadic function on an immutable value onto a value stored in 123 | -- a mutable reference, returning a result value from that function. Uses 124 | -- 'copyRef' into the reference after the action is completed. 125 | updateRefM 126 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 127 | => Ref s a 128 | -> (a -> m (a, b)) 129 | -> m b 130 | updateRefM v f = do 131 | (x, y) <- f =<< freezeRef v 132 | copyRef v x 133 | return y 134 | 135 | -- | 'updateRefM', but forces the updated value before storing it back in the 136 | -- reference. 137 | updateRefM' 138 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 139 | => Ref s a 140 | -> (a -> m (a, b)) 141 | -> m b 142 | updateRefM' v f = do 143 | (x, y) <- f =<< freezeRef v 144 | x `seq` copyRef v x 145 | return y 146 | 147 | -- | A default implementation of 'copyRef' using 'thawRef' and 'moveRef'. 148 | copyRefWhole 149 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 150 | => Ref s a -- ^ destination to overwrite 151 | -> a -- ^ pure value 152 | -> m () 153 | copyRefWhole r v = moveRef r =<< thawRef v 154 | {-# INLINE copyRefWhole #-} 155 | 156 | -- | A default implementation of 'moveRef' that round-trips through the 157 | -- pure type, using 'freezeRef' and 'copyRef'. It freezes the entire source 158 | -- and then re-copies it into the destination. 159 | moveRefWhole 160 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 161 | => Ref s a -- ^ destination 162 | -> Ref s a -- ^ source 163 | -> m () 164 | moveRefWhole r v = copyRef r =<< freezeRef v 165 | {-# INLINE moveRefWhole #-} 166 | 167 | -- | A default implementation of 'moveRef' that round-trips through the 168 | -- pure type, using 'freezeRef' and 'thawRef'. It freezes the entire 169 | -- source and then re-copies it into the destination. 170 | cloneRefWhole 171 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 172 | => Ref s a 173 | -> m (Ref s a) 174 | cloneRefWhole = thawRef <=< freezeRef 175 | {-# INLINE cloneRefWhole #-} 176 | 177 | -- | Newtype wrapper that can provide any type with a 'Mutable' instance, 178 | -- giving it a "non-piecewise" instance. Can be useful for avoiding orphan 179 | -- instances yet still utilizing auto-deriving features, or for overwriting 180 | -- the 'Mutable' instance of other instances. 181 | -- 182 | -- For example, let's say you want to auto-derive an instance for your data 183 | -- type: 184 | -- 185 | -- @ 186 | -- data MyType = MT Int Double OtherType 187 | -- deriving Generic 188 | -- @ 189 | -- 190 | -- This is possible if all of @MyType@s fields have 'Mutable' instances. 191 | -- However, let's say @OtherType@ comes from an external library that you 192 | -- don't have control over, and so you cannot give it a 'Mutable' instance 193 | -- without incurring an orphan instance. 194 | -- 195 | -- One solution is to wrap it in 'VarMut': 196 | -- 197 | -- @ 198 | -- data MyType = MT Int Double ('VarMut' OtherType) 199 | -- deriving Generic 200 | -- @ 201 | -- 202 | -- This can then be auto-derived: 203 | -- 204 | -- @ 205 | -- instance Mutable s MyType where 206 | -- type Ref s MyType = GRef s MyType 207 | -- @ 208 | -- 209 | -- It can also be used to /override/ a 'Mutable' instance. For example, 210 | -- even if the 'Mutable' instance of @SomeType@ is piecewise-mutable, the 211 | -- 'Mutable' instance of @'VarMut' SomeType@ will be not be piecewise. 212 | -- 213 | -- For example, the 'Mutable' instance for 'String' is a mutable linked 214 | -- list, but it might be more efficient to treat it as an atomic value to 215 | -- update all at once. You can use @'VarMut' 'String'@ to get that 216 | -- 'Mutable' instance. 217 | newtype VarMut a = VarMut { getVarMut :: a } 218 | 219 | -- | Use a @'VarMut' a@ as if it were an @a@. 220 | instance X.IsoHKD VarMut a where 221 | type HKD VarMut a = a 222 | unHKD = VarMut 223 | toHKD = getVarMut 224 | 225 | instance Mutable s (VarMut a) where 226 | type Ref s (VarMut a) = MutVar s (VarMut a) 227 | 228 | 229 | -- | Similar to 'VarMut', this allows you to overwrite the normal 'Mutable' 230 | -- instance for a type to utilize its 'Traversable' instance instead of its 231 | -- normal instance. It's also useful to provide an instance for an 232 | -- externally defined type without incurring orphan instances. 233 | -- 234 | -- For example, the instance of @'Mutable' ('TraverseMut' [] a)@ is 235 | -- a normal list of mutable references, instead of a full-on mutable linked 236 | -- list. 237 | newtype TraverseMut f a = TraverseMut { getTraverseMut :: f a } 238 | deriving (Show, Eq, Ord, Generic, Functor, Foldable, Traversable) 239 | 240 | -- | Use a @'TraverseMut' f a@ as if it were an @f a@ 241 | instance X.IsoHKD (TraverseMut f) a where 242 | type HKD (TraverseMut f) a = f a 243 | unHKD = TraverseMut 244 | toHKD = getTraverseMut 245 | 246 | instance (Traversable f, Mutable s a) => Mutable s (TraverseMut f a) where 247 | type Ref s (TraverseMut f a) = TraverseRef s (TraverseMut f) a 248 | 249 | -- | Similar to 'VarMut', this allows you to overwrite the normal 'Mutable' 250 | -- instance of a type to utilize a coercible type's 'Mutable' instance 251 | -- instead of its normal instance. It's also useful to provide an instance for 252 | -- an externally defined type without incurring orphan instances. 253 | -- 254 | -- For example, if an external library provides 255 | -- 256 | -- @ 257 | -- newtype DoubleVec = DV (Vector Double) 258 | -- @ 259 | -- 260 | -- and you want to use it following 'V.Vector's 'Mutable' instance (via 261 | -- 'MV.MVector'), but you don't want to write an orphan instance like 262 | -- 263 | -- @ 264 | -- instance Mutable s DoubleVec where 265 | -- type 'Ref' s DoubleVec = 'CoerceRef' s DoubleVec (Vector Double) 266 | -- @ 267 | -- 268 | -- then you can instead use @'CoerceMut' DoubleVec (Vector Double)@ as the 269 | -- data type. This wrapped type /does/ use the inderlying 'Mutable' 270 | -- insatnce for 'V.Vector'. 271 | newtype CoerceMut s a = CoerceMut { getCoerceMut :: s } 272 | 273 | -- | Use a @'CoerceMut' s a@ as if it were an @s@ 274 | instance X.IsoHKD (CoerceMut s) a where 275 | type HKD (CoerceMut s) a = s 276 | unHKD = CoerceMut 277 | toHKD = getCoerceMut 278 | 279 | instance (Mutable s a, Coercible s a) => Mutable s (CoerceMut s a) where 280 | type Ref s (CoerceMut s a) = CoerceRef s (CoerceMut s a) a 281 | 282 | -- | Similar to 'VarMut', this allows you to overwrite the normal 'Mutable' 283 | -- instance of a type to make it /immutable/. 284 | -- 285 | -- For example, let's say you have a type, with the automatically derived 286 | -- generic instance of 'Mutable': 287 | -- 288 | -- @ 289 | -- data MyType = MT 290 | -- { mtX :: Int 291 | -- , mtY :: Vector Double 292 | -- , mtZ :: String 293 | -- } 294 | -- deriving Generic 295 | -- 296 | -- instance Mutable s MyType where 297 | -- type Ref s MyType = GRef s MyType 298 | -- @ 299 | -- 300 | -- This basically uses three mutable references: the 'Int', the @'V.Vector' 301 | -- Double@, and the 'String'. However, you might want the 'Mutable' 302 | -- instance of @MyType@ to be /immutable/ 'String' field, and so it cannot 303 | -- be updated at all even when thawed. To do that, you can instead have: 304 | -- 305 | -- @ 306 | -- data MyType = MT 307 | -- { mtX :: Int 308 | -- , mtY :: Vector Double 309 | -- , mtZ :: 'Immutable' String 310 | -- } 311 | -- deriving Generic 312 | -- 313 | -- instance Mutable s MyType where 314 | -- type Ref s MyType = GRef s MyType 315 | -- @ 316 | -- 317 | -- which has that behavior. The 'Int' and the 'V.Vector' will be mutable 318 | -- within @'Ref' s MyType@, but not the 'String'. 319 | newtype Immutable s a = Immutable { getImmutable :: a } 320 | 321 | -- | Use an @'Immutable' a@ as if it were an @a@ 322 | instance X.IsoHKD (Immutable s) a where 323 | type HKD (Immutable s) a = a 324 | unHKD = Immutable 325 | toHKD = getImmutable 326 | 327 | 328 | instance Mutable s (Immutable s a) where 329 | type Ref s (Immutable s a) = ImmutableRef s (Immutable s a) 330 | 331 | -------------------------------------------------------------------------------- /src/Data/Mutable/Instances.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE DeriveFoldable #-} 3 | {-# LANGUAGE DeriveTraversable #-} 4 | {-# LANGUAGE EmptyCase #-} 5 | {-# LANGUAGE EmptyDataDeriving #-} 6 | {-# LANGUAGE FlexibleContexts #-} 7 | {-# LANGUAGE FlexibleInstances #-} 8 | {-# LANGUAGE GADTs #-} 9 | {-# LANGUAGE LambdaCase #-} 10 | {-# LANGUAGE MultiParamTypeClasses #-} 11 | {-# LANGUAGE StandaloneDeriving #-} 12 | {-# LANGUAGE TemplateHaskell #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE TypeInType #-} 15 | {-# LANGUAGE TypeOperators #-} 16 | {-# LANGUAGE UndecidableInstances #-} 17 | {-# OPTIONS_GHC -fno-warn-orphans #-} 18 | 19 | -- | 20 | -- Module : Data.Mutable.Instances 21 | -- Copyright : (c) Justin Le 2020 22 | -- License : BSD3 23 | -- 24 | -- Maintainer : justin@jle.im 25 | -- Stability : experimental 26 | -- Portability : non-portable 27 | -- 28 | -- Exports 'Ref' data types for various common data types, and also the 29 | -- tools for automatic derivation of instances. See "Data.Mutable" for 30 | -- more information. 31 | module Data.Mutable.Instances ( 32 | RecRef(..) 33 | , HListRef(..) 34 | , UnitRef(..) 35 | , VoidRef 36 | -- * Generic 37 | , GRef(..) 38 | , gThawRef, gFreezeRef 39 | , gCopyRef, gMoveRef, gCloneRef 40 | , gUnsafeThawRef, gUnsafeFreezeRef 41 | , GMutable (GRef_) 42 | -- * Higher-Kinded Data Pattern 43 | , thawHKD, freezeHKD 44 | , copyHKD, moveHKD, cloneHKD 45 | , unsafeThawHKD, unsafeFreezeHKD 46 | -- * Coercible 47 | , CoerceRef(..) 48 | , thawCoerce, freezeCoerce 49 | , copyCoerce, moveCoerce, cloneCoerce 50 | , unsafeThawCoerce, unsafeFreezeCoerce 51 | -- * Traversable 52 | , TraverseRef(..) 53 | , thawTraverse, freezeTraverse 54 | , copyTraverse, moveTraverse, cloneTraverse 55 | , unsafeThawTraverse, unsafeFreezeTraverse 56 | -- * Immutable 57 | , ImmutableRef(..), thawImmutable, freezeImmutable, copyImmutable 58 | -- * Instances for Generics combinators themselves 59 | , GMutableRef(..) 60 | , MutSumF(..) 61 | -- * Utility 62 | , MapRef 63 | ) where 64 | 65 | import Control.Applicative 66 | import Data.Complex 67 | import Data.Functor.Compose 68 | import Data.Functor.Identity 69 | import Data.Functor.Product 70 | import Data.Functor.Sum 71 | import Data.Generics.Product.Internal.HList (HList(..)) 72 | import Data.Kind 73 | import Data.Mutable.Internal 74 | import Data.Mutable.Internal.TH 75 | import Data.Ord 76 | import Data.Primitive.Array 77 | import Data.Primitive.ByteArray 78 | import Data.Primitive.PrimArray 79 | import Data.Primitive.SmallArray 80 | import Data.Primitive.Types 81 | import Data.Ratio 82 | import Data.Vinyl as V hiding (HList) 83 | import Data.Void 84 | import Data.Word 85 | import Foreign.C.Types 86 | import Foreign.Storable 87 | import Numeric.Natural 88 | import qualified Data.Monoid as M 89 | import qualified Data.Vector as V 90 | import qualified Data.Vector.Generic as VG 91 | import qualified Data.Vector.Generic.Mutable as MVG 92 | import qualified Data.Vector.Mutable as MV 93 | import qualified Data.Vector.Primitive as VP 94 | import qualified Data.Vector.Primitive.Mutable as MVP 95 | import qualified Data.Vector.Storable as VS 96 | import qualified Data.Vector.Storable.Mutable as MVS 97 | import qualified Data.Vector.Unboxed as VU 98 | import qualified Data.Vector.Unboxed.Mutable as MVU 99 | import qualified Data.Vinyl.ARec as V 100 | import qualified Data.Vinyl.Functor as V 101 | import qualified Data.Vinyl.TypeLevel as V 102 | 103 | instance Mutable s Int 104 | instance Mutable s Integer 105 | instance Mutable s Natural 106 | instance Mutable s (Ratio a) 107 | instance Mutable s Float 108 | instance Mutable s Double 109 | instance Mutable s (Complex a) 110 | instance Mutable s Bool 111 | instance Mutable s Char 112 | 113 | instance Mutable s Word 114 | instance Mutable s Word8 115 | instance Mutable s Word16 116 | instance Mutable s Word64 117 | 118 | instance Mutable s CChar 119 | instance Mutable s CSChar 120 | instance Mutable s CUChar 121 | instance Mutable s CShort 122 | instance Mutable s CUShort 123 | instance Mutable s CInt 124 | instance Mutable s CUInt 125 | instance Mutable s CLong 126 | instance Mutable s CULong 127 | instance Mutable s CPtrdiff 128 | instance Mutable s CSize 129 | instance Mutable s CWchar 130 | instance Mutable s CSigAtomic 131 | instance Mutable s CLLong 132 | instance Mutable s CULLong 133 | instance Mutable s CBool 134 | instance Mutable s CIntPtr 135 | instance Mutable s CUIntPtr 136 | instance Mutable s CIntMax 137 | instance Mutable s CUIntMax 138 | instance Mutable s CClock 139 | instance Mutable s CTime 140 | instance Mutable s CUSeconds 141 | instance Mutable s CSUSeconds 142 | instance Mutable s CFloat 143 | instance Mutable s CDouble 144 | 145 | instance Mutable s a => Mutable s (Identity a) where 146 | type Ref s (Identity a) = CoerceRef s (Identity a) a 147 | 148 | instance Mutable s a => Mutable s (Const a b) where 149 | type Ref s (Const a b) = CoerceRef s (Const a b) a 150 | 151 | instance Mutable s a => Mutable s (V.Const a b) where 152 | type Ref s (V.Const a b) = CoerceRef s (V.Const a b) a 153 | 154 | instance Mutable s a => Mutable s (M.Product a) where 155 | type Ref s (M.Product a) = CoerceRef s (M.Product a) a 156 | 157 | instance Mutable s a => Mutable s (M.Sum a) where 158 | type Ref s (M.Sum a) = CoerceRef s (M.Sum a) a 159 | 160 | instance Mutable s a => Mutable s (Down a) where 161 | type Ref s (Down a) = CoerceRef s (Down a) a 162 | 163 | instance Mutable s a => Mutable s (M.Dual a) where 164 | type Ref s (M.Dual a) = CoerceRef s (M.Dual a) a 165 | 166 | instance Mutable s a => Mutable s (Maybe a) where 167 | type Ref s (Maybe a) = GRef s (Maybe a) 168 | 169 | instance (Mutable s a, Mutable s b) => Mutable s (Either a b) where 170 | type Ref s (Either a b) = GRef s (Either a b) 171 | 172 | instance (Mutable s (f a), Mutable s (g a)) => Mutable s (Product f g a) where 173 | type Ref s (Product f g a) = GRef s (Product f g a) 174 | 175 | instance (Mutable s (f a), Mutable s (g a)) => Mutable s (Sum f g a) where 176 | type Ref s (Sum f g a) = GRef s (Sum f g a) 177 | 178 | instance (Mutable s (f (g a))) => Mutable s (Compose f g a) where 179 | type Ref s (Compose f g a) = CoerceRef s (Compose f g a) (f (g a)) 180 | 181 | -- | Mutable linked list with mutable references in each cell. See 182 | -- 'Data.Mutable.MutBranch' documentation for an example of using this as 183 | -- a mutable linked list.l 184 | instance Mutable s a => Mutable s [a] where 185 | type Ref s [a] = GRef s [a] 186 | 187 | -- | Meant for usage with higher-kinded data pattern (See 'X.HKD') 188 | instance Mutable s a => Mutable s (V.Identity a) where 189 | type Ref s (V.Identity a) = RefFor s a 190 | thawRef (V.Identity x) = RefFor <$> thawRef x 191 | freezeRef (RefFor r) = V.Identity <$> freezeRef r 192 | copyRef (RefFor r) (V.Identity x) = copyRef r x 193 | moveRef (RefFor r) (RefFor v) = moveRef r v 194 | cloneRef = fmap RefFor . cloneRef . getRefFor 195 | unsafeThawRef (V.Identity x) = RefFor <$> unsafeThawRef x 196 | unsafeFreezeRef (RefFor r) = V.Identity <$> unsafeFreezeRef r 197 | 198 | -- | Mutable reference is 'MV.MVector'. 199 | instance Mutable s (V.Vector a) where 200 | type Ref s (V.Vector a) = MV.MVector s a 201 | thawRef = VG.thaw 202 | freezeRef = VG.freeze 203 | copyRef = VG.copy 204 | moveRef = MVG.move 205 | cloneRef = MVG.clone 206 | unsafeThawRef = VG.unsafeThaw 207 | unsafeFreezeRef = VG.unsafeFreeze 208 | 209 | -- | Mutable reference is 'MVS.MVector'. 210 | instance Storable a => Mutable s (VS.Vector a) where 211 | type Ref s (VS.Vector a) = MVS.MVector s a 212 | thawRef = VG.thaw 213 | freezeRef = VG.freeze 214 | copyRef = VG.copy 215 | moveRef = MVG.move 216 | cloneRef = MVG.clone 217 | unsafeThawRef = VG.unsafeThaw 218 | unsafeFreezeRef = VG.unsafeFreeze 219 | 220 | -- | Mutable reference is 'MVU.MVector'. 221 | instance VU.Unbox a => Mutable s (VU.Vector a) where 222 | type Ref s (VU.Vector a) = MVU.MVector s a 223 | thawRef = VG.thaw 224 | freezeRef = VG.freeze 225 | copyRef = VG.copy 226 | moveRef = MVG.move 227 | cloneRef = MVG.clone 228 | unsafeThawRef = VG.unsafeThaw 229 | unsafeFreezeRef = VG.unsafeFreeze 230 | 231 | -- | Mutable reference is 'MVP.MVector'. 232 | instance Prim a => Mutable s (VP.Vector a) where 233 | type Ref s (VP.Vector a) = MVP.MVector s a 234 | thawRef = VG.thaw 235 | freezeRef = VG.freeze 236 | copyRef = VG.copy 237 | moveRef = MVG.move 238 | cloneRef = MVG.clone 239 | unsafeThawRef = VG.unsafeThaw 240 | unsafeFreezeRef = VG.unsafeFreeze 241 | 242 | instance Mutable s (Array a) where 243 | type Ref s (Array a) = MutableArray s a 244 | 245 | thawRef xs = thawArray xs 0 (sizeofArray xs) 246 | freezeRef rs = freezeArray rs 0 (sizeofMutableArray rs) 247 | copyRef rs xs = copyArray rs 0 xs 0 l 248 | where 249 | l = sizeofArray xs `min` sizeofMutableArray rs 250 | moveRef rs vs = copyMutableArray rs 0 vs 0 l 251 | where 252 | l = sizeofMutableArray vs `min` sizeofMutableArray rs 253 | cloneRef rs = cloneMutableArray rs 0 (sizeofMutableArray rs) 254 | unsafeThawRef = unsafeThawArray 255 | unsafeFreezeRef = unsafeFreezeArray 256 | 257 | instance Mutable s (SmallArray a) where 258 | type Ref s (SmallArray a) = SmallMutableArray s a 259 | 260 | thawRef xs = thawSmallArray xs 0 (sizeofSmallArray xs) 261 | freezeRef rs = freezeSmallArray rs 0 (sizeofSmallMutableArray rs) 262 | copyRef rs xs = copySmallArray rs 0 xs 0 l 263 | where 264 | l = sizeofSmallArray xs `min` sizeofSmallMutableArray rs 265 | moveRef rs vs = copySmallMutableArray rs 0 vs 0 l 266 | where 267 | l = sizeofSmallMutableArray vs `min` sizeofSmallMutableArray rs 268 | cloneRef rs = cloneSmallMutableArray rs 0 (sizeofSmallMutableArray rs) 269 | unsafeThawRef = unsafeThawSmallArray 270 | unsafeFreezeRef = unsafeFreezeSmallArray 271 | 272 | instance Mutable s ByteArray where 273 | type Ref s ByteArray = MutableByteArray s 274 | 275 | thawRef xs = do 276 | rs <- newByteArray (sizeofByteArray xs) 277 | copyByteArray rs 0 xs 0 (sizeofByteArray xs) 278 | pure rs 279 | freezeRef rs = do 280 | xs <- newByteArray (sizeofMutableByteArray rs) 281 | copyMutableByteArray xs 0 rs 0 (sizeofMutableByteArray rs) 282 | unsafeFreezeByteArray xs 283 | copyRef rs xs = copyByteArray rs 0 xs 0 l 284 | where 285 | l = sizeofByteArray xs `min` sizeofMutableByteArray rs 286 | moveRef rs vs = copyMutableByteArray rs 0 vs 0 l 287 | where 288 | l = sizeofMutableByteArray vs `min` sizeofMutableByteArray rs 289 | cloneRef rs = do 290 | vs <- newByteArray (sizeofMutableByteArray rs) 291 | copyMutableByteArray vs 0 rs 0 (sizeofMutableByteArray rs) 292 | pure vs 293 | unsafeThawRef = unsafeThawByteArray 294 | unsafeFreezeRef = unsafeFreezeByteArray 295 | 296 | instance Prim a => Mutable s (PrimArray a) where 297 | type Ref s (PrimArray a) = MutablePrimArray s a 298 | 299 | thawRef xs = do 300 | rs <- newPrimArray (sizeofPrimArray xs) 301 | copyPrimArray rs 0 xs 0 (sizeofPrimArray xs) 302 | pure rs 303 | freezeRef rs = do 304 | xs <- newPrimArray (sizeofMutablePrimArray rs) 305 | copyMutablePrimArray xs 0 rs 0 (sizeofMutablePrimArray rs) 306 | unsafeFreezePrimArray xs 307 | copyRef rs xs = copyPrimArray rs 0 xs 0 l 308 | where 309 | l = sizeofPrimArray xs `min` sizeofMutablePrimArray rs 310 | moveRef rs vs = copyMutablePrimArray rs 0 vs 0 l 311 | where 312 | l = sizeofMutablePrimArray vs `min` sizeofMutablePrimArray rs 313 | cloneRef rs = do 314 | vs <- newPrimArray (sizeofMutablePrimArray rs) 315 | copyMutablePrimArray vs 0 rs 0 (sizeofMutablePrimArray rs) 316 | pure vs 317 | unsafeThawRef = unsafeThawPrimArray 318 | unsafeFreezeRef = unsafeFreezePrimArray 319 | 320 | 321 | data VoidRef s 322 | deriving (Show, Read, Eq, Ord, Functor, Traversable, Foldable) 323 | 324 | instance Mutable s Void where 325 | type Ref s Void = VoidRef s 326 | thawRef = \case {} 327 | freezeRef = \case {} 328 | copyRef = \case {} 329 | moveRef = \case {} 330 | cloneRef = \case {} 331 | unsafeThawRef = \case {} 332 | unsafeFreezeRef = \case {} 333 | 334 | data UnitRef s = UnitRef 335 | deriving (Show, Read, Eq, Ord, Functor, Traversable, Foldable) 336 | 337 | instance Applicative UnitRef where 338 | pure _ = UnitRef 339 | _ <*> _ = UnitRef 340 | 341 | instance Monad UnitRef where 342 | return = pure 343 | _ >>= _ = UnitRef 344 | 345 | instance Mutable s () where 346 | type Ref s () = UnitRef s 347 | thawRef _ = pure UnitRef 348 | freezeRef _ = pure () 349 | copyRef _ _ = pure () 350 | moveRef _ _ = pure () 351 | cloneRef _ = pure UnitRef 352 | unsafeThawRef _ = pure UnitRef 353 | unsafeFreezeRef _ = pure () 354 | 355 | -- | A 'Ref' of a tuple is a tuple of 'Ref's, for easy accessing. 356 | -- 357 | -- @ 358 | -- Ref s (Int, 'V.Vector' Double) = ('Data.Primitive.MutVar.MutVar' s Int, 'MV.MVector' s Double) 359 | -- @ 360 | instance (Mutable s a, Mutable s b) => Mutable s (a, b) where 361 | type Ref s (a, b) = (Ref s a, Ref s b) 362 | thawRef (!x, !y) = (,) <$> thawRef x <*> thawRef y 363 | freezeRef (u , v ) = (,) <$> freezeRef u <*> freezeRef v 364 | copyRef (u , v ) (!x, !y) = copyRef u x *> copyRef v y 365 | moveRef (u , v ) ( x, y) = moveRef u x *> moveRef v y 366 | cloneRef (u , v ) = (,) <$> cloneRef u <*> cloneRef v 367 | unsafeThawRef (!x, !y) = (,) <$> unsafeThawRef x <*> unsafeThawRef y 368 | unsafeFreezeRef (u , v ) = (,) <$> unsafeFreezeRef u <*> unsafeFreezeRef v 369 | 370 | mutableTuples [3..12] 371 | 372 | -- | 'Ref' for components in a vinyl 'Rec'. 373 | newtype RecRef s f a = RecRef { getRecRef :: Ref s (f a) } 374 | 375 | deriving instance Eq (Ref s (f a)) => Eq (RecRef s f a) 376 | deriving instance Ord (Ref s (f a)) => Ord (RecRef s f a) 377 | 378 | instance Mutable s (Rec f '[]) where 379 | type Ref s (Rec f '[]) = Rec (RecRef s f) '[] 380 | thawRef _ = pure RNil 381 | freezeRef _ = pure RNil 382 | copyRef _ _ = pure () 383 | moveRef _ _ = pure () 384 | cloneRef _ = pure RNil 385 | unsafeThawRef _ = pure RNil 386 | unsafeFreezeRef _ = pure RNil 387 | 388 | instance ( Mutable s (f a) 389 | , Mutable s (Rec f as) 390 | , Ref s (Rec f as) ~ Rec (RecRef s f) as 391 | ) => Mutable s (Rec f (a ': as)) where 392 | type Ref s (Rec f (a ': as)) = Rec (RecRef s f) (a ': as) 393 | thawRef = \case 394 | x :& xs -> (:&) <$> (RecRef <$> thawRef x) <*> thawRef xs 395 | freezeRef = \case 396 | RecRef v :& vs -> (:&) <$> freezeRef v <*> freezeRef vs 397 | copyRef = \case 398 | RecRef v :& vs -> \case 399 | x :& xs -> copyRef v x >> copyRef vs xs 400 | moveRef = \case 401 | RecRef v :& vs -> \case 402 | RecRef r :& rs -> 403 | moveRef v r >> moveRef vs rs 404 | cloneRef = \case 405 | RecRef v :& rs -> (:&) <$> (RecRef <$> cloneRef v) <*> cloneRef rs 406 | unsafeThawRef = \case 407 | x :& xs -> (:&) <$> (RecRef <$> unsafeThawRef x) <*> unsafeThawRef xs 408 | unsafeFreezeRef = \case 409 | RecRef v :& vs -> (:&) <$> unsafeFreezeRef v <*> unsafeFreezeRef vs 410 | 411 | 412 | instance ( RecApplicative as 413 | , V.NatToInt (V.RLength as) 414 | , RPureConstrained (V.IndexableField as) as 415 | , Mutable s (Rec f as) 416 | , Ref s (Rec f as) ~ Rec (RecRef s f) as 417 | ) => Mutable s (ARec f as) where 418 | type Ref s (ARec f as) = ARec (RecRef s f) as 419 | 420 | thawRef = fmap toARec . thawRef . fromARec 421 | freezeRef = fmap toARec . freezeRef . fromARec 422 | copyRef r x = copyRef (fromARec r) (fromARec x) 423 | moveRef r v = moveRef (fromARec r) (fromARec v) 424 | cloneRef = fmap toARec . cloneRef . fromARec 425 | unsafeThawRef = fmap toARec . unsafeThawRef . fromARec 426 | unsafeFreezeRef = fmap toARec . unsafeFreezeRef . fromARec 427 | 428 | -- | The mutable reference of the 'HList' type from generic-lens. 429 | data HListRef :: Type -> [Type] -> Type where 430 | NilRef :: HListRef s '[] 431 | (:!>) :: Ref s a -> HListRef s as -> HListRef s (a ': as) 432 | infixr 5 :!> 433 | 434 | instance Mutable s (HList '[]) where 435 | type Ref s (HList '[]) = HListRef s '[] 436 | thawRef _ = pure NilRef 437 | freezeRef _ = pure Nil 438 | copyRef _ _ = pure () 439 | moveRef _ _ = pure () 440 | cloneRef _ = pure NilRef 441 | unsafeThawRef _ = pure NilRef 442 | unsafeFreezeRef _ = pure Nil 443 | 444 | instance (Mutable s a, Mutable s (HList as), Ref s (HList as) ~ HListRef s as) => Mutable s (HList (a ': as)) where 445 | type Ref s (HList (a ': as)) = HListRef s (a ': as) 446 | thawRef = \case 447 | x :> xs -> (:!>) <$> thawRef x <*> thawRef xs 448 | freezeRef = \case 449 | v :!> vs -> (:>) <$> freezeRef v <*> freezeRef vs 450 | copyRef = \case 451 | v :!> vs -> \case 452 | x :> xs -> copyRef v x >> copyRef vs xs 453 | moveRef = \case 454 | v :!> vs -> \case 455 | r :!> rs -> 456 | moveRef v r >> moveRef vs rs 457 | cloneRef = \case 458 | v :!> rs -> (:!>) <$> cloneRef v <*> cloneRef rs 459 | unsafeThawRef = \case 460 | x :> xs -> (:!>) <$> unsafeThawRef x <*> unsafeThawRef xs 461 | unsafeFreezeRef = \case 462 | v :!> vs -> (:>) <$> unsafeFreezeRef v <*> unsafeFreezeRef vs 463 | 464 | -- ListRefTuple instances 465 | 466 | -- this one instance is the reason why we have to define a new typeclass 467 | -- instead of using 'ListRef' -- because of @'ListRef' s () '[]@. 468 | instance ListRefTuple s (UnitRef s) '[] where 469 | tupleToListRef _ = Nil 470 | listRefToTuple _ = UnitRef 471 | 472 | instance (Ref s a ~ ra) => ListRefTuple s ra '[a] where 473 | tupleToListRef x = x :> Nil 474 | listRefToTuple (x :> _) = x 475 | 476 | instance (Ref s a ~ ra, Ref s b ~ rb) => ListRefTuple s (ra, rb) '[a, b] where 477 | tupleToListRef (x, y) = x :> y :> Nil 478 | listRefToTuple (x :> y :> _) = (x, y) 479 | 480 | listRefTuples [3..12] 481 | -------------------------------------------------------------------------------- /src/Data/Mutable/Internal/TH.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | 4 | module Data.Mutable.Internal.TH ( 5 | mutableTuples 6 | , listRefTuples 7 | ) where 8 | 9 | import Control.Monad 10 | import Data.Generics.Product.Internal.HList 11 | import Data.List 12 | import Data.Mutable.Internal 13 | import Language.Haskell.TH 14 | 15 | tyVarNames :: [String] 16 | tyVarNames = (:[]) <$> filter (/= 's') ['a' .. 'z'] 17 | 18 | mutableTuples :: [Int] -> Q [Dec] 19 | mutableTuples = traverse mutableTuple 20 | 21 | listRefTuples :: [Int] -> Q [Dec] 22 | listRefTuples = traverse listRefTuple 23 | 24 | 25 | mutableTuple 26 | :: Int 27 | -> Q Dec 28 | mutableTuple n = do 29 | valVars <- replicateM n (newName "x") 30 | refVars <- replicateM n (newName "r") 31 | -- instance (Mutable s a, Mutable s b, Mutable s c) => Mutable s (a, b, c) where 32 | pure $ InstanceD 33 | Nothing 34 | (mutableS . VarT <$> tyVars) 35 | (mutableS instHead) 36 | [ refImpl 37 | , thawImpl valVars 38 | , freezeImpl refVars 39 | , copyImpl refVars valVars 40 | , moveImpl refVars valVars 41 | , cloneImpl refVars 42 | , unsafeThawImpl valVars 43 | , unsafeFreezeImpl refVars 44 | ] 45 | where 46 | tuplerT :: [Type] -> Type 47 | tuplerT = applyAllT (TupleT n) 48 | tupConE :: Exp 49 | tupConE = ConE (tupleDataName n) 50 | 51 | mutableS :: Type -> Type 52 | mutableS = ((ConT ''Mutable `AppT` VarT (mkName "s")) `AppT`) 53 | refS :: Type -> Type 54 | refS = ((ConT ''Ref `AppT` VarT (mkName "s")) `AppT`) 55 | tyVars :: [Name] 56 | tyVars = mkName <$> take n tyVarNames 57 | instHead :: Type 58 | instHead = tuplerT $ VarT <$> tyVars 59 | -- type Ref s (a, b, c) = (Ref s a, Ref s b, Ref s c) 60 | refImpl :: Dec 61 | #if MIN_VERSION_template_haskell(2,15,0) 62 | refImpl = TySynInstD 63 | . TySynEqn Nothing (refS instHead) 64 | #else 65 | refImpl = TySynInstD ''Ref 66 | . TySynEqn [VarT (mkName "s"), instHead] 67 | #endif 68 | $ tuplerT (refS . VarT <$> tyVars) 69 | thawImpl :: [Name] -> Dec 70 | thawImpl valVars = FunD 'thawRef [ 71 | Clause [TupP (BangP . VarP <$> valVars)] 72 | (NormalB . liftApplyAllE tupConE $ 73 | (VarE 'thawRef `AppE`) . VarE <$> valVars 74 | ) 75 | [] 76 | ] 77 | -- freezeRef (u , v , w ) = (,,) <$> freezeRef u <*> freezeRef v <*> freezeRef w 78 | freezeImpl :: [Name] -> Dec 79 | freezeImpl refVars = FunD 'freezeRef [ 80 | Clause [TupP (VarP <$> refVars)] 81 | (NormalB . liftApplyAllE tupConE $ 82 | (VarE 'freezeRef `AppE`) . VarE <$> refVars 83 | ) 84 | [] 85 | ] 86 | -- copyRef (u , v , w ) (!x, !y, !z) = copyRef u x *> copyRef v y *> copyRef w z 87 | copyImpl :: [Name] -> [Name] -> Dec 88 | copyImpl refVars valVars = FunD 'copyRef [ 89 | Clause [ TupP (BangP . VarP <$> refVars) 90 | , TupP (BangP . VarP <$> valVars) 91 | ] 92 | (NormalB . sequenceAllE $ 93 | zipWith (\r v -> (VarE 'copyRef `AppE` VarE r) `AppE` VarE v) refVars valVars 94 | ) 95 | [] 96 | ] 97 | -- moveRef (u , v , w ) ( x, y, z) = moveRef u x *> moveRef v y *> moveRef w z 98 | moveImpl :: [Name] -> [Name] -> Dec 99 | moveImpl refVars valVars = FunD 'moveRef [ 100 | Clause [ TupP (BangP . VarP <$> refVars) 101 | , TupP (BangP . VarP <$> valVars) 102 | ] 103 | (NormalB . sequenceAllE $ 104 | zipWith (\r v -> (VarE 'moveRef `AppE` VarE r) `AppE` VarE v) refVars valVars 105 | ) 106 | [] 107 | ] 108 | -- cloneRef (u , v , w ) = (,,) <$> cloneRef u <*> cloneRef v <*> cloneRef w 109 | cloneImpl :: [Name] -> Dec 110 | cloneImpl refVars = FunD 'cloneRef [ 111 | Clause [TupP (VarP <$> refVars)] 112 | (NormalB . liftApplyAllE tupConE $ 113 | (VarE 'cloneRef `AppE`) . VarE <$> refVars 114 | ) 115 | [] 116 | ] 117 | -- unsafeThawRef (!x, !y, !z) = (,,) <$> unsafeThawRef x <*> unsafeThawRef y <*> unsafeThawRef z 118 | unsafeThawImpl :: [Name] -> Dec 119 | unsafeThawImpl valVars = FunD 'unsafeThawRef [ 120 | Clause [TupP (BangP . VarP <$> valVars)] 121 | (NormalB . liftApplyAllE tupConE $ 122 | (VarE 'unsafeThawRef `AppE`) . VarE <$> valVars 123 | ) 124 | [] 125 | ] 126 | -- unsafeFreezeRef (u , v , w ) = (,,) <$> unsafeFreezeRef u <*> unsafeFreezeRef v <*> unsafeFreezeRef w 127 | unsafeFreezeImpl :: [Name] -> Dec 128 | unsafeFreezeImpl refVars = FunD 'unsafeFreezeRef [ 129 | Clause [TupP (VarP <$> refVars)] 130 | (NormalB . liftApplyAllE tupConE $ 131 | (VarE 'unsafeFreezeRef `AppE`) . VarE <$> refVars 132 | ) 133 | [] 134 | ] 135 | 136 | listRefTuple 137 | :: Int 138 | -> Q Dec 139 | listRefTuple n = do 140 | valVars <- replicateM n (newName "x") 141 | -- instance (Ref s a ~ ra, Ref s b ~ rb) => ListRefTuple s (ra, rb) '[a, b] where 142 | pure $ InstanceD 143 | Nothing 144 | (zipWith refConstr refVars tyVars) 145 | (listRefTupleS (tuplerT (VarT <$> refVars)) `AppT` 146 | (liftedList (VarT <$> tyVars)) 147 | ) 148 | [ tupToListImpl valVars 149 | , listToTupImpl valVars 150 | ] 151 | where 152 | tuplerT :: [Type] -> Type 153 | tuplerT = applyAllT (TupleT n) 154 | tupConE :: Exp 155 | tupConE = ConE (tupleDataName n) 156 | 157 | listRefTupleS :: Type -> Type 158 | listRefTupleS = ((ConT ''ListRefTuple `AppT` VarT (mkName "s")) `AppT`) 159 | refS :: Type -> Type 160 | refS = ((ConT ''Ref `AppT` VarT (mkName "s")) `AppT`) 161 | tyVarsStr :: [String] 162 | tyVarsStr = take n tyVarNames 163 | tyVars :: [Name] 164 | tyVars = mkName <$> tyVarsStr 165 | refVars :: [Name] 166 | refVars = mkName . ("r" ++) <$> tyVarsStr 167 | 168 | refConstr :: Name -> Name -> Pred 169 | refConstr r v = (EqualityT `AppT` refS (VarT v)) 170 | `AppT` VarT r 171 | 172 | -- tupleToListRef (x, y) = x :> y :> Nil 173 | tupToListImpl :: [Name] -> Dec 174 | tupToListImpl valVars = FunD 'tupleToListRef [ 175 | Clause [TupP (VarP <$> valVars)] 176 | ( NormalB 177 | . foldr (\x y -> (ConE '(:>) `AppE` VarE x) `AppE` y) (ConE 'Nil) 178 | $ valVars 179 | ) 180 | [] 181 | ] 182 | -- listRefToTuple (x :> y :> _) = (x, y) 183 | listToTupImpl :: [Name] -> Dec 184 | listToTupImpl valVars = FunD 'listRefToTuple [ 185 | Clause [ foldr (\x y -> ConP '(:>) [VarP x, y]) (ConP 'Nil []) valVars 186 | ] 187 | ( NormalB . applyAllE tupConE $ 188 | VarE <$> valVars 189 | ) 190 | [] 191 | ] 192 | 193 | 194 | applyAllT 195 | :: Type 196 | -> [Type] 197 | -> Type 198 | applyAllT = foldl' (\t m -> t `AppT` m) 199 | 200 | -- | liftApplyAllE f [x,y,z] = f <$> x <*> y <*> z 201 | liftApplyAllE 202 | :: Exp 203 | -> [Exp] 204 | -> Exp 205 | liftApplyAllE = foldl' (\t m -> (VarE '(<*>) `AppE` t) `AppE` m) 206 | . (VarE 'pure `AppE`) 207 | 208 | -- | applyAllE f [x,y,z] = f x y z 209 | applyAllE 210 | :: Exp 211 | -> [Exp] 212 | -> Exp 213 | applyAllE = foldl' (\t m -> t `AppE` m) 214 | 215 | -- | sequenceAllE [x,y,z] = x *> y *> z 216 | sequenceAllE 217 | :: [Exp] 218 | -> Exp 219 | sequenceAllE = foldr1 (\x y -> (VarE '(*>) `AppE` x) `AppE` y) 220 | 221 | liftedList 222 | :: [Type] 223 | -> Type 224 | liftedList = foldr (\x y -> (PromotedConsT `AppT` x) `AppT` y) PromotedNilT 225 | 226 | -------------------------------------------------------------------------------- /src/Data/Mutable/Parts.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE AllowAmbiguousTypes #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE FunctionalDependencies #-} 5 | {-# LANGUAGE GADTs #-} 6 | {-# LANGUAGE LambdaCase #-} 7 | {-# LANGUAGE RankNTypes #-} 8 | {-# LANGUAGE ScopedTypeVariables #-} 9 | {-# LANGUAGE TypeApplications #-} 10 | {-# LANGUAGE TypeFamilyDependencies #-} 11 | {-# LANGUAGE TypeInType #-} 12 | {-# LANGUAGE TypeOperators #-} 13 | {-# LANGUAGE UndecidableInstances #-} 14 | 15 | -- | 16 | -- Module : Data.Mutable.Parts 17 | -- Copyright : (c) Justin Le 2020 18 | -- License : BSD3 19 | -- 20 | -- Maintainer : justin@jle.im 21 | -- Stability : experimental 22 | -- Portability : non-portable 23 | -- 24 | -- Tools for working with individual components of piecewise-mutable 25 | -- values. 26 | -- 27 | -- If "Data.Mutable.Branches" is for sum types, then "Data.Mutable.Parts" 28 | -- is for sum types. 29 | -- 30 | -- See for an introduction 31 | -- to this module. 32 | -- 33 | module Data.Mutable.Parts ( 34 | MutPart(..) 35 | , withPart 36 | , freezePart, copyPart 37 | , movePartInto, movePartOver, movePartWithin 38 | , clonePart, unsafeFreezePart 39 | , modifyPart, modifyPart' 40 | , updatePart, updatePart' 41 | , modifyPartM, modifyPartM' 42 | , updatePartM, updatePartM' 43 | -- * Built-in 'MutPart' 44 | , compMP 45 | , idMP 46 | , mutFst, mutSnd 47 | -- ** Field 48 | , FieldMut(..), withField, mutField, Label(..) 49 | -- ** Position 50 | , PosMut(..), withPos, mutPos 51 | -- ** HList 52 | , TupleMut(..), withTuple 53 | -- ** Other 54 | , hkdMutParts, HKDMutParts 55 | , mutRec 56 | , coerceRef, withCoerceRef 57 | , MapRef 58 | ) where 59 | 60 | import Control.Monad.Primitive 61 | import Data.Coerce 62 | import Data.Generics.Product.Internal.HList 63 | import Data.Kind 64 | import Data.Mutable.Class 65 | import Data.Mutable.Instances 66 | import Data.Vinyl hiding (HList) 67 | import Data.Vinyl.Functor 68 | import GHC.Generics 69 | import GHC.TypeLits 70 | import qualified Control.Category as C 71 | import qualified Data.GenericLens.Internal as GL 72 | import qualified Data.Generics.Internal.Profunctor.Lens as GLP 73 | import qualified Data.Generics.Product.Fields as GL 74 | import qualified Data.Generics.Product.Internal.GLens as GL 75 | import qualified Data.Generics.Product.Internal.Positions as GL 76 | import qualified Data.Generics.Product.Positions as GL 77 | import qualified Data.Vinyl.TypeLevel as V 78 | import qualified Data.Vinyl.XRec as X 79 | 80 | 81 | -- | A @'MutPart' s b a@ is a way to "zoom into" an @a@, as a part of 82 | -- a mutable reference on @b@. This allows you to only modify a single 83 | -- @a@ part of the @b@, without touching the rest. It's spiritually 84 | -- similar to a @Lens' b a@. 85 | -- 86 | -- If 'Data.Mutable.Branches.MutBranch' is for sum types, then 'MutPart' is 87 | -- for product types. 88 | -- 89 | -- See for an introduction 90 | -- to this type. 91 | -- 92 | -- An example that is commonly found in the ecosystem is something like 93 | -- (flipped) @write :: Int -> 'Data.Vector.MVector' s a -> a -> m ()@ from 94 | -- "Data.Vector.Mutable" --- @write 3 :: 'Data.Vector.MVector' s a -> a -> 95 | -- m ()@, for instance, lets you modify a specific part of the vector 96 | -- without touching the rest. 97 | -- 98 | -- You would /use/ a 'MutPart' using 'freezePart', 'copyPart', 99 | -- 'modifyPart', etc. 100 | -- 101 | -- For non-composite types, there won't really be any meaningful values. 102 | -- However, we have them for many composite types. For example, for 103 | -- tuples: 104 | -- 105 | -- @ 106 | -- 'mutFst' :: 'MutPart' s (a, b) a 107 | -- 'mutSnd' :: MutPart s (a, b) b 108 | -- @ 109 | -- 110 | -- @ 111 | -- ghci> r <- 'thawRef' (2, 4) 112 | -- ghci> 'copyPart' mutFst r 100 113 | -- ghci> 'freezeRef' r 114 | -- (100, 4) 115 | -- @ 116 | -- 117 | -- If you are using 'GRef' as an automatically-defined mutable reference, 118 | -- then the easiest way to create these for your mutable types are with 119 | -- 'fieldMut' and 'posMut'. 120 | -- 121 | -- If you are using the "Higher-kinded data" pattern, then there's an easy 122 | -- way to generate a 'MutPart' for every single field, if you have 123 | -- a product type --- see 'hkdMutParts' for more information. 124 | newtype MutPart s b a = MutPart { getMutPart :: Ref s b -> Ref s a } 125 | 126 | -- | Compose two 'MutPart's one after the other. 127 | -- 128 | -- Note this is also available (albeit flipped in arguments) through the 129 | -- 'C.Category' instance. 130 | compMP :: MutPart s a b -> MutPart s b c -> MutPart s a c 131 | compMP (MutPart f) (MutPart g) = MutPart (g . f) 132 | infixr 9 `compMP` 133 | 134 | -- | The identity 'MutPart': simply focus into the same type itself. 135 | -- 136 | -- Note this is also available through the 'C.Category' instance. 137 | idMP :: MutPart s a a 138 | idMP = MutPart id 139 | 140 | instance C.Category (MutPart s) where 141 | id = idMP 142 | (.) = flip compMP 143 | 144 | instance X.IsoHKD (MutPart s b) a 145 | 146 | -- | 'MutPart' into the first field of a tuple reference. 147 | mutFst :: MutPart s (a, b) a 148 | mutFst = MutPart fst 149 | 150 | -- | 'MutPart' into the second field of a tuple reference. 151 | mutSnd :: MutPart s (a, b) b 152 | mutSnd = MutPart snd 153 | 154 | -- | Using a 'MutPart', perform a function on a @'Ref' s s@ as if you had 155 | -- a @'Ref' s a@. 156 | withPart 157 | :: MutPart s b a -- ^ How to zoom into an @a@ from an @s@ 158 | -> Ref s b -- ^ The larger reference of @s@ 159 | -> (Ref s a -> m r) -- ^ What do do with the smaller sub-reference of @a@ 160 | -> m r 161 | withPart mp x f = f (getMutPart mp x) 162 | 163 | -- | With a 'MutPart', read out a specific part of a 'Ref'. 164 | freezePart 165 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 166 | => MutPart s b a 167 | -> Ref s b 168 | -> m a 169 | freezePart mp = freezeRef . getMutPart mp 170 | 171 | -- | With a 'MutPart', overwrite into a specific part of a 'Ref'. 172 | copyPart 173 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 174 | => MutPart s b a 175 | -> Ref s b 176 | -> a 177 | -> m () 178 | copyPart mp = copyRef . getMutPart mp 179 | 180 | -- | With a 'MutPart', copy a 'Ref' containing a subvalue into a specific 181 | -- part of a larger 'Ref'. 182 | -- 183 | -- @ 184 | -- data MyType = MT { mtInt :: Int, mtDouble :: Double } 185 | -- deriving Generic 186 | -- 187 | -- instance Mutable s MyType where 188 | -- type Ref s MyType = GRef s MyType 189 | -- @ 190 | -- 191 | -- @ 192 | -- ghci> x <- thawRef $ MyType 3 4.5 193 | -- ghci> y <- thawRef $ 100 194 | -- ghci> movePartInto (fieldMut #mtInt) x y 195 | -- ghci> freezeRef x 196 | -- MyType 100 4.5 197 | -- @ 198 | movePartInto 199 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 200 | => MutPart s b a 201 | -> Ref s b -- ^ bigger type (destination) 202 | -> Ref s a -- ^ smaller type (source) 203 | -> m () 204 | movePartInto mp = moveRef . getMutPart mp 205 | 206 | -- | With a 'MutPart', copy a specific part of a larger 'Ref' into a 'Ref' 207 | -- of the smaller subvalue value. 208 | -- 209 | -- @ 210 | -- data MyType = MT { mtInt :: Int, mtDouble :: Double } 211 | -- deriving Generic 212 | -- 213 | -- instance Mutable s MyType where 214 | -- type Ref s MyType = GRef s MyType 215 | -- @ 216 | -- 217 | -- @ 218 | -- ghci> x <- thawRef $ MyType 3 4.5 219 | -- ghci> y <- thawRef $ 100 220 | -- ghci> movePartOver (fieldMut #mtInt) y x 221 | -- ghci> freezeRef y 222 | -- 3 223 | -- @ 224 | movePartOver 225 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 226 | => MutPart s b a 227 | -> Ref s a -- ^ smaller type (destination) 228 | -> Ref s b -- ^ bigger type (source) 229 | -> m () 230 | movePartOver mp r = moveRef r . getMutPart mp 231 | 232 | -- | With a 'MutPart', copy a specific part of a large 'Ref' into that 233 | -- same part in another large 'Ref'. 234 | -- 235 | -- @ 236 | -- data MyType = MT { mtInt :: Int, mtDouble :: Double } 237 | -- deriving Generic 238 | -- 239 | -- instance Mutable s MyType where 240 | -- type Ref s MyType = GRef s MyType 241 | -- @ 242 | -- 243 | -- @ 244 | -- ghci> x <- thawRef $ MyType 3 4.5 245 | -- ghci> y <- thawRef $ MyType 100 12.34 246 | -- ghci> movePartWithin (fieldMut #mtInt) x y 247 | -- ghci> freezeRef x 248 | -- MyType 100 4.5 249 | -- @ 250 | movePartWithin 251 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 252 | => MutPart s b a 253 | -> Ref s b -- ^ destination 254 | -> Ref s b -- ^ source 255 | -> m () 256 | movePartWithin mp r v = moveRef (getMutPart mp r) (getMutPart mp v) 257 | 258 | -- | Clone out a subvalue of a larger 'Ref'. 259 | clonePart 260 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 261 | => MutPart s b a 262 | -> Ref s b 263 | -> m (Ref s a) 264 | clonePart mp = cloneRef . getMutPart mp 265 | 266 | -- | A non-copying version of 'unsafeFreezeRef' that can be more efficient for 267 | -- types where the mutable representation is the same as the immutable 268 | -- one (like 'V.Vector'). 269 | -- 270 | -- This is safe as long as you never again modify the mutable 271 | -- reference, since it can potentially directly mutate the frozen value 272 | -- magically. 273 | unsafeFreezePart 274 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 275 | => MutPart s b a 276 | -> Ref s b 277 | -> m a 278 | unsafeFreezePart mp = unsafeFreezeRef . getMutPart mp 279 | 280 | 281 | 282 | -- | With a 'MutPart', modify a specific part of a 'Ref' with a pure 283 | -- function. 284 | modifyPart 285 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 286 | => MutPart s b a 287 | -> Ref s b 288 | -> (a -> a) 289 | -> m () 290 | modifyPart mp = modifyRef . getMutPart mp 291 | 292 | -- | 'modifyPart', but forces the result before storing it back in the 293 | -- reference. 294 | modifyPart' 295 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 296 | => MutPart s b a 297 | -> Ref s b 298 | -> (a -> a) 299 | -> m () 300 | modifyPart' mp = modifyRef' . getMutPart mp 301 | 302 | -- | 'updateRef', under a 'MutPart' to only modify a specific part of 303 | -- a 'Ref'. 304 | updatePart 305 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 306 | => MutPart s b a 307 | -> Ref s b 308 | -> (a -> (a, r)) 309 | -> m r 310 | updatePart mp = updateRef . getMutPart mp 311 | 312 | -- | 'updatePart', but forces the result before storing it back in the 313 | -- reference. 314 | updatePart' 315 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 316 | => MutPart s b a 317 | -> Ref s b 318 | -> (a -> (a, r)) 319 | -> m r 320 | updatePart' mp = updateRef' . getMutPart mp 321 | 322 | -- | With a 'MutPart', modify a specific part of a 'Ref' with a monadic 323 | -- function. Uses 'copyRef' into the reference after the action is 324 | -- completed. 325 | modifyPartM 326 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 327 | => MutPart s b a 328 | -> Ref s b 329 | -> (a -> m a) 330 | -> m () 331 | modifyPartM mp = modifyRefM . getMutPart mp 332 | 333 | -- | 'modifyPartM', but forces the result before storing it back in the 334 | -- reference. 335 | modifyPartM' 336 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 337 | => MutPart s b a 338 | -> Ref s b 339 | -> (a -> m a) 340 | -> m () 341 | modifyPartM' mp = modifyRefM' . getMutPart mp 342 | 343 | -- | 'updateRefM', under a 'MutPart' to only modify a specific part of 344 | -- a 'Ref'. 'copyRef' into the reference after the action is completed. 345 | updatePartM 346 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 347 | => MutPart s b a 348 | -> Ref s b 349 | -> (a -> m (a, r)) 350 | -> m r 351 | updatePartM mp = updateRefM . getMutPart mp 352 | 353 | -- | 'updatePartM', but forces the result before storing it back in the 354 | -- reference. 355 | updatePartM' 356 | :: (Mutable s a, PrimMonad m, PrimState m ~ s) 357 | => MutPart s b a 358 | -> Ref s b 359 | -> (a -> m (a, r)) 360 | -> m r 361 | updatePartM' mp = updateRefM' . getMutPart mp 362 | 363 | -- | A 'MutPart' for a field in a vinyl 'Data.Vinyl.Rec', automatically 364 | -- generated as the first field with a matching type. This is polymorphic 365 | -- to work over both 'Data.Vinyl.Rec' and 'Data.Vinyl.ARec'. 366 | -- 367 | -- @ 368 | -- ghci> r <- 'thawRef' $ [1,2,3] 'V.:&' [True, False] :& 'V.RNil' 369 | -- ghci> modifyPart (mutRec @Bool) r reverse 370 | -- ghci> freezeRef r 371 | -- [1,2,3] :& [False, True] :& RNil 372 | -- @ 373 | mutRec 374 | :: forall a as f rec s. 375 | ( Ref s (rec f as) ~ rec (RecRef s f) as 376 | , RecElem rec a a as as (V.RIndex a as) 377 | , RecElemFCtx rec (RecRef s f) 378 | ) 379 | => MutPart s (rec f as) (f a) 380 | mutRec = MutPart $ getRecRef . rget @a @as @(RecRef s f) @rec 381 | 382 | -- | A 'MutPart' to get into a 'CoerceRef'. 383 | coerceRef :: (Ref s b ~ CoerceRef s b a) => MutPart s b a 384 | coerceRef = MutPart coerce 385 | 386 | -- | Handy wrapper over @'getMutPart' 'coerceRef'@. 387 | withCoerceRef 388 | :: CoerceRef s b a 389 | -> (Ref s a -> m r) 390 | -> m r 391 | withCoerceRef x f = f (coerce x) 392 | 393 | -- | Typeclass used to implement 'hkdMutParts'. See documentation of 394 | -- 'hkdMutParts' for more information. 395 | class (Mutable s (z Identity), Ref s (z Identity) ~ z (RefFor s)) => HKDMutParts s z i o where 396 | hkdMutParts_ :: (z (RefFor s) -> i a) -> o a 397 | 398 | instance (Mutable s (z Identity), Ref s (z Identity) ~ z (RefFor s)) => HKDMutParts s z (K1 i (RefFor s c)) (K1 i (MutPart s (z Identity) c)) where 399 | hkdMutParts_ f = K1 $ MutPart $ getRefFor . unK1 . f 400 | 401 | instance (Mutable s (z Identity), Ref s (z Identity) ~ z (RefFor s)) => HKDMutParts s z U1 U1 where 402 | hkdMutParts_ _ = U1 403 | 404 | instance (Mutable s (z Identity), Ref s (z Identity) ~ z (RefFor s), TypeError ('Text "Cannot use hkdMutParts for uninhabited types: " ':<>: 'ShowType z)) => HKDMutParts s z V1 V1 where 405 | hkdMutParts_ _ = undefined 406 | 407 | instance HKDMutParts s z i o => HKDMutParts s z (M1 a b i) (M1 a b o) where 408 | hkdMutParts_ f = M1 $ hkdMutParts_ @s (unM1 . f) 409 | 410 | instance (HKDMutParts s z i o, HKDMutParts s z i' o') => HKDMutParts s z (i :*: i') (o :*: o') where 411 | hkdMutParts_ f = hkdMutParts_ @s ((\(x:*:_)->x) . f) :*: hkdMutParts_ @s ((\(_:*:y)->y) . f) 412 | 413 | instance (Mutable s (z Identity), Ref s (z Identity) ~ z (RefFor s), TypeError ('Text "Cannot use hkdMutParts for sum types: " ':<>: 'ShowType z)) => HKDMutParts s z (i :+: i') o where 414 | hkdMutParts_ _ = undefined 415 | 416 | -- | If you are using the "higher-kinded data" pattern, a la 417 | -- , and you 418 | -- have the appropriate instance for 'Ref', then you can use this to 419 | -- generate a 'MutPart' for every field, if you have a type with only one 420 | -- constructor. 421 | -- 422 | -- @ 423 | -- data MyTypeF f = MT 424 | -- { mtInt :: f Int 425 | -- , mtDouble :: f Double 426 | -- } 427 | -- deriving Generic 428 | -- 429 | -- instance Mutable (MyTypeF 'Identity') where 430 | -- type Ref (MyTypeF 'Identity') = MyTypeF ('RefFor' m) 431 | -- 432 | -- mx :: MutPart s (MyTypeF Identity) ('V.Vector' Int) 433 | -- my :: MutPart s (MyTypeF Identity) (Vector Double) 434 | -- MT mx my = hkdMutParts @MyTypeF 435 | -- @ 436 | -- 437 | -- @ 438 | -- ghci> r <- thawRef (MT 3 4.5) 439 | -- ghci> 'freezePart' mx r 440 | -- 3 441 | -- ghci> 'copyPart' (mtDouble (hkdMutParts @MyTypeF)) r 12.3 442 | -- ghci> 'freezeRef' r 443 | -- MT 3 12.3 444 | -- @ 445 | -- 446 | -- Performance-wise, this is about equivalent to 'fieldMut' and 'posMut' 447 | -- for the most part, so the main advantage would be purely syntactical. If 448 | -- performance is an issue, you should benchmark all the different ways 449 | -- just to be sure. As a general rule, it seems like deep nested accesses 450 | -- are faster with composition of 'fieldMut' and 'posMut', but immediate 451 | -- shallow access is often faster with 'hkdMutParts'...but this probably 452 | -- does vary on a case-by-case basis. 453 | hkdMutParts 454 | :: forall z s. 455 | ( Generic (z (RefFor s)) 456 | , Generic (z (MutPart s (z Identity))) 457 | , HKDMutParts s z (Rep (z (RefFor s))) (Rep (z (MutPart s (z Identity)))) 458 | ) 459 | => z (MutPart s (z Identity)) 460 | hkdMutParts = to $ hkdMutParts_ @s @z from 461 | 462 | -- | Create a 'MutPart' for a field name. Should work for any type with 463 | -- one constructor whose mutable reference is 'GRef'. See 'fieldMut' for 464 | -- usage directions. 465 | -- 466 | -- Mostly leverages the power of "Data.Generics.Product.Fields". 467 | class (Mutable s b, Mutable s a) => FieldMut (fld :: Symbol) s b a | fld b -> a where 468 | -- | Create a 'MutPart' for a field name. Should work for any type with 469 | -- one constructor whose mutable reference is 'GRef'. 470 | -- 471 | -- Is meant to be used with OverloadedLabels: 472 | -- 473 | -- @ 474 | -- data MyType = MyType { mtInt :: Int, mtDouble :: Double } 475 | -- deriving (Generic, Show) 476 | -- 477 | -- instance Mutable s MyType where 478 | -- type Ref s MyType = 'GRef' s MyType 479 | -- @ 480 | -- 481 | -- @ 482 | -- ghci> r <- 'thawRef' (MyType 3 4.5) 483 | -- ghci> 'freezePart' ('fieldMut' #mtInt) r 484 | -- 3 485 | -- ghci> 'copyPart' (fieldMut #mtDouble) 1.23 486 | -- ghci> 'freezeRef' r 487 | -- MyType 3 1.23 488 | -- @ 489 | -- 490 | -- However, you can use it without OverloadedLabels by using 'Label' with 491 | -- TypeApplications: 492 | -- 493 | -- @ 494 | -- ghci> 'freezePart' ('fieldMut' ('Label' @"mtInt")) r 495 | -- 3 496 | -- @ 497 | -- 498 | -- This and 'posMut' are the main ways to generate a 'MutPart' for 499 | -- a type whose mutable reference is 'GRef'. Note that because all of 500 | -- the lookups are done at compile-time, 'fieldMut' and 'posMut' have 501 | -- more or less identical performance characteristics. 502 | fieldMut 503 | :: Label fld -- ^ field label (usually given using OverloadedLabels, @#blah) 504 | -> MutPart s b a 505 | 506 | instance 507 | ( Mutable s b 508 | , Mutable s a 509 | , Ref s b ~ GRef s b 510 | , GL.GLens' (HasTotalFieldPSym fld) (GRef_ s (Rep b)) (Ref s a) 511 | , GL.HasField' fld b a 512 | ) 513 | => FieldMut fld s b a where 514 | fieldMut _ = MutPart $ GLP.view (GL.glens @(HasTotalFieldPSym fld)) . unGRef 515 | 516 | data HasTotalFieldPSym :: Symbol -> GL.TyFun (Type -> Type) (Maybe Type) 517 | type instance GL.Eval (HasTotalFieldPSym sym) tt = GL.HasTotalFieldP sym tt 518 | 519 | -- | A helpful wrapper over @'withPart' ('fieldMut' #blah)@. Create 520 | -- a 'fieldMut' and directly use it. 521 | withField 522 | :: FieldMut fld s b a 523 | => Label fld -- ^ field label (usually given using OverloadedLabels, @#blah) 524 | -> Ref s b -- ^ Larger record reference 525 | -> (Ref s a -> m r) -- ^ What to do with the mutable field 526 | -> m r 527 | withField l = withPart (fieldMut l) 528 | 529 | -- | A helpful wrapper around @'getMutPart' ('fieldMut' #blah)@. Directly 530 | -- use a 'fieldMut' to access a mutable field. 531 | mutField 532 | :: forall fld s b a. FieldMut fld s b a 533 | => Label fld -- ^ field label (usually given using OverloadedLabels, @#blah) 534 | -> Ref s b -- ^ Larger record reference 535 | -> Ref s a -- ^ Internal mutable field 536 | mutField = getMutPart . fieldMut @_ @s 537 | 538 | -- | Create a 'MutPart' for a position in a product type. Should work for any 539 | -- type with one constructor whose mutable reference is 'GRef'. See 540 | -- 'posMut' for usage directions. 541 | -- 542 | -- Mostly leverages the power of "Data.Generics.Product.Positions". 543 | class (Mutable s b, Mutable s a) => PosMut (i :: Nat) s b a | i b -> a where 544 | -- | Create a 'MutPart' for a position in a product type. Should work for any 545 | -- type with one constructor whose mutable reference is 'GRef'. 546 | -- 547 | -- Meant to be used with TypeApplications: 548 | -- 549 | -- @ 550 | -- data MyType = MyType Int Double 551 | -- deriving (Generic, Show) 552 | -- 553 | -- instance Mutable s MyType where 554 | -- type Ref s MyType = 'GRef' s MyType 555 | -- @ 556 | -- 557 | -- @ 558 | -- ghci> r <- 'thawRef' (MyType 3 4.5) 559 | -- ghci> 'freezePart' ('posMut' \@1) r 560 | -- 3 561 | -- ghci> 'copyPart' (posMut \@2) 1.23 562 | -- ghci> 'freezeRef' r 563 | -- MyType 3 1.23 564 | -- @ 565 | -- 566 | -- This and 'fieldMut' are the main ways to generate a 'MutPart' for 567 | -- a type whose mutable reference is 'GRef'. Note that because all of 568 | -- the lookups are done at compile-time, 'posMut' and 'fieldMut' have 569 | -- more or less identical performance characteristics. 570 | posMut :: MutPart s b a 571 | 572 | instance 573 | ( Mutable s b 574 | , Mutable s a 575 | , Ref s b ~ GRef s b 576 | , gref ~ Fst (Traverse (GRef_ s (GL.CRep b)) 1) 577 | , Coercible (GRef_ s (Rep b) ()) (gref ()) 578 | , GL.GLens' (HasTotalPositionPSym i) gref (Ref s a) 579 | , GL.HasPosition' i b a 580 | ) 581 | => PosMut i s b a where 582 | posMut = MutPart $ GLP.view (GL.glens @(HasTotalPositionPSym i) @gref) . coerce @_ @(gref ()) . unGRef 583 | 584 | data HasTotalPositionPSym :: Nat -> GL.TyFun (Type -> Type) (Maybe Type) 585 | type instance GL.Eval (HasTotalPositionPSym t) tt = GL.HasTotalPositionP t tt 586 | 587 | -- | A helpful wrapper over @'withPart' ('posMut' \@n)@. Create 588 | -- a 'posMut' and directly use it. 589 | withPos 590 | :: forall i s m b a r. PosMut i s b a 591 | => Ref s b -- ^ Larger record reference 592 | -> (Ref s a -> m r) -- ^ What to do with the mutable field 593 | -> m r 594 | withPos = withPart (posMut @i) 595 | 596 | -- | A helpful wrapper around @'getMutPart' ('posMut' \@n)@. Directly 597 | -- use a 'posMut' to access a mutable field. 598 | mutPos 599 | :: forall i s b a. PosMut i s b a 600 | => Ref s b -- ^ Larger record reference 601 | -> Ref s a -- ^ Internal mutable field 602 | mutPos = getMutPart (posMut @i @s) 603 | 604 | -- | Create a 'MutPart' splitting out a product type into a tuple of refs 605 | -- for every field in that product type. Should work for any type with one 606 | -- constructor whose mutable reference is 'GRef'. See 'tupleMut' for usage 607 | -- directions. 608 | -- 609 | -- Mostly leverages the power of "Data.Generics.Product.HList". 610 | class (Mutable s b, Mutable s a) => TupleMut s b a | b -> a where 611 | -- | Create a 'MutPart' splitting out a product type into a tuple of refs 612 | -- for every field in that product type. Should work for any type with one 613 | -- constructor whose mutable reference is 'GRef'. 614 | -- 615 | -- Probably most easily used using 'withTuple': 616 | -- 617 | -- @ 618 | -- data MyType = MyType Int Double 619 | -- deriving (Generic, Show) 620 | -- 621 | -- instance Mutable s MyType where 622 | -- type Ref s MyType = 'GRef' s MyType 623 | -- @ 624 | -- 625 | -- Now there is an instance of @'TupleMut' m MyType (Int, Double)@. 626 | -- 627 | -- @ 628 | -- ghci> r <- 'thawRef' (MyType 3 4.5) 629 | -- ghci> 'withTuple' r $ \(rI, rD) -> do 630 | -- .. 'modifyRef' rI negate 631 | -- .. modifyRef rD (* 2) 632 | -- ghci> 'freezeRef' r 633 | -- MyType (-3) 9 634 | -- @ 635 | -- 636 | -- As can be seen, within the lambda, we can get access to every 637 | -- mutable reference inside a @MyType@ reference. 638 | -- 639 | -- Performance-wise, this appears to be faster than 'fieldMut' and 640 | -- 'posMut' when using a single reference, but slower if using all 641 | -- references. 642 | tupleMut :: MutPart s b a 643 | 644 | instance 645 | ( Mutable s b 646 | , Mutable s a 647 | , Ref s b ~ GRef s b 648 | , GIsList (GRef_ s (Rep b)) (GRef_ s (Rep b)) (MapRef s as) (MapRef s as) 649 | , GIsList (Rep b) (Rep b) as as 650 | , ListTuple a a as as 651 | , ListTuple c c (MapRef s as) (MapRef s as) 652 | , Ref s a ~ c 653 | ) 654 | => TupleMut s b a where 655 | tupleMut = MutPart $ listToTuple @c @c @(MapRef s as) @(MapRef s as) 656 | . GLP.view glist 657 | . unGRef 658 | 659 | -- | A helpful wrapper over @'withPart' 'tupleMut'@. Directly operate on 660 | -- the items in the data type, getting the references as a tuple. See 661 | -- 'tupleMut' for more details on when this should work. 662 | -- 663 | -- @ 664 | -- data MyType = MyType Int Double 665 | -- deriving (Generic, Show) 666 | -- 667 | -- instance Mutable s MyType where 668 | -- type Ref s MyType = 'GRef' s MyType 669 | -- @ 670 | -- 671 | -- @ 672 | -- ghci> r <- 'thawRef' (MyType 3 4.5) 673 | -- ghci> 'withTuple' r $ \(rI, rD) -> do 674 | -- .. 'modifyRef' rI negate 675 | -- .. modifyRef rD (* 2) 676 | -- ghci> 'freezeRef' r 677 | -- MyType (-3) 9 678 | -- @ 679 | withTuple 680 | :: TupleMut s b a 681 | => Ref s b -- ^ Larger record reference 682 | -> (Ref s a -> m r) -- ^ What to do with each mutable field. The 683 | -- @'Ref' s a@ will be a tuple of every field's ref. 684 | -> m r 685 | withTuple = withPart tupleMut 686 | 687 | 688 | -- stuff from generic-lens that wasn't exported 689 | 690 | type G = Type -> Type 691 | 692 | type family Traverse (a :: G) (n :: Nat) :: (G, Nat) where 693 | Traverse (M1 mt m s) n 694 | = Traverse1 (M1 mt m) (Traverse s n) 695 | Traverse (l :+: r) n 696 | = '(Fst (Traverse l n) :+: Fst (Traverse r n), n) 697 | Traverse (l :*: r) n 698 | = TraverseProd (:*:) (Traverse l n) r 699 | Traverse (K1 _ p) n 700 | = '(K1 (GL.Pos n) p, n + 1) 701 | Traverse U1 n 702 | = '(U1, n) 703 | 704 | type family Traverse1 (w :: G -> G) (z :: (G, Nat)) :: (G, Nat) where 705 | Traverse1 w '(i, n) = '(w i, n) 706 | 707 | -- | For products, we first traverse the left-hand side, followed by the second 708 | -- using the counter returned by the left traversal. 709 | type family TraverseProd (c :: G -> G -> G) (a :: (G, Nat)) (r :: G) :: (G, Nat) where 710 | TraverseProd w '(i, n) r = Traverse1 (w i) (Traverse r n) 711 | 712 | type family Fst (p :: (a, b)) :: a where 713 | Fst '(a, b) = a 714 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: nightly-2020-01-17 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # subdirs: 29 | # - auto-update 30 | # - wai 31 | packages: 32 | - . 33 | # Dependency packages to be pulled from upstream that are not in the resolver. 34 | # These entries can reference officially published versions as well as 35 | # forks / in-progress versions pinned to a git hash. For example: 36 | # 37 | # extra-deps: 38 | # - acme-missiles-0.3 39 | # - git: https://github.com/commercialhaskell/stack.git 40 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 41 | # 42 | extra-deps: 43 | - vinyl-0.12.0 44 | - primitive-0.7.0.0 45 | - generic-lens-2.0.0.0 46 | - generic-lens-core-2.0.0.0 47 | - indexed-profunctors-0.1 48 | - inliterate-0.1.0 49 | - tintin-1.10.0 50 | - require-0.4.3 51 | - github: jgm/cheapskate 52 | commit: 74c308a9f145c00c7d0f41dcf90aac56d8614c65 53 | 54 | ghc-options: 55 | "$locals": -ddump-to-file -ddump-hi 56 | 57 | # Override default flag values for local packages and extra-deps 58 | # flags: {} 59 | 60 | # Extra package databases containing global packages 61 | # extra-package-dbs: [] 62 | 63 | # Control whether we use the GHC we find on the path 64 | # system-ghc: true 65 | # 66 | # Require a specific version of stack, using version ranges 67 | # require-stack-version: -any # Default 68 | # require-stack-version: ">=2.2" 69 | # 70 | # Override the architecture used by stack, especially useful on Windows 71 | # arch: i386 72 | # arch: x86_64 73 | # 74 | # Extra directories used by stack for building 75 | # extra-include-dirs: [/path/to/dir] 76 | # extra-lib-dirs: [/path/to/dir] 77 | # 78 | # Allow a newer minor version of GHC than the snapshot specifies 79 | # compiler-check: newer-minor 80 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: vinyl-0.12.0@sha256:6136e2608c2c4be0c112944fb0f5a6a0df56b50adec12eb1b7240258abfcf9b1,3790 9 | pantry-tree: 10 | size: 1857 11 | sha256: aeb9e0e1a3bbe2b1f048a096430d240964a31c6936a1da89f4b32e931eba9d69 12 | original: 13 | hackage: vinyl-0.12.0 14 | - completed: 15 | hackage: primitive-0.7.0.0@sha256:c45abc68bec080e3f1ab347dd331617d43fded94a473086bf21aeda69a6e20bc,3552 16 | pantry-tree: 17 | size: 3221 18 | sha256: 2d85b8e01790534e666f519787454bab613c21d609f6707cb56c3301fafcc8cb 19 | original: 20 | hackage: primitive-0.7.0.0 21 | - completed: 22 | hackage: generic-lens-2.0.0.0@sha256:7409fa0ce540d0bd41acf596edd1c5d0c0ab1cd1294d514cf19c5c24e8ef2550,3866 23 | pantry-tree: 24 | size: 2470 25 | sha256: 46ba160f0efc9c805eac6666f298f48dda899834b68c860f63641ce1f82db737 26 | original: 27 | hackage: generic-lens-2.0.0.0 28 | - completed: 29 | hackage: generic-lens-core-2.0.0.0@sha256:40b063c4a1399b3cdb19f2df1fae5a1a82f3313015c7c3e47fc23b8ef1b3e443,2913 30 | pantry-tree: 31 | size: 2201 32 | sha256: 73f91636570c0e96044f655402ccbf6adba78d3a93f8d9ee97f3115bae096536 33 | original: 34 | hackage: generic-lens-core-2.0.0.0 35 | - completed: 36 | hackage: indexed-profunctors-0.1@sha256:ddf618d0d4c58319c1e735e746bc69a1021f13b6f475dc9614b80af03432e6d4,1016 37 | pantry-tree: 38 | size: 235 39 | sha256: cfd66c0a53be1b45eae72df112ea1158614458bb7b1c9cbbe3410b04ab011ec6 40 | original: 41 | hackage: indexed-profunctors-0.1 42 | - completed: 43 | hackage: inliterate-0.1.0@sha256:61b17ab3cef803512c264e27e463390b47af59d7d2b3a2a89bea2eac0cf84266,1853 44 | pantry-tree: 45 | size: 618 46 | sha256: 2cea999a63449b913f6186c3b8b276050e7a1a7195f5e94ac94fa4007da36558 47 | original: 48 | hackage: inliterate-0.1.0 49 | - completed: 50 | hackage: tintin-1.10.0@sha256:4ed09092d0218825c064384f992d8b83b59ebd26fea42aecbcc369b5b6ed38c5,3087 51 | pantry-tree: 52 | size: 1552 53 | sha256: b3810078d22856eb1764f37ffe42cef4a76e648b9a26c04a337173d40a0cce37 54 | original: 55 | hackage: tintin-1.10.0 56 | - completed: 57 | hackage: require-0.4.3@sha256:73d04a6b9c01fac37b1e26b4eb22900e0a0e2f5181ea62ba7b63e7e3d0a2f1ed,3624 58 | pantry-tree: 59 | size: 718 60 | sha256: 7ad8126f0e3189490a46f7a713f51d0fa46c4aabc03cc584b139749ac7e8f185 61 | original: 62 | hackage: require-0.4.3 63 | - completed: 64 | size: 60639 65 | url: https://github.com/jgm/cheapskate/archive/74c308a9f145c00c7d0f41dcf90aac56d8614c65.tar.gz 66 | cabal-file: 67 | size: 3020 68 | sha256: 9ce4daf47a3f9083c02d4b5bb7182511c1389d767804437f79a44266ef60e255 69 | name: cheapskate 70 | version: 0.1.1.1 71 | sha256: 14e53fed14ec842727781ab3fad0716146901789639826f8de14ac1a1e64b241 72 | pantry-tree: 73 | size: 12002 74 | sha256: cd3ccdd0d2eb914ed32b7fbf15c6b4b7c19382452dd3a2367e4a0bcac5d98341 75 | original: 76 | url: https://github.com/jgm/cheapskate/archive/74c308a9f145c00c7d0f41dcf90aac56d8614c65.tar.gz 77 | snapshots: 78 | - completed: 79 | size: 457392 80 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/1/17.yaml 81 | sha256: 8c2a25a0da9445dee2c63c5db2e079e44f16ff870bd9f56c554ac5ec60a0fd96 82 | original: nightly-2020-01-17 83 | --------------------------------------------------------------------------------