diff --git a/src/Mujoco/MJCF.purs b/src/Mujoco/MJCF.purs index a4f9d20..646b942 100644 --- a/src/Mujoco/MJCF.purs +++ b/src/Mujoco/MJCF.purs @@ -32,6 +32,9 @@ import Mujoco.MJCF.Keyword as X import Mujoco.MJCF.Asset as X import Mujoco.MJCF.Body as X import Mujoco.MJCF.Contact as X +import Mujoco.MJCF.Sensor (sensor) as X +import Mujoco.MJCF.Actuator (actuator) as X +import Mujoco.MJCF.Tendon (tendon) as X import Mujoco.MJCF.XML (empty, text, fragment) as X type Props_mujoco = (model :: String) diff --git a/src/Mujoco/MJCF/Sensor.purs b/src/Mujoco/MJCF/Sensor.purs index fd24cad..1b9e6b8 100644 --- a/src/Mujoco/MJCF/Sensor.purs +++ b/src/Mujoco/MJCF/Sensor.purs @@ -4,6 +4,8 @@ import Mujoco.MJCF.Prelude import Mujoco.MJCF.Keyword as Kw +sensor = tag @() "sensor" :: Tag () + type ObjType = Kw.Body \/ Kw.Xbody \/ Kw.Geom \/ Kw.Site \/ Kw.Camera type Common' r = diff --git a/src/Mujoco/MJCF/Tendon.purs b/src/Mujoco/MJCF/Tendon.purs index 8ebf5d9..dee7416 100644 --- a/src/Mujoco/MJCF/Tendon.purs +++ b/src/Mujoco/MJCF/Tendon.purs @@ -4,6 +4,8 @@ import Mujoco.MJCF.Prelude import Mujoco.MJCF.Keyword as Kw +tendon = tag @() "tendon" :: Tag () + type Common r = ( class :: String , group :: Int diff --git a/src/Mujoco/MJCF/XML.Prop.purs b/src/Mujoco/MJCF/XML.Prop.purs index a0a2ae8..a49a987 100644 --- a/src/Mujoco/MJCF/XML.Prop.purs +++ b/src/Mujoco/MJCF/XML.Prop.purs @@ -20,7 +20,7 @@ import Type.Prelude (Proxy(..)) import Unsafe.Coerce (unsafeCoerce) renames :: Map String String -renames = Map.fromFoldable ["size" /\ "mjcf:size"] +renames = Map.fromFoldable ["size" /\ "mjcf:size", "class" /\ "mjcf:class"] class Serialize a where serialize :: a -> String diff --git a/test/Main.purs b/test/Main.purs index fa5edd0..6c8cb48 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -3,13 +3,36 @@ module Test.Main where import Prelude import Effect (Effect) -import Test.Mujoco.MJCF.XML.Prop as Test.Mujoco.MJCF.XML.Prop 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 +import Test.Mujoco.MJCF.Custom as Test.Mujoco.MJCF.Custom +import Test.Mujoco.MJCF.Default as Test.Mujoco.MJCF.Default +import Test.Mujoco.MJCF.Deformable as Test.Mujoco.MJCF.Deformable +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.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 - Test.Mujoco.MJCF.spec - Test.Mujoco.MJCF.XML.Prop.spec + mjcf do + Test.Mujoco.MJCF.spec + Test.Mujoco.MJCF.XML.Prop.spec + Test.Mujoco.MJCF.Actuator.spec + Test.Mujoco.MJCF.Contact.spec + Test.Mujoco.MJCF.Custom.spec + Test.Mujoco.MJCF.Deformable.spec + Test.Mujoco.MJCF.Default.spec + Test.Mujoco.MJCF.Equality.spec + Test.Mujoco.MJCF.Keyframe.spec + Test.Mujoco.MJCF.Sensor.spec + Test.Mujoco.MJCF.Tendon.spec + Test.Mujoco.MJCF.Visual.spec diff --git a/test/Mujoco.MJCF.Actuator.purs b/test/Mujoco.MJCF.Actuator.purs new file mode 100644 index 0000000..7eb62a6 --- /dev/null +++ b/test/Mujoco.MJCF.Actuator.purs @@ -0,0 +1,102 @@ +module Test.Mujoco.MJCF.Actuator where + +import Prelude + +import Data.Tuple.Nested ((/\)) +import Mujoco.MJCF as X +import Mujoco.MJCF.Actuator as Act +import Mujoco.MJCF.XML (Node) +import Test.Mujoco.MJCF.Util (MjcfSpec, parseOk) +import Test.Spec (describe, it) + +-- | Model with a body + hinge joint for actuator tests +m :: Node -> Node +m a = X.mujoco {} + [ X.compiler { inertiafromgeom: X.true_ } + , X.worldbody {} + [ X.body { name: "b1", pos: 0.0 /\ 0.0 /\ 0.5 } + [ X.joint { name: "j1", type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } + , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit + ] + ] + , a + ] + +spec :: MjcfSpec Unit +spec = + describe "actuator" do + describe "general" do + it "basic" $ parseOk $ m $ + Act.actuator {} [ Act.general { name: "a_gen", joint: "j1" } ] + + it "dyntype + gaintype + biastype" $ parseOk $ m $ + Act.actuator {} + [ Act.general { name: "a_gen2", joint: "j1", dyntype: X.kw X.Filter, gaintype: X.kw X.Fixed, biastype: X.kw X.Affine } ] + + it "ctrlrange + forcerange" $ parseOk $ m $ + Act.actuator {} + [ Act.general { name: "a_gen3", joint: "j1", ctrllimited: X.true_, ctrlrange: (-1.0) /\ 1.0, forcelimited: X.true_, forcerange: (-100.0) /\ 100.0 } ] + + describe "motor" do + it "basic" $ parseOk $ m $ + Act.actuator {} [ Act.motor { name: "a_motor", joint: "j1" } ] + + it "ctrlrange + gear" $ parseOk $ m $ + Act.actuator {} + [ Act.motor { name: "a_motor2", joint: "j1", ctrllimited: X.true_, ctrlrange: (-1.0) /\ 1.0, gear: [100.0, 0.0, 0.0, 0.0, 0.0, 0.0] } ] + + describe "position" do + it "basic" $ parseOk $ m $ + Act.actuator {} [ Act.position { name: "a_pos", joint: "j1" } ] + + it "kp + kv" $ parseOk $ m $ + Act.actuator {} + [ Act.position { name: "a_pos2", joint: "j1", kp: 100.0, kv: 10.0 } ] + + describe "velocity" do + it "basic" $ parseOk $ m $ + Act.actuator {} [ Act.velocity { name: "a_vel", joint: "j1" } ] + + it "kv" $ parseOk $ m $ + Act.actuator {} + [ Act.velocity { name: "a_vel2", joint: "j1", kv: 10.0 } ] + + describe "intvelocity" do + it "basic" $ parseOk $ m $ + Act.actuator {} [ Act.intvelocity { name: "a_iv", joint: "j1" } ] + + it "kp + actrange" $ parseOk $ m $ + Act.actuator {} + [ Act.intvelocity { name: "a_iv2", joint: "j1", kp: 100.0, actrange: (-1.0) /\ 1.0 } ] + + describe "damper" do + it "basic" $ parseOk $ m $ + Act.actuator {} [ Act.damper { name: "a_damp", joint: "j1" } ] + + it "kv" $ parseOk $ m $ + Act.actuator {} + [ Act.damper { name: "a_damp2", joint: "j1", kv: 10.0 } ] + + describe "cylinder" do + it "basic" $ parseOk $ m $ + Act.actuator {} [ Act.cylinder { name: "a_cyl", joint: "j1" } ] + + it "timeconst + area" $ parseOk $ m $ + Act.actuator {} + [ Act.cylinder { name: "a_cyl2", joint: "j1", timeconst: 0.1, area: 0.01 } ] + + describe "muscle" do + it "basic" $ parseOk $ m $ + Act.actuator {} [ Act.muscle { name: "a_musc", joint: "j1" } ] + + it "force + range + timeconst" $ parseOk $ m $ + Act.actuator {} + [ Act.muscle { name: "a_musc2", joint: "j1", force: 100.0, range: 0.75 /\ 1.05, timeconst: 0.01 /\ 0.04 } ] + + describe "adhesion" do + it "basic" $ parseOk $ m $ + Act.actuator {} [ Act.adhesion { name: "a_adh", body: "b1" } ] + + it "gain" $ parseOk $ m $ + Act.actuator {} + [ Act.adhesion { name: "a_adh2", body: "b1", gain: 1.0 } ] diff --git a/test/Mujoco.MJCF.Contact.purs b/test/Mujoco.MJCF.Contact.purs new file mode 100644 index 0000000..5999106 --- /dev/null +++ b/test/Mujoco.MJCF.Contact.purs @@ -0,0 +1,47 @@ +module Test.Mujoco.MJCF.Contact where + +import Prelude + +import Data.Tuple.Nested ((/\)) +import Mujoco.MJCF as X +import Test.Mujoco.MJCF.Util (MjcfSpec, parseOk) +import Test.Spec (describe, it) + +spec :: MjcfSpec Unit +spec = + describe "contact" do + describe "pair" do + it "geom1 + geom2" $ parseOk $ X.mujoco {} + [ X.worldbody {} + [ X.geom { name: "g1", type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit + , X.geom { name: "g2", type: X.kw X.Sphere, size: [0.1, 0.0, 0.0], pos: 1.0 /\ 0.0 /\ 0.0 } unit + ] + , X.contact {} [ X.pair { geom1: "g1", geom2: "g2" } ] + ] + + it "condim + friction" $ parseOk $ X.mujoco {} + [ X.worldbody {} + [ X.geom { name: "g1", type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit + , X.geom { name: "g2", type: X.kw X.Sphere, size: [0.1, 0.0, 0.0], pos: 1.0 /\ 0.0 /\ 0.0 } unit + ] + , X.contact {} [ X.pair { geom1: "g1", geom2: "g2", condim: 3, friction: 1.0 /\ 0.005 /\ 0.0001 /\ 0.005 /\ 0.0001 } ] + ] + + it "solref + solimp + margin + gap" $ parseOk $ X.mujoco {} + [ X.worldbody {} + [ X.geom { name: "g1", type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit + , X.geom { name: "g2", type: X.kw X.Sphere, size: [0.1, 0.0, 0.0], pos: 1.0 /\ 0.0 /\ 0.0 } unit + ] + , X.contact {} [ X.pair { geom1: "g1", geom2: "g2", solref: 0.02 /\ 1.0, solimp: 0.9 /\ 0.95 /\ 0.001 /\ 0.5 /\ 2.0, margin: 0.01, gap: 0.0 } ] + ] + + describe "exclude" do + it "body1 + body2" $ parseOk $ X.mujoco {} + [ X.worldbody {} + [ X.body { name: "b1", pos: 0.0 /\ 0.0 /\ 0.0 } + [ X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit ] + , X.body { name: "b2", pos: 1.0 /\ 0.0 /\ 0.0 } + [ X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit ] + ] + , X.contact {} [ X.exclude { body1: "b1", body2: "b2" } ] + ] diff --git a/test/Mujoco.MJCF.Custom.purs b/test/Mujoco.MJCF.Custom.purs new file mode 100644 index 0000000..cd3d62b --- /dev/null +++ b/test/Mujoco.MJCF.Custom.purs @@ -0,0 +1,50 @@ +module Test.Mujoco.MJCF.Custom where + +import Prelude + +import Mujoco.MJCF as X +import Mujoco.MJCF.Custom as Custom +import Test.Mujoco.MJCF.Util (MjcfSpec, parseOk) +import Test.Spec (describe, it) + +spec :: MjcfSpec Unit +spec = + describe "custom" do + describe "numeric" do + it "name + data" $ parseOk $ X.mujoco {} + [ Custom.custom {} + [ Custom.numeric { name: "params", data: [1.0, 2.0, 3.0] } ] + , X.worldbody {} unit + ] + + it "name + size" $ parseOk $ X.mujoco {} + [ Custom.custom {} + [ Custom.numeric { name: "zeros", size: 5 } ] + , X.worldbody {} unit + ] + + describe "text" do + it "name + data" $ parseOk $ X.mujoco {} + [ Custom.custom {} + [ Custom.text { name: "info", data: "hello world" } ] + , X.worldbody {} unit + ] + + describe "tuple" do + it "with elements" $ parseOk $ X.mujoco {} + [ Custom.custom {} + [ Custom.tuple { name: "body_list" } + [ Custom.element { objtype: "body", objname: "world", prm: 1.0 } ] + ] + , X.worldbody {} unit + ] + + describe "mixed" do + it "numeric + text + tuple" $ parseOk $ X.mujoco {} + [ Custom.custom {} + [ Custom.numeric { name: "n1", data: [0.0] } + , Custom.text { name: "t1", data: "value" } + , Custom.tuple { name: "tup1" } unit + ] + , X.worldbody {} unit + ] diff --git a/test/Mujoco.MJCF.Default.purs b/test/Mujoco.MJCF.Default.purs new file mode 100644 index 0000000..f357c17 --- /dev/null +++ b/test/Mujoco.MJCF.Default.purs @@ -0,0 +1,87 @@ +module Test.Mujoco.MJCF.Default where + +import Prelude + +import Data.Tuple.Nested ((/\)) +import Mujoco.MJCF as X +import Mujoco.MJCF.Default as Def +import Test.Mujoco.MJCF.Util (MjcfSpec, parseOk) +import Test.Spec (describe, it) + +spec :: MjcfSpec Unit +spec = + describe "default" do + it "empty" $ parseOk $ X.mujoco {} + [ Def.default {} unit + , X.worldbody {} unit + ] + + it "with class" $ parseOk $ X.mujoco {} + [ Def.default { class: "main" } unit + , X.worldbody {} unit + ] + + it "geom defaults" $ parseOk $ X.mujoco {} + [ Def.default {} + [ Def.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0], rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0 } ] + , X.worldbody {} + [ X.geom {} unit ] + ] + + it "joint defaults" $ parseOk $ X.mujoco {} + [ X.compiler { inertiafromgeom: X.true_ } + , Def.default {} + [ Def.joint { type: X.kw X.Hinge, damping: 1.0, stiffness: 10.0 } + , Def.geom { type: X.kw X.Capsule, size: [0.05, 0.2] } + ] + , X.worldbody {} + [ X.body { pos: 0.0 /\ 0.0 /\ 0.5 } + [ X.joint { axis: 1.0 /\ 0.0 /\ 0.0 } + , X.geom {} unit + ] + ] + ] + + it "nested defaults" $ parseOk $ X.mujoco {} + [ X.compiler { inertiafromgeom: X.true_ } + , Def.default { class: "outer" } + [ Def.geom { rgba: 1.0 /\ 1.0 /\ 1.0 /\ 1.0 } + , Def.default { class: "inner" } + [ Def.geom { rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0 } ] + ] + , X.worldbody {} + [ X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit ] + ] + + it "site defaults" $ parseOk $ X.mujoco {} + [ Def.default {} + [ Def.site { type: X.kw X.Sphere, size: 0.02 /\ 0.02 /\ 0.02, rgba: 0.0 /\ 1.0 /\ 0.0 /\ 1.0 } ] + , X.worldbody {} + [ X.site { name: "s1", pos: 0.0 /\ 0.0 /\ 0.0 } ] + ] + + it "light defaults" $ parseOk $ X.mujoco {} + [ Def.default {} + [ Def.light { diffuse: 0.8 /\ 0.8 /\ 0.8, castshadow: true } ] + , X.worldbody {} + [ X.light { name: "l1", pos: 0.0 /\ 0.0 /\ 3.0 } ] + ] + + it "camera defaults" $ parseOk $ X.mujoco {} + [ Def.default {} + [ Def.camera { fovy: 60.0 } ] + , X.worldbody {} + [ X.camera { name: "c1", pos: 0.0 /\ (-2.0) /\ 1.0 } ] + ] + + it "motor defaults" $ parseOk $ X.mujoco {} + [ X.compiler { inertiafromgeom: X.true_ } + , Def.default {} + [ Def.motor { ctrllimited: X.true_, ctrlrange: (-1.0) /\ 1.0 } ] + , X.worldbody {} + [ X.body { pos: 0.0 /\ 0.0 /\ 0.5 } + [ X.joint { name: "j1", type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } + , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit + ] + ] + ] diff --git a/test/Mujoco.MJCF.Deformable.purs b/test/Mujoco.MJCF.Deformable.purs new file mode 100644 index 0000000..caf9ed6 --- /dev/null +++ b/test/Mujoco.MJCF.Deformable.purs @@ -0,0 +1,92 @@ +module Test.Mujoco.MJCF.Deformable where + +import Prelude + +import Data.Tuple.Nested ((/\)) +import Mujoco.MJCF as X +import Mujoco.MJCF.Deformable as Deformable +import Mujoco.MJCF.Deformable.Flex as Flex +import Mujoco.MJCF.Deformable.Skin as Skin +import Test.Mujoco.MJCF.Util (MjcfSpec, parseOk) +import Test.Spec (describe, it) + +spec :: MjcfSpec Unit +spec = + describe "deformable" do + describe "flex" do + 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] } + unit + ] + , X.worldbody {} + [ X.body { pos: 0.0 /\ 0.0 /\ 0.0 } + [ X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit ] + ] + ] + + 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.edge { stiffness: 100.0, damping: 1.0 } ] + ] + , X.worldbody {} + [ X.body { pos: 0.0 /\ 0.0 /\ 0.0 } + [ X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit ] + ] + ] + + 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.elasticity { young: 1000.0, poisson: 0.3, damping: 0.01 } ] + ] + , X.worldbody {} + [ X.body { pos: 0.0 /\ 0.0 /\ 0.0 } + [ X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit ] + ] + ] + + 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.contact { internal: true } ] + ] + , X.worldbody {} + [ X.body { pos: 0.0 /\ 0.0 /\ 0.0 } + [ X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit ] + ] + ] + + 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 } + unit + ] + , X.worldbody {} + [ X.body { pos: 0.0 /\ 0.0 /\ 0.0 } + [ X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit ] + ] + ] + + describe "skin" do + it "basic" $ parseOk $ X.mujoco {} + [ Deformable.deformable {} + [ Skin.skin { name: "sk1", vertex: [0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0], face: [0, 1, 2] } + [ Skin.bone { body: "world", bindpos: 0.0 /\ 0.0 /\ 0.0, bindquat: 1.0 /\ 0.0 /\ 0.0 /\ 0.0, vertid: [0, 1, 2], vertweight: [1.0, 1.0, 1.0] } ] + ] + , X.worldbody {} unit + ] + + it "inflate + rgba" $ parseOk $ X.mujoco {} + [ Deformable.deformable {} + [ Skin.skin { name: "sk2", vertex: [0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0], face: [0, 1, 2], inflate: 0.01, rgba: 0.5 /\ 0.5 /\ 1.0 /\ 0.8 } + [ Skin.bone { body: "world", bindpos: 0.0 /\ 0.0 /\ 0.0, bindquat: 1.0 /\ 0.0 /\ 0.0 /\ 0.0, vertid: [0, 1, 2], vertweight: [1.0, 1.0, 1.0] } ] + ] + , X.worldbody {} unit + ] diff --git a/test/Mujoco.MJCF.Equality.purs b/test/Mujoco.MJCF.Equality.purs new file mode 100644 index 0000000..d148363 --- /dev/null +++ b/test/Mujoco.MJCF.Equality.purs @@ -0,0 +1,73 @@ +module Test.Mujoco.MJCF.Equality where + +import Prelude + +import Data.Tuple.Nested ((/\)) +import Mujoco.MJCF as X +import Mujoco.MJCF.Equality as Eq +import Mujoco.MJCF.Tendon as Tendon +import Mujoco.MJCF.XML (Node) +import Test.Mujoco.MJCF.Util (MjcfSpec, parseOk) +import Test.Spec (describe, it) + +-- | Model with two bodies, joints, and sites for equality constraint tests +m :: Node -> Node +m e = X.mujoco {} + [ X.compiler { inertiafromgeom: X.true_ } + , X.worldbody {} + [ X.body { name: "b1", pos: 0.0 /\ 0.0 /\ 0.5 } + [ X.joint { name: "j1", type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } + , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit + , X.site { name: "s1", pos: 0.0 /\ 0.0 /\ 0.1, size: 0.01 /\ 0.01 /\ 0.01 } + ] + , X.body { name: "b2", pos: 1.0 /\ 0.0 /\ 0.5 } + [ X.joint { name: "j2", type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } + , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit + , X.site { name: "s2", pos: 0.0 /\ 0.0 /\ 0.1, size: 0.01 /\ 0.01 /\ 0.01 } + ] + ] + , e + ] + +spec :: MjcfSpec Unit +spec = + describe "equality" do + describe "connect" do + it "body1 + body2 + anchor" $ parseOk $ m $ + Eq.equality {} [ Eq.connect { body1: "b1", body2: "b2", anchor: 0.5 /\ 0.0 /\ 0.5 } unit ] + + it "site1 + site2" $ parseOk $ m $ + Eq.equality {} [ Eq.connect { site1: "s1", site2: "s2" } unit ] + + it "solref + solimp" $ parseOk $ m $ + Eq.equality {} [ Eq.connect { body1: "b1", body2: "b2", anchor: 0.5 /\ 0.0 /\ 0.5, solref: 0.02 /\ 1.0, solimp: 0.9 /\ 0.95 /\ 0.001 /\ 0.5 /\ 2.0 } unit ] + + describe "weld" do + it "body1 + body2" $ parseOk $ m $ + Eq.equality {} [ Eq.weld { body1: "b1", body2: "b2" } ] + + it "site1 + site2" $ parseOk $ m $ + Eq.equality {} [ Eq.weld { site1: "s1", site2: "s2" } ] + + it "torquescale" $ parseOk $ m $ + Eq.equality {} [ Eq.weld { body1: "b1", body2: "b2", torquescale: 1.0 } ] + + describe "joint" do + it "joint1 + joint2" $ parseOk $ m $ + Eq.equality {} [ Eq.joint { joint1: "j1", joint2: "j2" } ] + + it "polycoef" $ parseOk $ m $ + Eq.equality {} [ Eq.joint { joint1: "j1", joint2: "j2", polycoef: 0.0 /\ 1.0 /\ 0.0 /\ 0.0 /\ 0.0 } ] + + describe "tendon" do + it "tendon1" $ parseOk $ X.mujoco {} + [ X.compiler { inertiafromgeom: X.true_ } + , X.worldbody {} + [ X.body { name: "b1", pos: 0.0 /\ 0.0 /\ 0.5 } + [ X.joint { name: "j1", type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } + , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit + ] + ] + , Tendon.tendon {} $ Tendon.fixed { name: "t1" } [ Tendon.joint { joint: "j1", coef: 1.0 } ] + , Eq.equality {} [ Eq.tendon { tendon1: "t1" } ] + ] diff --git a/test/Mujoco.MJCF.Keyframe.purs b/test/Mujoco.MJCF.Keyframe.purs new file mode 100644 index 0000000..70356b9 --- /dev/null +++ b/test/Mujoco.MJCF.Keyframe.purs @@ -0,0 +1,54 @@ +module Test.Mujoco.MJCF.Keyframe where + +import Prelude + +import Data.Tuple.Nested ((/\)) +import Mujoco.MJCF as X +import Test.Mujoco.MJCF.Util (MjcfSpec, parseOk) +import Test.Spec (describe, it) + +spec :: MjcfSpec Unit +spec = + describe "keyframe" do + it "empty" $ parseOk $ X.mujoco {} + [ X.worldbody {} unit + , X.keyframe {} unit + ] + + it "key with time" $ parseOk $ X.mujoco {} + [ X.worldbody {} unit + , X.keyframe {} + [ X.key { name: "home", time: 0.0 } ] + ] + + it "key with qpos + qvel" $ parseOk $ X.mujoco {} + [ X.compiler { inertiafromgeom: X.true_ } + , X.worldbody {} + [ X.body { pos: 0.0 /\ 0.0 /\ 0.5 } + [ X.joint { name: "j1", type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } + , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit + ] + ] + , X.keyframe {} + [ X.key { name: "init", time: 0.0, qpos: [0.5], qvel: [0.0] } ] + ] + + it "key with ctrl" $ parseOk $ X.mujoco {} + [ X.compiler { inertiafromgeom: X.true_ } + , X.worldbody {} + [ X.body { pos: 0.0 /\ 0.0 /\ 0.5 } + [ X.joint { name: "j1", type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } + , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit + ] + ] + , X.keyframe {} + [ X.key { name: "start", ctrl: [0.0] } ] + ] + + it "multiple keys" $ parseOk $ X.mujoco {} + [ X.worldbody {} unit + , X.keyframe {} + [ X.key { name: "k1", time: 0.0 } + , X.key { name: "k2", time: 1.0 } + ] + ] diff --git a/test/Mujoco.MJCF.Sensor.purs b/test/Mujoco.MJCF.Sensor.purs new file mode 100644 index 0000000..ca1f30f --- /dev/null +++ b/test/Mujoco.MJCF.Sensor.purs @@ -0,0 +1,166 @@ +module Test.Mujoco.MJCF.Sensor where + +import Prelude + +import Data.Tuple.Nested ((/\)) +import Mujoco.MJCF as X +import Mujoco.MJCF.Actuator as Act +import Mujoco.MJCF.Sensor as Sens +import Mujoco.MJCF.XML (Node) +import Test.Mujoco.MJCF.Util (MjcfSpec, parseOk) +import Test.Spec (describe, it) + +-- | Model with body, site, joint, tendon, and actuator for sensor tests +m :: Node -> Node +m s = X.mujoco {} + [ X.compiler { inertiafromgeom: X.true_ } + , X.worldbody {} + [ X.body { name: "b1", pos: 0.0 /\ 0.0 /\ 0.5 } + [ X.joint { name: "j1", type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } + , X.geom { name: "g1", type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit + , X.site { name: "s1", pos: 0.0 /\ 0.0 /\ 0.1, size: 0.01 /\ 0.01 /\ 0.01 } + , X.camera { name: "cam1", pos: 0.0 /\ (-1.0) /\ 0.5, fovy: 60.0 } + ] + , X.body { name: "b2", pos: 1.0 /\ 0.0 /\ 0.5 } + [ X.joint { name: "j2", type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } + , X.geom { name: "g2", type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit + , X.site { name: "s2", pos: 0.0 /\ 0.0 /\ 0.1, size: 0.01 /\ 0.01 /\ 0.01 } + ] + ] + , Act.actuator {} [ Act.motor { name: "a1", joint: "j1" } ] + , s + ] + +spec :: MjcfSpec Unit +spec = + describe "sensor" do + describe "site-based" do + it "touch" $ parseOk $ m $ + X.sensor {} [ Sens.touch { name: "se_touch", site: "s1" } ] + + it "accelerometer" $ parseOk $ m $ + X.sensor {} [ Sens.accelerometer { name: "se_accel", site: "s1" } ] + + it "velocimeter" $ parseOk $ m $ + X.sensor {} [ Sens.velocimeter { name: "se_velo", site: "s1" } ] + + it "gyro" $ parseOk $ m $ + X.sensor {} [ Sens.gyro { name: "se_gyro", site: "s1" } ] + + it "force" $ parseOk $ m $ + X.sensor {} [ Sens.force { name: "se_force", site: "s1" } ] + + it "torque" $ parseOk $ m $ + X.sensor {} [ Sens.torque { name: "se_torque", site: "s1" } ] + + it "magnetometer" $ parseOk $ m $ + X.sensor {} [ Sens.magnetometer { name: "se_mag", site: "s1" } ] + + it "rangefinder" $ parseOk $ m $ + X.sensor {} [ Sens.rangefinder { name: "se_range", site: "s1" } ] + + it "camprojection" $ parseOk $ m $ + X.sensor {} [ Sens.camprojection { name: "se_camp", site: "s1", camera: "cam1" } ] + + describe "joint-based" do + it "jointpos" $ parseOk $ m $ + X.sensor {} [ Sens.jointpos { name: "se_jpos", joint: "j1" } ] + + it "jointvel" $ parseOk $ m $ + X.sensor {} [ Sens.jointvel { name: "se_jvel", joint: "j1" } ] + + it "jointactuatorfrc" $ parseOk $ m $ + X.sensor {} [ Sens.jointactuatorfrc { name: "se_jafrc", joint: "j1" } ] + + it "jointlimitpos" $ parseOk $ m $ + X.sensor {} [ Sens.jointlimitpos { name: "se_jlpos", joint: "j1" } ] + + it "jointlimitvel" $ parseOk $ m $ + X.sensor {} [ Sens.jointlimitvel { name: "se_jlvel", joint: "j1" } ] + + it "jointlimitfrc" $ parseOk $ m $ + X.sensor {} [ Sens.jointlimitfrc { name: "se_jlfrc", joint: "j1" } ] + + describe "actuator-based" do + it "actuatorpos" $ parseOk $ m $ + X.sensor {} [ Sens.actuatorpos { name: "se_apos", actuator: "a1" } ] + + it "actuatorvel" $ parseOk $ m $ + X.sensor {} [ Sens.actuatorvel { name: "se_avel", actuator: "a1" } ] + + it "actuatorfrc" $ parseOk $ m $ + X.sensor {} [ Sens.actuatorfrc { name: "se_afrc", actuator: "a1" } ] + + describe "frame-based" do + it "framepos" $ parseOk $ m $ + X.sensor {} [ Sens.framepos { name: "se_fpos", objtype: X.kw X.Body, objname: "b1" } ] + + it "framequat" $ parseOk $ m $ + X.sensor {} [ Sens.framequat { name: "se_fquat", objtype: X.kw X.Body, objname: "b1" } ] + + it "framexaxis" $ parseOk $ m $ + X.sensor {} [ Sens.framexaxis { name: "se_fxax", objtype: X.kw X.Body, objname: "b1" } ] + + it "frameyaxis" $ parseOk $ m $ + X.sensor {} [ Sens.frameyaxis { name: "se_fyax", objtype: X.kw X.Body, objname: "b1" } ] + + it "framezaxis" $ parseOk $ m $ + X.sensor {} [ Sens.framezaxis { name: "se_fzax", objtype: X.kw X.Body, objname: "b1" } ] + + it "framelinvel" $ parseOk $ m $ + X.sensor {} [ Sens.framelinvel { name: "se_flv", objtype: X.kw X.Body, objname: "b1" } ] + + it "frameangvel" $ parseOk $ m $ + X.sensor {} [ Sens.frameangvel { name: "se_fav", objtype: X.kw X.Body, objname: "b1" } ] + + it "framelinvel with ref" $ parseOk $ m $ + X.sensor {} [ Sens.framelinvel { name: "se_flvr", objtype: X.kw X.Body, objname: "b1", reftype: X.kw X.Body, refname: "b2" } ] + + it "framelinacc" $ parseOk $ m $ + X.sensor {} [ Sens.framelinacc { name: "se_fla", objtype: X.kw X.Body, objname: "b1" } ] + + it "frameangacc" $ parseOk $ m $ + X.sensor {} [ Sens.frameangacc { name: "se_faa", objtype: X.kw X.Body, objname: "b1" } ] + + describe "subtree" do + it "subtreecom" $ parseOk $ m $ + X.sensor {} [ Sens.subtreecom { name: "se_stcom", body: "b1" } ] + + it "subtreelinvel" $ parseOk $ m $ + X.sensor {} [ Sens.subtreelinvel { name: "se_stlv", body: "b1" } ] + + it "subtreeangmom" $ parseOk $ m $ + X.sensor {} [ Sens.subtreeangmom { name: "se_stam", body: "b1" } ] + + describe "collision" do + it "distance" $ parseOk $ m $ + X.sensor {} [ Sens.distance { name: "se_dist", geom1: "g1", geom2: "g2" } ] + + it "normal" $ parseOk $ m $ + X.sensor {} [ Sens.normal { name: "se_norm", geom1: "g1", geom2: "g2" } ] + + it "fromto" $ parseOk $ m $ + X.sensor {} [ Sens.fromto { name: "se_ft", geom1: "g1", geom2: "g2" } ] + + it "contact" $ parseOk $ m $ + X.sensor {} [ Sens.contact { name: "se_cont", body1: "b1", body2: "b2" } ] + + describe "other" do + it "insidesite" $ parseOk $ m $ + X.sensor {} [ Sens.insidesite { name: "se_inside", objtype: X.kw X.Geom, objname: "g1", site: "s1" } ] + + it "e_potential" $ parseOk $ m $ + X.sensor {} [ Sens.e_potential { name: "se_ep" } ] + + it "e_kinetic" $ parseOk $ m $ + X.sensor {} [ Sens.e_kinetic { name: "se_ek" } ] + + it "clock" $ parseOk $ m $ + X.sensor {} [ Sens.clock { name: "se_clock" } ] + + it "user" $ parseOk $ m $ + X.sensor {} [ Sens.user { name: "se_user", objtype: "body", objname: "b1", datatype: X.kw X.Real, needstage: X.kw X.Vel, dim: 1 } ] + + describe "common props" do + it "noise + cutoff" $ parseOk $ m $ + X.sensor {} [ Sens.touch { name: "se_noisy", site: "s1", noise: 0.01, cutoff: 100.0 } ] diff --git a/test/Mujoco.MJCF.Tendon.purs b/test/Mujoco.MJCF.Tendon.purs new file mode 100644 index 0000000..39d8bd8 --- /dev/null +++ b/test/Mujoco.MJCF.Tendon.purs @@ -0,0 +1,64 @@ +module Test.Mujoco.MJCF.Tendon where + +import Prelude + +import Data.Tuple.Nested ((/\)) +import Mujoco.MJCF as X +import Mujoco.MJCF.Tendon as Tendon +import Mujoco.MJCF.XML (Node) +import Test.Mujoco.MJCF.Util (MjcfSpec, parseOk) +import Test.Spec (describe, it) + +-- | Model with two bodies, two hinge joints, and two sites for tendon routing +m :: Node -> Node +m t = X.mujoco {} + [ X.compiler { inertiafromgeom: X.true_ } + , X.worldbody {} + [ X.body { name: "b1", pos: 0.0 /\ 0.0 /\ 0.5 } + [ X.joint { name: "j1", type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } + , X.geom { type: X.kw X.Capsule, size: [0.05, 0.2] } unit + , X.site { name: "s1", pos: 0.0 /\ 0.0 /\ 0.2, size: 0.01 /\ 0.01 /\ 0.01 } + , X.body { name: "b2", pos: 0.0 /\ 0.0 /\ 0.5 } + [ X.joint { name: "j2", type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } + , X.geom { type: X.kw X.Capsule, size: [0.05, 0.2] } unit + , X.site { name: "s2", pos: 0.0 /\ 0.0 /\ 0.2, size: 0.01 /\ 0.01 /\ 0.01 } + ] + ] + ] + , t + ] + +spec :: MjcfSpec Unit +spec = + describe "tendon" do + describe "spatial" do + it "basic site routing" $ parseOk $ m $ Tendon.tendon {} $ + Tendon.spatial { name: "t_spatial" } + [ Tendon.site { site: "s1" } + , Tendon.site { site: "s2" } + ] + + it "with pulley" $ parseOk $ m $ Tendon.tendon {} $ + Tendon.spatial { name: "t_pulley" } + [ Tendon.site { site: "s1" } + , Tendon.pulley { divisor: 2.0 } + , Tendon.site { site: "s2" } + ] + + it "limited + range + stiffness + damping" $ parseOk $ m $ Tendon.tendon {} $ + Tendon.spatial { name: "t_props", limited: X.true_, range: (-1.0) /\ 1.0, stiffness: 100.0, damping: 10.0 } + [ Tendon.site { site: "s1" } + , Tendon.site { site: "s2" } + ] + + describe "fixed" do + it "basic joint" $ parseOk $ m $ Tendon.tendon {} $ + Tendon.fixed { name: "t_fixed" } + [ Tendon.joint { joint: "j1", coef: 1.0 } + , Tendon.joint { joint: "j2", coef: -1.0 } + ] + + it "stiffness + damping" $ parseOk $ m $ Tendon.tendon {} $ + Tendon.fixed { name: "t_fixed2", stiffness: 50.0, damping: 5.0 } + [ Tendon.joint { joint: "j1", coef: 1.0 } + ] diff --git a/test/Mujoco.MJCF.Visual.purs b/test/Mujoco.MJCF.Visual.purs new file mode 100644 index 0000000..7c6b0dd --- /dev/null +++ b/test/Mujoco.MJCF.Visual.purs @@ -0,0 +1,82 @@ +module Test.Mujoco.MJCF.Visual where + +import Prelude + +import Data.Tuple.Nested ((/\)) +import Mujoco.MJCF as X +import Mujoco.MJCF.Visual as Vis +import Mujoco.MJCF.XML (Node) +import Test.Mujoco.MJCF.Util (MjcfSpec, parseOk) +import Test.Spec (describe, it) + +v :: Node -> Node +v c = X.mujoco {} + [ Vis.visual {} [ c ] + , X.worldbody {} unit + ] + +spec :: MjcfSpec Unit +spec = + describe "visual" do + describe "global" do + it "fovy + linewidth" $ parseOk $ v $ + Vis.global { fovy: 45.0, linewidth: 2.0 } + + it "offwidth + offheight" $ parseOk $ v $ + Vis.global { offwidth: 1920, offheight: 1080 } + + it "orthographic + ellipsoidinertia" $ parseOk $ v $ + Vis.global { orthographic: true, ellipsoidinertia: true } + + describe "quality" do + it "shadowsize + offsamples" $ parseOk $ v $ + Vis.quality { shadowsize: 4096, offsamples: 8 } + + it "numslices + numstacks + numquads" $ parseOk $ v $ + Vis.quality { numslices: 32, numstacks: 32, numquads: 4 } + + describe "headlight" do + it "ambient + diffuse + specular" $ parseOk $ v $ + Vis.headlight { ambient: 0.3 /\ 0.3 /\ 0.3, diffuse: 0.6 /\ 0.6 /\ 0.6, specular: 0.2 /\ 0.2 /\ 0.2 } + + it "active" $ parseOk $ v $ + Vis.headlight { active: 0 } + + describe "map" do + it "stiffness + force + torque" $ parseOk $ v $ + Vis.map { stiffness: 100.0, force: 0.05, torque: 0.1 } + + it "fogstart + fogend" $ parseOk $ v $ + Vis.map { fogstart: 2.0, fogend: 10.0 } + + it "znear + zfar" $ parseOk $ v $ + Vis.map { znear: 0.01, zfar: 50.0 } + + it "shadowclip + shadowscale" $ parseOk $ v $ + Vis.map { shadowclip: 0.5, shadowscale: 0.5 } + + describe "scale" do + it "forcewidth + contactwidth + contactheight" $ parseOk $ v $ + Vis.scale { forcewidth: 0.1, contactwidth: 0.3, contactheight: 0.1 } + + it "jointlength + jointwidth" $ parseOk $ v $ + Vis.scale { jointlength: 0.5, jointwidth: 0.1 } + + it "framelength + framewidth" $ parseOk $ v $ + Vis.scale { framelength: 1.0, framewidth: 0.05 } + + it "actuatorlength + actuatorwidth" $ parseOk $ v $ + Vis.scale { actuatorlength: 0.7, actuatorwidth: 0.1 } + + describe "rgba" do + it "fog + haze" $ parseOk $ v $ + Vis.rgba { fog: 0.0 /\ 0.0 /\ 0.0 /\ 1.0, haze: 1.0 /\ 1.0 /\ 1.0 /\ 1.0 } + + it "force + inertia + joint" $ parseOk $ v $ + Vis.rgba { force: 1.0 /\ 0.5 /\ 0.5 /\ 1.0, inertia: 0.8 /\ 0.2 /\ 0.2 /\ 0.6, joint: 0.2 /\ 0.6 /\ 0.8 /\ 1.0 } + + it "com + camera + light" $ parseOk $ v $ + Vis.rgba { com: 0.0 /\ 1.0 /\ 0.0 /\ 1.0, camera: 0.6 /\ 0.9 /\ 0.6 /\ 1.0, light: 0.9 /\ 0.9 /\ 0.3 /\ 1.0 } + + it "contact colors" $ parseOk $ v $ + Vis.rgba { contactpoint: 0.9 /\ 0.2 /\ 0.2 /\ 1.0, contactforce: 0.2 /\ 0.9 /\ 0.2 /\ 1.0, contactfriction: 0.2 /\ 0.2 /\ 0.9 /\ 1.0, contacttorque: 0.9 /\ 0.9 /\ 0.2 /\ 1.0 } diff --git a/test/Mujoco.MJCF.XML.Prop.purs b/test/Mujoco.MJCF.XML.Prop.purs index 1829d2d..a99fb97 100644 --- a/test/Mujoco.MJCF.XML.Prop.purs +++ b/test/Mujoco.MJCF.XML.Prop.purs @@ -6,7 +6,8 @@ import Data.Tuple.Nested (type (/\), (/\)) import Mujoco.MJCF.XML.Prop (class SerializeProps', serialize, serializeProps) import Prim.Row (class Union) import Prim.RowList (class RowToList) -import Test.Spec (Spec, describe, it) +import Test.Mujoco.MJCF.Util (MjcfSpec) +import Test.Spec (describe, it) import Test.Spec.Assertions (shouldEqual) import Unsafe.Coerce (unsafeCoerce) @@ -20,7 +21,7 @@ type Props = , bool :: Boolean ) -spec :: Spec Unit +spec :: MjcfSpec Unit spec = describe "Mujoco.MJCF.XML.Prop" do describe "Serialize" do diff --git a/test/Mujoco.MJCF.purs b/test/Mujoco.MJCF.purs index e9fb73b..e801bdf 100644 --- a/test/Mujoco.MJCF.purs +++ b/test/Mujoco.MJCF.purs @@ -2,111 +2,94 @@ module Test.Mujoco.MJCF where import Prelude -import Control.Monad.Error.Class (try) -import Data.Either (isLeft) import Data.Tuple.Nested ((/\)) -import Effect.Aff (Aff) -import Effect.Class (liftEffect) import Mujoco.MJCF as X -import Mujoco.MJCF.Geom as X.G -import Mujoco.Wasm (renderSpec) -import Mujoco.MJCF.XML (Node) -import Mujoco.MJCF.XML as XML -import Test.Assert (assertTrue) -import Test.Spec (Spec, describe, it) +import Test.Mujoco.MJCF.Util (MjcfSpec, parseFail, parseOk, w) +import Test.Spec (describe, it) -ok :: Node -> Aff Unit -ok = void <<< renderSpec - -fail :: Node -> Aff Unit -fail = (liftEffect <<< assertTrue <<< isLeft) <=< (try <<< renderSpec) - -w :: forall a. XML.Children a => a -> Node -w = X.mujoco {} <<< X.worldbody {} - -spec :: Spec Unit +spec :: MjcfSpec Unit spec = describe "MJCF" do - it "" $ fail $ X.empty - it "" $ ok $ X.mujoco {} unit - it "" $ ok $ X.mujoco {} $ X.worldbody {} unit + it "" $ parseFail $ X.empty + it "" $ parseOk $ X.mujoco {} unit + it "" $ parseOk $ X.mujoco {} $ X.worldbody {} unit describe "compiler" do - it "empty" $ ok $ X.mujoco {} + it "empty" $ parseOk $ X.mujoco {} [ X.compiler {} , X.worldbody {} unit ] - it "angle=radian" $ ok $ X.mujoco {} + it "angle=radian" $ parseOk $ X.mujoco {} [ X.compiler { angle: X.kw X.Radian } , X.worldbody {} unit ] - it "autolimits + coordinate" $ ok $ X.mujoco {} + it "autolimits + coordinate" $ parseOk $ X.mujoco {} [ X.compiler { autolimits: true, coordinate: X.kw X.Local } , X.worldbody {} unit ] - it "inertiafromgeom=auto" $ ok $ X.mujoco {} + it "inertiafromgeom=auto" $ parseOk $ X.mujoco {} [ X.compiler { inertiafromgeom: X.kw X.Auto } , X.worldbody {} unit ] - it "boundmass + boundinertia" $ ok $ X.mujoco {} + it "boundmass + boundinertia" $ parseOk $ X.mujoco {} [ X.compiler { boundmass: 0.01, boundinertia: 0.001 } , X.worldbody {} unit ] describe "size" do - it "empty" $ ok $ X.mujoco {} + it "empty" $ parseOk $ X.mujoco {} [ X.size {} , X.worldbody {} unit ] - it "memory" $ ok $ X.mujoco {} + it "memory" $ parseOk $ X.mujoco {} [ X.size { memory: "16M" } , X.worldbody {} unit ] - it "nuser fields" $ ok $ X.mujoco {} + it "nuser fields" $ parseOk $ X.mujoco {} [ X.size { nuser_body: 2, nuser_jnt: 1, nuser_geom: 3 } , X.worldbody {} unit ] describe "option" do - it "timestep + integrator" $ ok $ X.mujoco {} + it "timestep + integrator" $ parseOk $ X.mujoco {} [ X.option { timestep: 0.001, integrator: X.kw X.RK4 } unit , X.worldbody {} unit ] - it "gravity + solver" $ ok $ X.mujoco {} + it "gravity + solver" $ parseOk $ X.mujoco {} [ X.option { gravity: 0.0 /\ 0.0 /\ (-9.81), solver: X.kw X.Newton } unit , X.worldbody {} unit ] describe "statistic" do - it "extent + center" $ ok $ X.mujoco {} + it "extent + center" $ parseOk $ X.mujoco {} [ X.statistic { extent: 2.0, center: 0.0 /\ 0.0 /\ 1.0 } , X.worldbody {} unit ] describe "asset" do describe "mesh" do - it "inline vertex" $ ok $ X.mujoco {} + it "inline vertex" $ parseOk $ X.mujoco {} [ X.asset {} [ X.mesh { name: "tetra", 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] } unit ] , X.worldbody {} unit ] describe "hfield" do - it "nrow + ncol + size" $ ok $ X.mujoco {} + it "nrow + ncol + size" $ parseOk $ X.mujoco {} [ X.asset {} [ X.hfield { name: "terrain", nrow: 10, ncol: 10, size: 1.0 /\ 1.0 /\ 0.5 /\ 0.1 } ] , X.worldbody {} unit ] describe "texture" do - it "procedural checker" $ ok $ X.mujoco {} + it "procedural checker" $ parseOk $ X.mujoco {} [ X.asset {} [ X.texture { name: "grid" @@ -122,7 +105,7 @@ spec = ] describe "material" do - it "rgba + specular" $ ok $ X.mujoco {} + it "rgba + specular" $ parseOk $ X.mujoco {} [ X.asset {} [ X.material { name: "mat1", rgba: 0.8 /\ 0.2 /\ 0.2 /\ 1.0, specular: 0.8 } unit ] , X.worldbody {} unit @@ -130,77 +113,77 @@ spec = describe "body" do describe "joint" do - it "hinge" $ ok $ w $ + it "hinge" $ parseOk $ w $ X.body { name: "b1", pos: 0.0 /\ 0.0 /\ 0.5 } [ X.joint { type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit ] - it "slide with range" $ ok $ w $ + it "slide with range" $ parseOk $ w $ X.body { name: "slider", pos: 0.0 /\ 0.0 /\ 1.0 } [ X.joint { type: X.kw X.Slide, axis: 0.0 /\ 0.0 /\ 1.0, range: (-1.0) /\ 1.0, limited: X.true_ } , X.geom { type: X.kw X.Box, size: [0.1, 0.1, 0.1] } unit ] - it "stiffness + damping" $ ok $ w $ + it "stiffness + damping" $ parseOk $ w $ X.body { pos: 0.0 /\ 0.0 /\ 0.0 } [ X.joint { type: X.kw X.Hinge, stiffness: 100.0, damping: 10.0, armature: 0.1 } , X.geom { type: X.kw X.Sphere, size: [0.05, 0.0, 0.0] } unit ] describe "freejoint" do - it "basic" $ ok $ w $ + it "basic" $ parseOk $ w $ X.body { name: "free_body", pos: 0.0 /\ 0.0 /\ 1.0 } [ X.freejoint { name: "fj" } , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit ] describe "geom" do - it "sphere" $ ok $ w $ + it "sphere" $ parseOk $ w $ X.geom { type: X.kw X.Sphere, size: [1.0, 0.0, 0.0] } unit - it "capsule fromto" $ ok $ w $ + it "capsule fromto" $ parseOk $ w $ X.geom { type: X.kw X.Capsule, fromto: [0.0, 0.0, 0.0, 0.0, 0.0, 1.0], size: [0.05, 0.0, 0.0] } unit - it "box with material" $ ok $ X.mujoco {} + it "box with material" $ parseOk $ X.mujoco {} [ X.asset {} [ X.material { name: "red", rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0 } unit ] , X.worldbody {} $ X.geom { type: X.kw X.Box, size: [0.5, 0.5, 0.5], material: "red" } unit ] - it "plane" $ ok $ w $ + it "plane" $ parseOk $ w $ X.geom { type: X.kw X.Plane, size: [5.0, 5.0, 0.1] } unit - it "friction + density" $ ok $ w $ + it "friction + density" $ parseOk $ w $ X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0], friction: 0.5 /\ 0.005 /\ 0.0001, density: 500.0 } unit describe "site" do - it "basic" $ ok $ w $ + it "basic" $ parseOk $ w $ X.body { pos: 0.0 /\ 0.0 /\ 0.0 } [ X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit , X.site { name: "s1", pos: 0.0 /\ 0.0 /\ 0.1, size: 0.01 /\ 0.01 /\ 0.01 } ] describe "camera" do - it "fixed" $ ok $ w $ + it "fixed" $ parseOk $ w $ X.camera { name: "cam1", pos: 0.0 /\ (-2.0) /\ 1.0, fovy: 60.0 } - it "tracking" $ ok $ w $ + it "tracking" $ parseOk $ w $ X.body { name: "target_body", pos: 0.0 /\ 0.0 /\ 0.5 } [ X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit , X.camera { name: "tracker", mode: X.kw X.Targetbody, target: "target_body", pos: 1.0 /\ 0.0 /\ 0.5 } ] describe "light" do - it "spotlight" $ ok $ w $ + it "spotlight" $ parseOk $ w $ X.light { name: "spot1", pos: 0.0 /\ 0.0 /\ 3.0, dir: 0.0 /\ 0.0 /\ (-1.0), diffuse: 1.0 /\ 1.0 /\ 1.0 } - it "directional" $ ok $ w $ + it "directional" $ parseOk $ w $ X.light { name: "sun", type: X.kw X.Directional, dir: 0.0 /\ (-1.0) /\ (-1.0), castshadow: true } describe "inertial" do - it "explicit mass + diaginertia" $ ok $ w $ + it "explicit mass + diaginertia" $ parseOk $ w $ X.body { pos: 0.0 /\ 0.0 /\ 0.0 } [ X.inertial { pos: 0.0 /\ 0.0 /\ 0.0, mass: 1.0, diaginertia: 0.01 /\ 0.01 /\ 0.01 } , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit @@ -208,7 +191,7 @@ spec = describe "composite" do it "full model" - $ ok + $ parseOk $ X.mujoco { model: "test" } [ X.compiler { angle: X.kw X.Radian, inertiafromgeom: X.true_ } , X.option { timestep: 0.002, gravity: 0.0 /\ 0.0 /\ (-9.81) } @@ -227,7 +210,7 @@ spec = ] ] - it "bodies with joints" $ ok $ w + it "bodies with joints" $ parseOk $ w [ X.light { name: "top", pos: 0.0 /\ 0.0 /\ 1.0 } , X.body {} [ X.joint { name: "v0_rx", damping: 1.0, stiffness: 10.0, axis: 1.0 /\ 0.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) } diff --git a/test/Mujoco.Wasm.purs b/test/Mujoco.Wasm.purs index f6c6615..aeaf7b5 100644 --- a/test/Mujoco.Wasm.purs +++ b/test/Mujoco.Wasm.purs @@ -1,21 +1,10 @@ module Mujoco.Wasm where -import Prelude - import Control.Promise (Promise) -import Control.Promise as Promise import Effect (Effect) -import Effect.Aff (Aff) -import Effect.Class (liftEffect) -import Mujoco.MJCF.XML as XML foreign import data Mujoco :: Type foreign import data Spec :: Type foreign import loadMujoco :: Effect (Promise Mujoco) foreign import parseXMLString :: Mujoco -> String -> Effect Spec - -renderSpec :: XML.Node -> Aff Spec -renderSpec node = do - mj <- Promise.toAffE loadMujoco - liftEffect $ parseXMLString mj $ XML.render node diff --git a/test/Mujuco.MJCF.Util.purs b/test/Mujuco.MJCF.Util.purs new file mode 100644 index 0000000..390729a --- /dev/null +++ b/test/Mujuco.MJCF.Util.purs @@ -0,0 +1,59 @@ +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.Promise as Promise +import Data.Either (isLeft) +import Data.Identity (Identity) +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.Exception (Error) +import Mujoco.MJCF as X +import Mujoco.MJCF.XML (Node) +import Mujoco.MJCF.XML as XML +import Mujoco.Wasm (Mujoco) +import Mujoco.Wasm as Mj +import Test.Assert (assertTrue) +import Test.Spec (SpecT, Spec, hoistSpec) + +newtype T a = T (ReaderT Mujoco 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 MonadEffect T +derive newtype instance MonadAff T +derive newtype instance MonadThrow Error T +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) + +runT :: forall a. T a -> Aff a +runT m = do + mj <- liftAff $ Promise.toAffE Mj.loadMujoco + runReaderT (unwrap m) mj + +renderSpec :: XML.Node -> T Mj.Spec +renderSpec node = do + mj <- ask + liftEffect $ Mj.parseXMLString mj $ XML.render node + +parseOk :: XML.Node -> T Unit +parseOk = void <<< renderSpec + +parseFail :: XML.Node -> T Unit +parseFail = (liftEffect <<< assertTrue <<< isLeft) <=< (try <<< renderSpec) + +w :: forall a. XML.Children a => a -> Node +w = X.mujoco {} <<< X.worldbody {}