orion/purescript-mujoco-mjcf
1
0
Fork 0
generated from tpl/purs
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

test

Browse Source
This commit is contained in:
orion kindel
2026-02-20 14:47:29 -06:00
parent 8b7ad814fd
commit 442351f47d
7 changed files with 240 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
spago.lock
View File

@@ -8,10 +8,13 @@
"arrays",
"elmish",
"elmish-html",
"foldable-traversable",
"integers",
"maybe",
"numbers",
"ordered-collections",
"prelude",
"strings",
"tuples",
"typelevel-prelude",
"unsafe-coerce"

3
spago.yaml
View File

@@ -23,10 +23,13 @@ package:
- arrays
- elmish
- elmish-html
- foldable-traversable
- integers
- maybe
- numbers
- ordered-collections
- prelude
- strings
- tuples
- typelevel-prelude
- unsafe-coerce

7
src/Mujoco.MJCF.purs
View File

@@ -56,8 +56,8 @@ instance Serialize Solver where
data Enable = Disable | Enable
instance Serialize Enable where
serialize Enable = "Enable"
serialize Disable = "Disable"
serialize Enable = "enable"
serialize Disable = "disable"
data Coordinate = Local | Global
instance Serialize Coordinate where
@@ -100,6 +100,7 @@ type Props_option =
, sdf_iterations :: Int
, sdf_initpoints :: Int
, actuatorgroupdisable :: Array Int
, solver :: Solver
)
option = tag @Props_option "option" :: Tag Props_option
@@ -130,7 +131,7 @@ type Props_flag =
, multiccd :: Enable
, sleep :: Enable
)
flag = tag @Props_flag "flag" :: Tag Props_flag
flag = tagNoContent @Props_flag "flag" :: TagNoContent Props_flag
type Props_compiler =
( autolimits :: Boolean

21
src/Mujoco.XML.Node.Prop.purs
View File

@@ -1,12 +1,16 @@
module Mujoco.XML.Node.Prop (class Serialize, serialize, serializeProps, class SerializeProps', serializeProps') where
module Mujoco.XML.Node.Prop (class Serialize, serialize, serializeProps, class SerializeProps', serializeProps', renames, unrenames) where
import Prelude
import Data.Array as Array
import Data.Int as Int
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Number.Format (toString) as Number
import Data.Symbol (class IsSymbol, reflectSymbol)
import Data.Tuple (Tuple)
import Data.Tuple as Tuple
import Data.Tuple.Nested ((/\))
import Prim.Row (class Cons, class Union)
import Prim.RowList (class RowToList, RowList)
@@ -15,6 +19,12 @@ import Record.Unsafe (unsafeSet, unsafeHas, unsafeGet) as Record
import Type.Prelude (Proxy(..))
import Unsafe.Coerce (unsafeCoerce)
renames :: Map String String
renames = Map.fromFoldable ["size" /\ "mjcf:size"]
unrenames :: Map String String
unrenames = Map.fromFoldable $ map Tuple.swap $ (Map.toUnfoldable renames :: Array _)
class Serialize a where
serialize :: a -> String
@@ -60,11 +70,14 @@ instance SerializeProps' () RL.Nil where
patchUnsafe :: forall (@k :: Symbol) a b @r @lacksK. IsSymbol k => Cons k a lacksK r => (a -> b) -> Record r -> Record r
patchUnsafe f r =
let
k = reflectSymbol $ Proxy @k
k' = reflectSymbol $ Proxy @k
k = fromMaybe k' $ Map.lookup k' renames
btoa = unsafeCoerce :: b -> a
in
if Record.unsafeHas k r then
Record.unsafeSet k (btoa $ f $ Record.unsafeGet k r) r
if Record.unsafeHas k' r then
Record.unsafeSet k (btoa $ f $ Record.unsafeGet k' r) r
else
r

18
src/Mujoco.XML.Node.purs
View File

@@ -14,11 +14,13 @@ module Mujoco.XML.Node
import Prelude
import Data.FoldableWithIndex (foldlWithIndex)
import Data.String as String
import Elmish.HTML (empty, fragment, text) as HTML
import Elmish.HTML.Internal (tag, tagNoContent) as HTML
import Elmish.React (ReactElement)
import Elmish.React as React
import Mujoco.XML.Node.Prop (class SerializeProps', serializeProps)
import Mujoco.XML.Node.Prop as Prop
import Prim.Row (class Union)
import Prim.RowList (class RowToList)
import Unsafe.Coerce (unsafeCoerce)
@@ -29,7 +31,6 @@ type Tag props
= forall r missing a propsrl
. Children a
=> Union r missing props
=> React.ValidReactProps (Record r)
=> RowToList props propsrl
=> SerializeProps' props propsrl
=> Record r
@@ -39,7 +40,6 @@ type Tag props
type TagNoContent props
= forall r missing propsrl
. Union r missing props
=> React.ValidReactProps (Record r)
=> RowToList props propsrl
=> SerializeProps' props propsrl
=> Record r
@@ -48,7 +48,15 @@ type TagNoContent props
foreign import data Node :: Type
render :: Node -> String
render = renderToString <<< toReact
render =
let
unrenameProps str =
foldlWithIndex unrenameProp str Prop.unrenames
unrenameProp from str to =
String.replaceAll (String.Pattern from) (String.Replacement to) str
in
unrenameProps <<< renderToString <<< toReact
fromReact :: ReactElement -> Node
fromReact = unsafeCoerce
@@ -64,7 +72,6 @@ tag
-> ( forall r missing a.
Union r missing props
=> Children a
=> React.ValidReactProps (Record r)
=> Record r
-> a
-> Node
@@ -78,7 +85,6 @@ tagNoContent
=> String
-> ( forall r missing.
Union r missing props
=> React.ValidReactProps (Record r)
=> Record r
-> Node
)

200
test/Mujoco.MJCF.purs
View File

@@ -4,6 +4,7 @@ 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
@@ -18,9 +19,208 @@ ok = void <<< renderSpec
fail :: Node -> Aff Unit
fail = (liftEffect <<< assertTrue <<< isLeft) <=< (try <<< renderSpec)
w :: Node -> Node
w = X.mujoco {} <<< X.worldbody {}
spec :: Spec Unit
spec =
describe "MJCF" do
it "</>" $ fail $ X.empty
it "<mujoco>" $ ok $ X.mujoco {} unit
it "<worldbody>" $ ok $ X.mujoco {} $ X.worldbody {} unit
describe "compiler" do
it "empty" $ ok $ X.mujoco {}
[ X.compiler {}
, X.worldbody {} unit
]
it "angle=radian" $ ok $ X.mujoco {}
[ X.compiler { angle: X.Radian }
, X.worldbody {} unit
]
it "autolimits + coordinate" $ ok $ X.mujoco {}
[ X.compiler { autolimits: true, coordinate: X.Local }
, X.worldbody {} unit
]
it "inertiafromgeom=auto" $ ok $ X.mujoco {}
[ X.compiler { inertiafromgeom: X.InertiaFromGeomAuto }
, X.worldbody {} unit
]
it "boundmass + boundinertia" $ ok $ X.mujoco {}
[ X.compiler { boundmass: 0.01, boundinertia: 0.001 }
, X.worldbody {} unit
]
describe "size" do
it "empty" $ ok $ X.mujoco {}
[ X.size {}
, X.worldbody {} unit
]
it "memory" $ ok $ X.mujoco {}
[ X.size { memory: "16M" }
, X.worldbody {} unit
]
it "nuser fields" $ ok $ 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 {}
[ X.option { timestep: 0.001, integrator: X.RK4 } unit
, X.worldbody {} unit
]
it "gravity + solver" $ ok $ X.mujoco {}
[ X.option { gravity: 0.0 /\ 0.0 /\ (-9.81), solver: X.Newton } unit
, X.worldbody {} unit
]
describe "statistic" do
it "extent + center" $ ok $ 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 {}
[ 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 {}
[ 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 {}
[ X.asset {}
[ X.texture
{ name: "grid"
, type: X.Texture2d
, builtin: X.BuiltinChecker
, width: 512
, height: 512
, rgb1: 0.9 /\ 0.9 /\ 0.9
, rgb2: 0.1 /\ 0.1 /\ 0.1
}
]
, X.worldbody {} unit
]
describe "material" do
it "rgba + specular" $ ok $ X.mujoco {}
[ X.asset {}
[ X.material { name: "mat1", rgba: 0.8 /\ 0.2 /\ 0.2 /\ 1.0, specular: 0.8 } unit ]
, X.worldbody {} unit
]
describe "body" do
describe "joint" do
it "hinge" $ ok $ w $
X.body { name: "b1", pos: 0.0 /\ 0.0 /\ 0.5 }
[ X.joint { type: X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 }
, X.geom { type: X.GSphere, size: 0.1 /\ 0.0 /\ 0.0 } unit
]
it "slide with range" $ ok $ w $
X.body { name: "slider", pos: 0.0 /\ 0.0 /\ 1.0 }
[ X.joint { type: X.Slide, axis: 0.0 /\ 0.0 /\ 1.0, range: (-1.0) /\ 1.0, limited: X.AutoBoolTrue }
, X.geom { type: X.GBox, size: 0.1 /\ 0.1 /\ 0.1 } unit
]
it "stiffness + damping" $ ok $ w $
X.body { pos: 0.0 /\ 0.0 /\ 0.0 }
[ X.joint { type: X.Hinge, stiffness: 100.0, damping: 10.0, armature: 0.1 }
, X.geom { type: X.GSphere, size: 0.05 /\ 0.0 /\ 0.0 } unit
]
describe "freejoint" do
it "basic" $ ok $ w $
X.body { name: "free_body", pos: 0.0 /\ 0.0 /\ 1.0 }
[ X.freejoint { name: "fj" }
, X.geom { type: X.GSphere, size: 0.1 /\ 0.0 /\ 0.0 } unit
]
describe "geom" do
it "sphere" $ ok $ w $
X.geom { type: X.GSphere, size: 1.0 /\ 0.0 /\ 0.0 } unit
it "capsule fromto" $ ok $ w $
X.geom { type: X.GCapsule, 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 {}
[ X.asset {}
[ X.material { name: "red", rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0 } unit ]
, X.worldbody {} $
X.geom { type: X.GBox, size: 0.5 /\ 0.5 /\ 0.5, material: "red" } unit
]
it "plane" $ ok $ w $
X.geom { type: X.GPlane, size: 5.0 /\ 5.0 /\ 0.1 } unit
it "friction + density" $ ok $ w $
X.geom { type: X.GSphere, 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 $
X.body { pos: 0.0 /\ 0.0 /\ 0.0 }
[ X.geom { type: X.GSphere, 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 $
X.camera { name: "cam1", pos: 0.0 /\ (-2.0) /\ 1.0, fovy: 60.0 }
it "tracking" $ ok $ w $
X.body { name: "target_body", pos: 0.0 /\ 0.0 /\ 0.5 }
[ X.geom { type: X.GSphere, size: 0.1 /\ 0.0 /\ 0.0 } unit
, X.camera { name: "tracker", mode: X.CamTargetbody, target: "target_body", pos: 1.0 /\ 0.0 /\ 0.5 }
]
describe "light" do
it "spotlight" $ ok $ 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 $
X.light { name: "sun", type: X.LightDirectional, dir: 0.0 /\ (-1.0) /\ (-1.0), castshadow: true }
describe "inertial" do
it "explicit mass + diaginertia" $ ok $ 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.GSphere, size: 0.1 /\ 0.0 /\ 0.0 } unit
]
describe "composite" do
it "full model"
$ ok
$ X.mujoco { model: "test" }
[ X.compiler { angle: X.Radian, inertiafromgeom: X.InertiaFromGeomTrue }
, X.option { timestep: 0.002, gravity: 0.0 /\ 0.0 /\ (-9.81) }
[ X.flag { contact: X.Enable } ]
, X.asset {}
[ X.texture { name: "grid", type: X.Texture2d, builtin: X.BuiltinChecker, width: 256, height: 256, rgb1: 0.9 /\ 0.9 /\ 0.9, rgb2: 0.1 /\ 0.1 /\ 0.1 }
, X.material { name: "floor_mat", texture: "grid", texrepeat: 5.0 /\ 5.0 } unit
]
, X.worldbody {}
[ X.geom { type: X.GPlane, size: 5.0 /\ 5.0 /\ 0.1, material: "floor_mat" } unit
, X.light { name: "top", pos: 0.0 /\ 0.0 /\ 3.0, dir: 0.0 /\ 0.0 /\ (-1.0) }
, X.body { name: "ball", pos: 0.0 /\ 0.0 /\ 1.0 }
[ X.freejoint {}
, X.geom { type: X.GSphere, size: 0.1 /\ 0.0 /\ 0.0, rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0 } unit
]
]
]

1
test/Mujoco.XML.Node.Prop.purs
View File

@@ -33,6 +33,7 @@ spec =
it "serializes number array" $ serialize [1.0, 2.0] `shouldEqual` "1 2"
it "serializes tuple" $ serialize (1 /\ 2) `shouldEqual` "1 2"
it "serializes nested tuple" $ serialize (1 /\ 2 /\ 3) `shouldEqual` "1 2 3"
it "serializes real(4)" $ serialize (1.0 /\ 1.0 /\ 0.5 /\ 0.1) `shouldEqual` "1 1 0.5 0.1"
describe "SerializeProps" do
let