STRecord (#9)

Author: paf31

bower.json

@@ -19,7 +19,8 @@
   "dependencies": {
     "purescript-symbols": "^3.0.0",
     "purescript-functions": "^3.0.0",
-    "purescript-typelevel-prelude": "^2.3.1"
+    "purescript-typelevel-prelude": "^2.3.1",
+    "purescript-st": "^3.0.0"
   },
   "devDependencies": {
     "purescript-assert": "^3.0.0"

src/Data/Record/ST.js

@@ -0,0 +1,47 @@
+"use strict";
+
+function copyRecord(rec) {
+  var copy = {};
+  for (var key in rec) {
+    if ({}.hasOwnProperty.call(rec, key)) {
+      copy[key] = rec[key];
+    }
+  }
+  return copy;
+}
+
+exports.runSTRecord = function(rec) {
+  return function() {
+    return copyRecord(rec());
+  };
+};
+
+exports.freezeSTRecord = function(rec) {
+  return function() {
+    return copyRecord(rec);
+  };
+};
+
+exports.thawSTRecord = function(rec) {
+  return function() {
+    return copyRecord(rec);
+  };
+};
+
+exports.unsafePeekSTRecord = function(l) {
+  return function(rec) {
+    return function() {
+      return rec[l];
+    };
+  };
+};
+
+exports.unsafePokeSTRecord = function(l) {
+  return function(a) {
+    return function(rec) {
+      return function() {
+        rec[l] = a;
+      };
+    };
+  };
+};

src/Data/Record/ST.purs

@@ -0,0 +1,71 @@
+module Data.Record.ST
+  ( STRecord
+  , freezeSTRecord
+  , thawSTRecord
+  , peekSTRecord
+  , pokeSTRecord
+  , runSTRecord
+  , pureSTRecord
+  ) where
+
+import Prelude
+
+import Control.Monad.Eff (Eff, runPure)
+import Control.Monad.ST (ST)
+import Data.Symbol (class IsSymbol, SProxy, reflectSymbol)
+
+-- | A value of type `STRecord h r` represents a mutable record with fields `r`,
+-- | belonging to the state thread `h`.
+-- |
+-- | Create values of type `STRecord` using `thawSTRecord`.
+foreign import data STRecord :: Type -> # Type -> Type
+
+-- | Freeze a mutable record, creating a copy.
+foreign import freezeSTRecord :: forall h r eff. STRecord h r -> Eff (st :: ST h | eff) (Record r)
+
+-- | Thaw an immutable record, creating a copy.
+foreign import thawSTRecord :: forall h r eff. Record r -> Eff (st :: ST h | eff) (STRecord h r)
+
+-- | Run an ST computation safely, constructing a record.
+foreign import runSTRecord :: forall r eff. (forall h. Eff (st :: ST h | eff) (STRecord h r)) -> Eff eff (Record r)
+
+-- | Run an ST computation safely, constructing a record, assuming no other
+-- | types of effects.
+pureSTRecord :: forall r. (forall h eff. Eff (st :: ST h | eff) (STRecord h r)) -> Record r
+pureSTRecord st = runPure (runSTRecord st)
+
+foreign import unsafePeekSTRecord
+  :: forall a r h eff
+   . String
+  -> STRecord h r
+  -> Eff (st :: ST h | eff) a
+
+-- | Read the current value of a field in a mutable record, by providing a
+-- | type-level representative for the label which should be read.
+peekSTRecord
+  :: forall l h a r r1 eff
+   . RowCons l a r1 r
+  => IsSymbol l
+  => SProxy l
+  -> STRecord h r
+  -> Eff (st :: ST h | eff) a
+peekSTRecord l = unsafePeekSTRecord (reflectSymbol l)
+
+foreign import unsafePokeSTRecord
+  :: forall a r h eff
+   . String
+  -> a
+  -> STRecord h r
+  -> Eff (st :: ST h | eff) Unit
+
+-- | Modify a record in place, by providing a type-level representative for the label
+-- | which should be updated.
+pokeSTRecord
+  :: forall l h a r r1 eff
+   . RowCons l a r1 r
+  => IsSymbol l
+  => SProxy l
+  -> a
+  -> STRecord h r
+  -> Eff (st :: ST h | eff) Unit
+pokeSTRecord l = unsafePokeSTRecord (reflectSymbol l)

test/Main.purs

@@ -3,8 +3,9 @@ module Test.Main where
 import Prelude
 
 import Control.Monad.Eff (Eff)
-import Data.Record.Builder as Builder
 import Data.Record (delete, get, insert, modify, set, equal)
+import Data.Record.Builder as Builder
+import Data.Record.ST (pokeSTRecord, pureSTRecord, thawSTRecord)
 import Data.Record.Unsafe (unsafeHas)
 import Data.Symbol (SProxy(..))
 import Test.Assert (ASSERT, assert')
@@ -33,6 +34,15 @@ main = do
   assert' "unsafeHas2" $
     not $ unsafeHas "b" { a: 42 }
 
+  let stTest1 = pureSTRecord do
+        rec <- thawSTRecord { x: 41, y: "" }
+        pokeSTRecord x 42 rec
+        pokeSTRecord y "testing" rec
+        pure rec
+
+  assert' "pokeSTRecord" $
+    stTest1.x == 42 && stTest1.y == "testing"
+    
   let testBuilder = Builder.build (Builder.insert x 42
                                   >>> Builder.merge { y: true, z: "testing" }
                                   >>> Builder.delete y) {}