Fix

bin/genrecord

@@ -0,0 +1,73 @@
+#!/usr/bin/env cabal
+
+{-# LANGUAGE OverloadedStrings #-}
+
+{- cabal:
+build-depends: base, fmt
+-}
+
+import Data.List
+import Fmt
+
+main = do
+  let n = 62 -- max tuple size
+  putStrLn
+    "-- Generated with cabal run -v0 bin/genrecord > src/JRec/Tuple.hs\n\
+    \\n\
+    \module JRec.Tuple where\n\
+    \\n\
+    \import qualified JRec.Internal as R\n\
+    \import Unsafe.Coerce\n\
+    \\n\
+    \class RecTuple tuple fields | tuple -> fields, fields -> tuple where\n\
+    \  fromTuple :: tuple -> R.Rec fields\n\
+    \  toTuple :: R.Rec fields -> tuple\n\
+    \\n\
+    \"
+  mapM_ (putStrLn . genInstance) [0 .. n]
+
+genInstance :: Int -> String
+genInstance 0 =
+  "instance RecTuple () '[] where\n\
+  \  fromTuple _ = R.rnil\n\
+  \  toTuple _ = ()\n\
+  \"
+genInstance i =
+  let fromTuple, toTuple, constraints :: Builder
+      fromTuple =
+        format
+          "fromTuple {} = R.create $ {} R.unsafeRNil {}"
+          exprTuple
+          consApps
+          i
+      toTuple =
+        format
+          "toTuple r = let {} = R.getFields r in unsafeCoerce {}"
+          exprList
+          exprTuple
+      constraints =
+        tupleF $
+          format "R.RecApply {} {} R.NoConstraint" typeList typeList :
+          [format "n{} ~ n{}'" j j :: Builder | j <- [1 .. i]]
+            ++ [format "v{} ~ v{}'" j j :: Builder | j <- [1 .. i]]
+   in format
+        "instance {} => RecTuple {} {} where\n\
+        \  {}\n\
+        \  {}\n\
+        \"
+        constraints
+        typeTuple
+        typeList
+        fromTuple
+        toTuple
+  where
+    -- '[n1' R.:= v1', n2' R.:= v2']
+    typeList = "'" <> listF [format "n{}' R.:= v{}'" j j :: Builder | j <- [1 .. i]]
+    -- (n1 R.:= v1, n2 R.:= v2)
+    typeTuple = tupleF [format "n{} R.:= v{}" j j :: Builder | j <- [1 .. i]]
+    -- (f1, f2)
+    exprTuple = tupleF ["f" <> show j | j <- [1 .. i]]
+    -- [f1, f2]
+    exprList = listF ["f" <> show j | j <- [1 .. i]]
+    -- R.unsafeRCons f1 $ R.unsafeRCons f2 $
+    consApps = mconcat [format "R.unsafeRCons f{} =<< " j :: Builder | j <- [1 .. i]]

default.nix

@@ -30,9 +30,6 @@ in {
         packages = p: [ p.jrec ];
         buildInputs = with projectDrv; [
           cabal-install
-          ormolu
-          haskell-language-server
-          ghcid
         ];
       };
   in 

src/JRec/Internal.hs

@@ -72,6 +72,10 @@ instance
   showsPrec p (l := t) =
     showParen (p > 10) (showString ("#" ++ symbolVal l ++ " := " ++ show t))
 
+unpackAssign :: (label := value) -> value
+unpackAssign (_ := value) = value
+{-# INLINE unpackAssign #-}
+
 -- | A proxy witness for a label. Very similar to 'Proxy', but needed to implement
 -- a non-orphan 'IsLabel' instance
 data FldProxy (t :: Symbol)
@@ -125,26 +129,58 @@ instance (RecSize lts ~ s, KnownNat s, RecJsonParse lts) => FromJSON (Rec lts) w
 instance RecNfData lts lts => NFData (Rec lts) where
   rnf = recNfData (Proxy :: Proxy lts)
 
+newtype ForallST a = ForallST {unForallST :: forall s. ST s a}
+
 -- Hack needed because $! doesn't have the same special treatment $ does to work with ST yet
 runST' :: (forall s. ST s a) -> a
 runST' !s = runST s
 
 -- | An empty record
 rnil :: Rec '[]
-rnil = unsafeRNil 0
+rnil = create (unsafeRNil 0)
 {-# INLINE rnil #-}
 
--- | An empty record with an initial size for the record
-unsafeRNil :: Int -> Rec '[]
+create :: (forall s. ST s (Rec xs)) -> Rec xs
+create = runST'
+
+unsafeRNil :: Int -> ST s (Rec '[])
 unsafeRNil (I# n#) =
-  runST' $
-    ST $ \s# ->
-      case newSmallArray# n# (error "No Value") s# of
-        (# s'#, arr# #) ->
-          case unsafeFreezeSmallArray# arr# s'# of
-            (# s''#, a# #) -> (# s''#, MkRec a# #)
+  ST $ \s# ->
+    case newSmallArray# n# (error "No value") s# of
+      (# s'#, arr# #) ->
+        case unsafeFreezeSmallArray# arr# s'# of
+          (# s''#, a# #) -> (# s''#, MkRec a# #)
 {-# INLINE unsafeRNil #-}
 
+-- | Prepend a record entry to a record 'Rec'. Assumes that the record was created with
+-- 'unsafeRNil' and still has enough free slots, mutates the original 'Rec' which should
+-- not be reused after
+--
+-- NOTE: doesn't use 'KeyDoesNotExist' because we rely on the fact that in
+-- euler-ps there were no duplicate keys
+unsafeRCons ::
+  forall l t lts size s.
+  ( RecSize lts ~ size,
+    KnownNat size
+    -- KeyDoesNotExist l lts
+  ) =>
+  l := t ->
+  Rec lts ->
+  ST s (Rec (l := t ': lts))
+unsafeRCons (_ := val) (MkRec vec#) =
+  ST $ \s# ->
+    case unsafeThawSmallArray# vec# s# of
+      (# s'#, arr# #) ->
+        -- Write the value to be cons'ed at the *end* (hence size#) of the
+        -- array, because `Rec` stores values in reverse order.
+        case writeSmallArray# arr# size# (unsafeCoerce# val) s'# of
+          s''# ->
+            case unsafeFreezeSmallArray# arr# s''# of
+              (# s'''#, a# #) -> (# s'''#, MkRec a# #)
+  where
+    !(I# size#) = fromIntegral $ natVal' (proxy# :: Proxy# size)
+{-# INLINE unsafeRCons #-}
+
 -- Not in superrecord
 recCopy :: forall lts rts. RecCopy lts lts rts => Rec lts -> Rec rts
 recCopy r@(MkRec vec#) =
@@ -189,36 +225,6 @@ instance
      in case writeSmallArray# tgt# (size# -# index# -# 1#) (unsafeCoerce# val) s# of
           s'# -> recCopyInto (Proxy :: Proxy nts) lts prxy tgt# s'#
 
--- | Prepend a record entry to a record 'Rec'. Assumes that the record was created with
--- 'unsafeRNil' and still has enough free slots, mutates the original 'Rec' which should
--- not be reused after
---
--- NOTE: doesn't use 'KeyDoesNotExist' because we rely on the fact that in
--- euler-ps there were no duplicate keys
-unsafeRCons ::
-  forall l t lts s.
-  ( RecSize lts ~ s,
-    KnownNat s
-    -- KeyDoesNotExist l lts
-  ) =>
-  l := t ->
-  Rec lts ->
-  Rec (l := t ': lts)
-unsafeRCons (_ := val) (MkRec vec#) =
-  runST' $
-    ST $ \s# ->
-      case unsafeThawSmallArray# vec# s# of
-        (# s'#, arr# #) ->
-          -- Write the value to be cons'ed at the *end* (hence size#) of the
-          -- array, because `Rec` stores values in reverse order.
-          case writeSmallArray# arr# size# (unsafeCoerce# val) s'# of
-            s''# ->
-              case unsafeFreezeSmallArray# arr# s''# of
-                (# s'''#, a# #) -> (# s'''#, MkRec a# #)
-  where
-    !(I# size#) = fromIntegral $ natVal' (proxy# :: Proxy# s)
-{-# INLINE unsafeRCons #-}
-
 type family RecAll (c :: u -> Constraint) (rs :: [u]) :: Constraint where
   RecAll c '[] = ()
   RecAll c (r ': rs) = (c r, RecAll c rs)
@@ -456,13 +462,14 @@ insert ::
 insert (l := v) rts =
   let !(I# size#) =
         fromIntegral $ natVal' (proxy# :: Proxy# (RecSize res))
-   in runST' $
+   in runST' $ do
+        single <- unsafeRCons (l := v) =<< unsafeRNil 1
         ST $ \s# ->
           case newSmallArray# size# (error "No value") s# of
             (# s'#, arr# #) ->
               case recCopyInto (Proxy :: Proxy rhs) rts (Proxy :: Proxy res) arr# s'# of
                 s''# ->
-                  case recCopyInto (Proxy :: Proxy '[l := v]) (unsafeRCons (l := v) $ unsafeRNil 1) (Proxy :: Proxy res) arr# s''# of
+                  case recCopyInto (Proxy :: Proxy '[l := v]) single (Proxy :: Proxy res) arr# s''# of
                     s'''# ->
                       case unsafeFreezeSmallArray# arr# s'''# of
                         (# s''''#, a# #) -> (# s''''#, MkRec a# #)
@@ -559,7 +566,7 @@ recJsonParser ::
   (JSONOptions -> Value -> Parser (Rec lts))
 recJsonParser options =
   withObject "Record" $ \o ->
-    recJsonParse options initSize o
+    (\(ForallST act) -> create act) <$> recJsonParse options initSize o
   where
     initSize = fromIntegral $ natVal' (proxy# :: Proxy# s)
 
@@ -619,10 +626,10 @@ type family RemoveAccessTo (l :: Symbol) (lts :: [*]) :: [*] where
 
 -- | Machinery to implement parseJSON
 class RecJsonParse (lts :: [*]) where
-  recJsonParse :: JSONOptions -> Int -> Object -> Parser (Rec lts)
+  recJsonParse :: JSONOptions -> Int -> Object -> Parser (ForallST (Rec lts))
 
 instance RecJsonParse '[] where
-  recJsonParse _ initSize _ = pure (unsafeRNil initSize)
+  recJsonParse _ initSize _ = pure (ForallST (unsafeRNil initSize))
 
 instance
   ( KnownSymbol l,
@@ -639,7 +646,7 @@ instance
         lbl = FldProxy
     rest <- recJsonParse options initSize obj
     (v :: t) <- obj .: T.pack (fieldTransform options (symbolVal lbl))
-    pure $ unsafeRCons (lbl := v) rest
+    pure $ ForallST (unsafeRCons (lbl := v) =<< unForallST rest)
 
 -- | Machinery for NFData
 class RecNfData (lts :: [*]) (rts :: [*]) where
@@ -680,7 +687,9 @@ instance
   ) =>
   FromNative (S1 ('MetaSel ('Just name) p s l) (Rec0 t)) '[name := t]
   where
-  fromNative' (M1 (K1 t)) = ((FldProxy :: FldProxy name) := t) `unsafeRCons` unsafeRNil 1
+  fromNative' (M1 (K1 t)) =
+    create $
+      unsafeRCons ((FldProxy :: FldProxy name) := t) =<< unsafeRNil 1
 
 instance
   ( FromNative l lhs,