ST.modify

src/Record/ST.js

@@ -39,3 +39,13 @@ exports.unsafePoke = function(l) {
     };
   };
 };
+
+exports.unsafeModify = function(l) {
+  return function(f) {
+    return function(rec) {
+      return function() {
+        rec[l] = f(rec[l]);
+      };
+    };
+  };
+};

src/Record/ST.purs

@@ -4,6 +4,7 @@ module Record.ST
   , thaw
   , peek
   , poke
+  , modify
   ) where
 
 import Prelude
@@ -59,3 +60,23 @@ poke
   -> STRecord h r
   -> ST h Unit
 poke l = unsafePoke (reflectSymbol l)
+
+foreign import unsafeModify
+  :: forall a r h
+   . String
+  -> (a -> a)
+  -> STRecord h r
+  -> ST h Unit
+
+-- | Modify a record in place,
+-- | by providing a type-level representative for the label to update
+-- | and a function to update it.
+modify
+  :: forall l h a r r1
+   . Row.Cons l a r1 r
+  => IsSymbol l
+  => SProxy l
+  -> (a -> a)
+  -> STRecord h r
+  -> ST h Unit
+modify l = unsafeModify (reflectSymbol l)

test/Main.purs

@@ -6,7 +6,7 @@ import Effect (Effect)
 import Record (delete, equal, get, insert, modify, rename, set)
 import Record.Builder as Builder
 import Control.Monad.ST (run) as ST
-import Record.ST (poke, thaw, freeze) as ST
+import Record.ST (poke, thaw, freeze, modify) as ST
 import Record.Unsafe (unsafeHas)
 import Data.Symbol (SProxy(..))
 import Test.Assert (assert')
@@ -38,14 +38,20 @@ main = do
   assert' "unsafeHas2" $
     not $ unsafeHas "b" { a: 42 }
 
-  let stTest1 = ST.run do
-        rec <- ST.thaw { x: 41, y: "" }
-        ST.poke x 42 rec
-        ST.poke y "testing" rec
-        ST.freeze rec
+  let
+    stTest1 = ST.run do
+      rec <- ST.thaw { x: 41, y: "" }
+      ST.poke x 42 rec
+      ST.poke y "testing" rec
+      ST.freeze rec
+    stTest2 = ST.run do
+      rec <- ST.thaw { x: 41 }
+      ST.modify x (_ + 1) rec
+      ST.freeze rec
 
   assert' "pokeSTRecord" $
     stTest1.x == 42 && stTest1.y == "testing"
+  assert' "ST.modify" $ stTest2.x == 42
 
   let testBuilder = Builder.build (Builder.insert x 42
                                   >>> Builder.merge { y: true, z: "testing" }