tests green

src/Mujoco/MJCF/XML.Prop.purs

@@ -15,7 +15,7 @@ import Data.Tuple.Nested ((/\))
 import Prim.Row (class Cons, class Union)
 import Prim.RowList (class RowToList, RowList)
 import Prim.RowList as RL
-import Record.Unsafe (unsafeSet, unsafeHas, unsafeGet) as Record
+import Record.Unsafe (unsafeDelete, unsafeGet, unsafeHas, unsafeSet) as Record
 import Type.Prelude (Proxy(..))
 import Unsafe.Coerce (unsafeCoerce)
 
@@ -72,9 +72,15 @@ patchUnsafe f r =
     k' = reflectSymbol $ Proxy @k
     k = fromMaybe k' $ Map.lookup k' renames
     btoa = unsafeCoerce :: b -> a
+    newValue _ = btoa $ f $ Record.unsafeGet k' r
+    maybeWasRenamed
+      | k' /= k = Record.unsafeDelete k'
+      | otherwise = identity
   in
     if Record.unsafeHas k' r then
-      Record.unsafeSet k (btoa $ f $ Record.unsafeGet k' r) r
+      maybeWasRenamed
+      $ Record.unsafeSet k (newValue unit)
+      $ r
     else
       r
 

test/Main.purs

@@ -3,6 +3,9 @@ module Test.Main where
 import Prelude
 
 import Effect (Effect)
+import Effect.Aff (launchAff_)
+import Effect.Class (liftEffect)
+import Mujoco.Wasm as Wasm
 import Test.Mujoco.MJCF as Test.Mujoco.MJCF
 import Test.Mujoco.MJCF.Actuator as Test.Mujoco.MJCF.Actuator
 import Test.Mujoco.MJCF.Contact as Test.Mujoco.MJCF.Contact
@@ -13,17 +16,20 @@ import Test.Mujoco.MJCF.Equality as Test.Mujoco.MJCF.Equality
 import Test.Mujoco.MJCF.Keyframe as Test.Mujoco.MJCF.Keyframe
 import Test.Mujoco.MJCF.Sensor as Test.Mujoco.MJCF.Sensor
 import Test.Mujoco.MJCF.Tendon as Test.Mujoco.MJCF.Tendon
+import Test.Mujoco.MJCF.Util (mjcf)
 import Test.Mujoco.MJCF.Visual as Test.Mujoco.MJCF.Visual
 import Test.Mujoco.MJCF.XML.Prop as Test.Mujoco.MJCF.XML.Prop
-import Test.Mujoco.MJCF.Util (mjcf)
 import Test.Spec (mapSpecTree)
 import Test.Spec.Reporter.Console (consoleReporter)
 import Test.Spec.Runner.Node (runSpecAndExitProcess)
 
 main :: Effect Unit
 main =
-  runSpecAndExitProcess [consoleReporter] do
-    mjcf do
+  launchAff_ do
+    mj <- Wasm.loadMujoco
+    liftEffect
+      $ runSpecAndExitProcess [consoleReporter]
+      $ mjcf mj do
           Test.Mujoco.MJCF.spec
           Test.Mujoco.MJCF.XML.Prop.spec
           Test.Mujoco.MJCF.Actuator.spec

test/Mujoco.MJCF.Default.purs

@@ -44,9 +44,9 @@ spec =
 
     it "nested defaults" $ parseOk $ X.mujoco {}
       [ X.compiler { inertiafromgeom: X.true_ }
-      , Def.default { class: "outer" }
+      , Def.default {}
           [ Def.geom { rgba: 1.0 /\ 1.0 /\ 1.0 /\ 1.0 }
-          , Def.default { class: "inner" }
+          , Def.default { class: "red" }
               [ Def.geom { rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0 } ]
           ]
       , X.worldbody {}

test/Mujoco.MJCF.Deformable.purs

@@ -17,7 +17,7 @@ spec =
       it "basic" $ parseOk $ X.mujoco {}
         [ X.compiler { inertiafromgeom: X.true_ }
         , Deformable.deformable {}
-            [ Flex.flex { name: "f1", dim: 3, vertex: [0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], element: [0, 1, 2, 3] }
+            [ Flex.flex { name: "f1", dim: 3, body: ["world", "world", "world", "world"], vertex: [0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], element: [0, 1, 2, 3] }
                 unit
             ]
         , X.worldbody {}
@@ -29,7 +29,7 @@ spec =
       it "with edge" $ parseOk $ X.mujoco {}
         [ X.compiler { inertiafromgeom: X.true_ }
         , Deformable.deformable {}
-            [ Flex.flex { name: "f2", dim: 3, vertex: [0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], element: [0, 1, 2, 3] }
+            [ Flex.flex { name: "f2", dim: 3, body: ["world", "world", "world", "world"], vertex: [0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], element: [0, 1, 2, 3] }
                 [ Flex.edge { stiffness: 100.0, damping: 1.0 } ]
             ]
         , X.worldbody {}
@@ -41,7 +41,7 @@ spec =
       it "with elasticity" $ parseOk $ X.mujoco {}
         [ X.compiler { inertiafromgeom: X.true_ }
         , Deformable.deformable {}
-            [ Flex.flex { name: "f3", dim: 3, vertex: [0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], element: [0, 1, 2, 3] }
+            [ Flex.flex { name: "f3", dim: 3, body: ["world", "world", "world", "world"], vertex: [0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], element: [0, 1, 2, 3] }
                 [ Flex.elasticity { young: 1000.0, poisson: 0.3, damping: 0.01 } ]
             ]
         , X.worldbody {}
@@ -53,7 +53,7 @@ spec =
       it "with contact" $ parseOk $ X.mujoco {}
         [ X.compiler { inertiafromgeom: X.true_ }
         , Deformable.deformable {}
-            [ Flex.flex { name: "f4", dim: 3, vertex: [0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], element: [0, 1, 2, 3] }
+            [ Flex.flex { name: "f4", dim: 3, body: ["world", "world", "world", "world"], vertex: [0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], element: [0, 1, 2, 3] }
                 [ Flex.contact { internal: true } ]
             ]
         , X.worldbody {}
@@ -65,7 +65,7 @@ spec =
       it "rgba + group" $ parseOk $ X.mujoco {}
         [ X.compiler { inertiafromgeom: X.true_ }
         , Deformable.deformable {}
-            [ Flex.flex { name: "f5", dim: 3, vertex: [0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], element: [0, 1, 2, 3], rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0, group: 0 }
+            [ Flex.flex { name: "f5", dim: 3, body: ["world", "world", "world", "world"], vertex: [0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], element: [0, 1, 2, 3], rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0, group: 0 }
                 unit
             ]
         , X.worldbody {}

test/Mujoco.Wasm.js

@@ -4,7 +4,7 @@ import load_mujoco from 'mujoco_wasm/mujoco_wasm.js'
 /** @typedef {import('mujoco_wasm').MjSpec} Spec */
 
 /** @type {() => Promise<Mujoco>} */
-export const loadMujoco = () => load_mujoco()
+export const loadMujoco_ = () => load_mujoco()
 
 /** @type {(mj: Mujoco) => (xml: String) => () => Spec} */
 export const parseXMLString = m => xml => () => m.parseXMLString(xml)

test/Mujoco.Wasm.purs

@@ -1,10 +1,15 @@
 module Mujoco.Wasm where
 
 import Control.Promise (Promise)
+import Control.Promise as Promise
 import Effect (Effect)
+import Effect.Aff (Aff)
 
 foreign import data Mujoco :: Type
 foreign import data Spec :: Type
 
-foreign import loadMujoco :: Effect (Promise Mujoco)
+foreign import loadMujoco_ :: Effect (Promise Mujoco)
 foreign import parseXMLString :: Mujoco -> String -> Effect Spec
+
+loadMujoco :: Aff Mujoco
+loadMujoco = Promise.toAffE loadMujoco_

test/Mujuco.MJCF.Util.purs

@@ -3,7 +3,7 @@ module Test.Mujoco.MJCF.Util where
 import Prelude
 
 import Control.Monad.Error.Class (class MonadError, class MonadThrow, try)
-import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, ask, runReaderT)
+import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, ask, local, runReaderT)
 import Control.Promise as Promise
 import Data.Either (isLeft)
 import Data.Identity (Identity)
@@ -11,6 +11,7 @@ import Data.Newtype (class Newtype, unwrap)
 import Effect.Aff (Aff)
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect, liftEffect)
+import Effect.Console as Console
 import Effect.Exception (Error)
 import Mujoco.MJCF as X
 import Mujoco.MJCF.XML (Node)
@@ -20,15 +21,16 @@ import Mujoco.Wasm as Mj
 import Test.Assert (assertTrue)
 import Test.Spec (SpecT, Spec, hoistSpec)
 
-newtype T a = T (ReaderT Mujoco Aff a)
+type T' = { mj :: Mujoco, dbg :: Boolean }
+newtype T a = T (ReaderT T' Aff a)
 derive instance Newtype (T a) _
 derive newtype instance Functor T
 derive newtype instance Applicative T
 derive newtype instance Apply T
 derive newtype instance Bind T
 derive newtype instance Monad T
-derive newtype instance MonadReader Mujoco T
-derive newtype instance MonadAsk Mujoco T
+derive newtype instance MonadReader T' T
+derive newtype instance MonadAsk T' T
 derive newtype instance MonadEffect T
 derive newtype instance MonadAff T
 derive newtype instance MonadThrow Error T
@@ -36,18 +38,27 @@ derive newtype instance MonadError Error T
 
 type MjcfSpec a = SpecT T Unit Identity a
 
-mjcf :: forall a. MjcfSpec a -> Spec a
-mjcf = hoistSpec identity (\_ -> runT)
+mjcf :: forall a. Mujoco -> MjcfSpec a -> Spec a
+mjcf mj = hoistSpec identity (\_ -> runT mj)
 
-runT :: forall a. T a -> Aff a
-runT m = do
-  mj <- liftAff $ Promise.toAffE Mj.loadMujoco
-  runReaderT (unwrap m) mj
+runT :: forall a. Mujoco -> T a -> Aff a
+runT mj m = runReaderT (unwrap m) { mj, dbg: false }
+
+dbg :: forall a. T a -> T a
+dbg = local (_ { dbg = true })
 
 renderSpec :: XML.Node -> T Mj.Spec
 renderSpec node = do
-  mj <- ask
-  liftEffect $ Mj.parseXMLString mj $ XML.render node
+  { mj, dbg: dbg' } <- ask
+  let
+    xml = XML.render node
+
+  when dbg'
+    $ liftEffect
+    $ Console.log
+    $ xml
+
+  liftEffect $ Mj.parseXMLString mj xml
 
 parseOk :: XML.Node -> T Unit
 parseOk = void <<< renderSpec