more

spago.lock

@@ -6,6 +6,7 @@
         "core": {
           "dependencies": [
             "arrays",
+            "either",
             "elmish",
             "elmish-html",
             "foldable-traversable",

spago.yaml

@@ -21,6 +21,7 @@ package:
       - spec-node
   dependencies:
     - arrays
+    - either
     - elmish
     - elmish-html
     - foldable-traversable

src/Mujoco.MJCF.Actuator.purs

@@ -0,0 +1,134 @@
+module Mujoco.MJCF.Actuator where
+
+import Mujoco.Prelude
+import Mujoco.MJCF.Keyword as Kw
+
+actuator = tag @() "actuator" :: Tag ()
+
+type Interp = Kw.Zoh \/ Kw.Linear \/ Kw.Cubic
+type DynType = Kw.None \/ Kw.Integrator \/ Kw.Filter \/ Kw.FilterExact \/ Kw.Muscle \/ Kw.User
+type GainType = Kw.Fixed \/ Kw.Affine \/ Kw.Muscle \/ Kw.User
+type BiasType = Kw.None \/ Kw.Affine \/ Kw.Muscle \/ Kw.User
+
+type CommonMin r =
+  ( class :: String
+  , group :: Int
+  , delay :: Real
+  , forcelimited :: Kw.Auto \/ Boolean
+  , ctrlrange :: Real /\ Real
+  , forcerange :: Real /\ Real
+  , user :: Array Real
+  , interp :: Interp
+  , nsample :: Int
+  | Named r
+  )
+
+type Common r =
+  ( ctrllimited :: Kw.Auto \/ Boolean
+  , lengthrange :: Real /\ Real
+  , gear :: Array Real
+  , cranklength :: Real
+  , joint :: String
+  , jointinparent :: String
+  , tendon :: String
+  , cranksite :: String
+  , slidersite :: String
+  , site :: String
+  , refsite :: String
+  | CommonMin r
+  )
+
+type Props_general =
+  ( actlimited :: Kw.Auto \/ Boolean
+  , actrange :: Real /\ Real
+  , actdim :: Int
+  , dyntype :: DynType
+  , gaintype :: GainType
+  , biastype :: BiasType
+  , dynprm :: Array Real
+  , gainprm :: Array Real
+  , biasprm :: Array Real
+  , actearly :: Boolean
+  , body :: String
+  | Common ()
+  )
+general = tagNoContent @Props_general "general" :: TagNoContent Props_general
+
+type Props_adhesion =
+  ( body :: String
+  , gain :: Real
+  | CommonMin ()
+  )
+adhesion = tagNoContent @Props_adhesion "adhesion" :: TagNoContent Props_adhesion
+
+type Props_plugin =
+  ( actlimited :: Kw.Auto \/ Boolean
+  , actdim :: Int
+  , dynprm :: Array Real
+  , actearly :: Boolean
+  , actrange :: Real /\ Real
+  , dyntype :: DynType
+  , instance :: String
+  , plugin :: String
+  | Common ()
+  )
+plugin = tagNoContent @Props_plugin "plugin" :: TagNoContent Props_plugin
+
+type Props_motor = Common ()
+motor = tagNoContent @Props_motor "motor" :: TagNoContent Props_motor
+
+type Props_position =
+  ( kp :: Real
+  , kv :: Real
+  , dampratio :: Real
+  , timeconst :: Real
+  , inheritrange :: Real
+  | Common ()
+  )
+position = tagNoContent @Props_position "position" :: TagNoContent Props_position
+
+type Props_velocity =
+  ( kv :: Real
+  | Common ()
+  )
+velocity = tagNoContent @Props_velocity "velocity" :: TagNoContent Props_velocity
+
+type Props_intvelocity =
+  ( kp :: Real
+  , kv :: Real
+  , dampratio :: Real
+  , inheritrange :: Real
+  , actrange :: Real /\ Real
+  | Common ()
+  )
+intvelocity = tagNoContent @Props_intvelocity "intvelocity" :: TagNoContent Props_intvelocity
+
+type Props_damper =
+  ( kv :: Real
+  | Common ()
+  )
+damper = tagNoContent @Props_damper "damper" :: TagNoContent Props_damper
+
+type Props_cylinder =
+  ( timeconst :: Real
+  , area :: Real
+  , diameter :: Real
+  , bias :: Vec Real
+  | Common ()
+  )
+cylinder = tagNoContent @Props_cylinder "cylinder" :: TagNoContent Props_cylinder
+
+type Props_muscle =
+  ( timeconst :: Real /\ Real
+  , tausmooth :: Real
+  , range :: Real /\ Real
+  , force :: Real
+  , scale :: Real
+  , lmin :: Real
+  , lmax :: Real
+  , vmax :: Real
+  , fpmax :: Real
+  , fvmax :: Real
+  | Common ()
+  )
+muscle = tagNoContent @Props_muscle "muscle" :: TagNoContent Props_muscle

src/Mujoco.MJCF.Asset.purs

@@ -2,14 +2,11 @@ module Mujoco.MJCF.Asset where
 
 import Mujoco.Prelude
 
+import Mujoco.MJCF.Keyword as Kw
+
 asset = tag @() "asset" :: Tag ()
 
-data MeshInertia = Convex | Exact | Legacy | Shell
+type MeshInertia = Kw.Convex \/ Kw.Exact \/ Kw.Legacy \/ Kw.Shell
-instance Serialize MeshInertia where
-  serialize Convex = "convex"
-  serialize Exact = "exact"
-  serialize Legacy = "legacy"
-  serialize Shell = "shell"
 
 type Props_mesh =
   ( name :: String
@@ -43,31 +40,10 @@ type Props_hfield =
   )
 hfield = tagNoContent @Props_hfield "hfield" :: TagNoContent Props_hfield
 
-data TextureType = Texture2d | TextureCube | TextureSkybox
+type TextureType = Kw.TwoD \/ Kw.Cube \/ Kw.Skybox
-instance Serialize TextureType where
+type TextureColorspace = Kw.Auto \/ Kw.Linear \/ Kw.SRGB
-  serialize Texture2d = "2d"
+type TextureBuiltin = Kw.None \/ Kw.Gradient \/ Kw.Checker \/ Kw.Flat
-  serialize TextureCube = "cube"
+type TextureMark = Kw.None \/ Kw.Edge \/ Kw.Cross \/ Kw.Random
-  serialize TextureSkybox = "skybox"
-
-data TextureColorspace = ColorspaceAuto | ColorspaceLinear | ColorspaceSRGB
-instance Serialize TextureColorspace where
-  serialize ColorspaceAuto = "auto"
-  serialize ColorspaceLinear = "linear"
-  serialize ColorspaceSRGB = "sRGB"
-
-data TextureBuiltin = BuiltinNone | BuiltinGradient | BuiltinChecker | BuiltinFlat
-instance Serialize TextureBuiltin where
-  serialize BuiltinNone = "none"
-  serialize BuiltinGradient = "gradient"
-  serialize BuiltinChecker = "checker"
-  serialize BuiltinFlat = "flat"
-
-data TextureMark = MarkNone | MarkEdge | MarkCross | MarkRandom
-instance Serialize TextureMark where
-  serialize MarkNone = "none"
-  serialize MarkEdge = "edge"
-  serialize MarkCross = "cross"
-  serialize MarkRandom = "random"
 
 type Props_texture =
   ( name :: String
@@ -113,27 +89,7 @@ type Props_material =
   )
 material = tag @Props_material "material" :: Tag Props_material
 
-data LayerRole
+type LayerRole = Kw.Rgb \/ Kw.Normal \/ Kw.Occlusion \/ Kw.Roughness \/ Kw.Metallic \/ Kw.Opacity \/ Kw.Emissive \/ Kw.Orm \/ Kw.Rgba
-  = RoleRgb
-  | RoleNormal
-  | RoleOcclusion
-  | RoleRoughness
-  | RoleMetallic
-  | RoleOpacity
-  | RoleEmissive
-  | RoleOrm
-  | RoleRgba
-
-instance Serialize LayerRole where
-  serialize RoleRgb = "rgb"
-  serialize RoleNormal = "normal"
-  serialize RoleOcclusion = "occlusion"
-  serialize RoleRoughness = "roughness"
-  serialize RoleMetallic = "metallic"
-  serialize RoleOpacity = "opacity"
-  serialize RoleEmissive = "emissive"
-  serialize RoleOrm = "orm"
-  serialize RoleRgba = "rgba"
 
 type Props_layer =
   ( texture :: String
@@ -147,4 +103,3 @@ type Props_model =
   , content_type :: String
   )
 model = tagNoContent @Props_model "model" :: TagNoContent Props_model
-

src/Mujoco.MJCF.Body.purs

@@ -1,9 +1,9 @@
 module Mujoco.MJCF.Body
-  ( CameraMode(..)
+  ( CameraMode
-  , CameraOutput(..)
+  , CameraOutput
-  , JointType(..)
+  , JointType
-  , LightType(..)
+  , LightType
-  , Projection(..)
+  , Projection
   , Props_attach
   , Props_body
   , Props_camera
@@ -13,8 +13,8 @@ module Mujoco.MJCF.Body
   , Props_joint
   , Props_light
   , Props_site
-  , SiteType(..)
+  , SiteType
-  , SleepPolicy(..)
+  , SleepPolicy
   , attach
   , body
   , camera
@@ -32,13 +32,9 @@ module Mujoco.MJCF.Body
 import Mujoco.Prelude
 
 import Mujoco.MJCF.Geom (Props_geom, geom) as X
+import Mujoco.MJCF.Keyword as Kw
 
-data SleepPolicy = SleepAuto | SleepNever | SleepAllowed | SleepInit
+type SleepPolicy = Kw.Auto \/ Kw.Never \/ Kw.Allowed \/ Kw.Init
-instance Serialize SleepPolicy where
-  serialize SleepAuto = "auto"
-  serialize SleepNever = "never"
-  serialize SleepAllowed = "allowed"
-  serialize SleepInit = "init"
 
 type Props_body =
   ( name :: String
@@ -70,12 +66,7 @@ type Props_inertial =
   )
 inertial = tagNoContent @Props_inertial "inertial" :: TagNoContent Props_inertial
 
-data JointType = Free | Ball | Slide | Hinge
+type JointType = Kw.Free \/ Kw.Ball \/ Kw.Slide \/ Kw.Hinge
-instance Serialize JointType where
-  serialize Free = "free"
-  serialize Ball = "ball"
-  serialize Slide = "slide"
-  serialize Hinge = "hinge"
 
 type Props_joint =
   ( name :: String
@@ -91,9 +82,9 @@ type Props_joint =
   , solimpfriction :: Vec5 Real
   , stiffness :: Real
   , range :: Real /\ Real
-  , limited :: Auto \/ Boolean
+  , limited :: Kw.Auto \/ Boolean
   , actuatorfrcrange :: Real /\ Real
-  , actuatorfrclimited :: Auto \/ Boolean
+  , actuatorfrclimited :: Kw.Auto \/ Boolean
   , actuatorgravcomp :: Boolean
   , margin :: Real
   , ref :: Real
@@ -108,17 +99,11 @@ joint = tagNoContent @Props_joint "joint" :: TagNoContent Props_joint
 type Props_freejoint =
   ( name :: String
   , group :: Int
-  , align :: Auto \/ Boolean
+  , align :: Kw.Auto \/ Boolean
   )
 freejoint = tagNoContent @Props_freejoint "freejoint" :: TagNoContent Props_freejoint
 
-data SiteType = SiteSphere | SiteCapsule | SiteEllipsoid | SiteCylinder | SiteBox
+type SiteType = Kw.Sphere \/ Kw.Capsule \/ Kw.Ellipsoid \/ Kw.Cylinder \/ Kw.Box
-instance Serialize SiteType where
-  serialize SiteSphere = "sphere"
-  serialize SiteCapsule = "capsule"
-  serialize SiteEllipsoid = "ellipsoid"
-  serialize SiteCylinder = "cylinder"
-  serialize SiteBox = "box"
 
 type Props_site =
   ( name :: String
@@ -139,26 +124,9 @@ type Props_site =
   )
 site = tagNoContent @Props_site "site" :: TagNoContent Props_site
 
-data CameraMode = CamFixed | CamTrack | CamTrackcom | CamTargetbody | CamTargetbodycom
+type CameraMode = Kw.Fixed \/ Kw.Track \/ Kw.Trackcom \/ Kw.Targetbody \/ Kw.Targetbodycom
-instance Serialize CameraMode where
+type Projection = Kw.Perspective \/ Kw.Orthographic
-  serialize CamFixed = "fixed"
+type CameraOutput = Kw.Rgb \/ Kw.Depth \/ Kw.Distance \/ Kw.Normal \/ Kw.Segmentation
-  serialize CamTrack = "track"
-  serialize CamTrackcom = "trackcom"
-  serialize CamTargetbody = "targetbody"
-  serialize CamTargetbodycom = "targetbodycom"
-
-data Projection = Perspective | Orthographic
-instance Serialize Projection where
-  serialize Perspective = "perspective"
-  serialize Orthographic = "orthographic"
-
-data CameraOutput = OutputRgb | OutputDepth | OutputDistance | OutputNormal | OutputSegmentation
-instance Serialize CameraOutput where
-  serialize OutputRgb = "rgb"
-  serialize OutputDepth = "depth"
-  serialize OutputDistance = "distance"
-  serialize OutputNormal = "normal"
-  serialize OutputSegmentation = "segmentation"
 
 type Props_camera =
   ( name :: String
@@ -185,12 +153,7 @@ type Props_camera =
   )
 camera = tagNoContent @Props_camera "camera" :: TagNoContent Props_camera
 
-data LightType = LightSpot | LightDirectional | LightPoint | LightImage
+type LightType = Kw.Spot \/ Kw.Directional \/ Kw.Point \/ Kw.Image
-instance Serialize LightType where
-  serialize LightSpot = "spot"
-  serialize LightDirectional = "directional"
-  serialize LightPoint = "point"
-  serialize LightImage = "image"
 
 type Props_light =
   ( name :: String

src/Mujoco.MJCF.Common.purs

@@ -1,7 +1,15 @@
-module Mujoco.MJCF.Common where
+module Mujoco.MJCF.Common
+  ( Named
+  , Oriented
+  , Pos
+  , Real
+  , Vec
+  , Vec4
+  , Vec5
+  )
+  where
 
 import Data.Tuple.Nested (type (/\))
-import Mujoco.XML.Node.Prop (class Serialize)
 
 type Named r = (name :: String | r)
 type Pos r = (pos :: Vec Real | r)
@@ -14,10 +22,6 @@ type Oriented r =
   | r
   )
 
-data Auto = Auto
-instance Serialize Auto where
-  serialize Auto = "auto"
-
 type Real = Number
 type Vec a = a /\ a /\ a
 type Vec4 a = a /\ a /\ a /\ a

src/Mujoco.MJCF.Geom.purs

@@ -1,24 +1,7 @@
 module Mujoco.MJCF.Geom where
 
 import Mujoco.Prelude
-import Prim hiding (Type)
+import Mujoco.MJCF.Keyword as Kw
-
-data FluidShape = FluidNone | FluidEllipsoid
-instance Serialize FluidShape where
-  serialize FluidNone = "none"
-  serialize FluidEllipsoid = "ellipsoid"
-
-data Type = Plane | Hfield | Sphere | Capsule | Ellipsoid | Cylinder | Box | Mesh | Sdf
-instance Serialize Type where
-  serialize Plane = "plane"
-  serialize Hfield = "hfield"
-  serialize Sphere = "sphere"
-  serialize Capsule = "capsule"
-  serialize Ellipsoid = "ellipsoid"
-  serialize Cylinder = "cylinder"
-  serialize Box = "box"
-  serialize Mesh = "mesh"
-  serialize Sdf = "sdf"
 
 type Contact r =
   ( contype :: Int
@@ -43,7 +26,7 @@ type Solver r =
 
 type Props_geom =
     ( class :: String
-    , type :: Type
+    , type :: Kw.Plane \/ Kw.Hfield \/ Kw.Sphere \/ Kw.Capsule \/ Kw.Ellipsoid \/ Kw.Cylinder \/ Kw.Box \/ Kw.Mesh \/ Kw.Sdf
     , group :: Int
     , size :: Array Real
     , material :: String
@@ -56,7 +39,7 @@ type Props_geom =
     , hfield :: String
     , mesh :: String
     , fitscale :: Real
-    , fluidshape :: FluidShape
+    , fluidshape :: Kw.None \/ Kw.Ellipsoid
     , fluidcoef :: Vec5 Real
     , user :: Array Real
     | Named

src/Mujoco.MJCF.Keyword.purs

@@ -0,0 +1,256 @@
+module Mujoco.MJCF.Keyword where
+
+import Data.Either.Inject (class Inject, inj)
+import Mujoco.XML.Node.Prop (class Serialize)
+
+kw :: forall kw sum. Inject kw sum => kw -> sum
+kw = inj
+
+true_ :: forall sum. Inject Boolean sum => sum
+true_ = inj true
+
+false_ :: forall sum. Inject Boolean sum => sum
+false_ = inj false
+
+data None = None
+instance Serialize None where serialize None = "none"
+
+data Integrator = Integrator
+instance Serialize Integrator where serialize Integrator = "integrator"
+
+data Filter = Filter
+instance Serialize Filter where serialize Filter = "filter"
+
+data FilterExact = FilterExact
+instance Serialize FilterExact where serialize FilterExact = "filterexact"
+
+data Muscle = Muscle
+instance Serialize Muscle where serialize Muscle = "muscle"
+
+data User = User
+instance Serialize User where serialize User = "user"
+
+data Fixed = Fixed
+instance Serialize Fixed where serialize Fixed = "fixed"
+
+data Affine = Affine
+instance Serialize Affine where serialize Affine = "affine"
+
+data Zoh = Zoh
+instance Serialize Zoh where serialize Zoh = "zoh"
+
+data Linear = Linear
+instance Serialize Linear where serialize Linear = "linear"
+
+data Cubic = Cubic
+instance Serialize Cubic where serialize Cubic = "cubic"
+
+data Convex = Convex
+instance Serialize Convex where serialize Convex = "convex"
+
+data Exact = Exact
+instance Serialize Exact where serialize Exact = "exact"
+
+data Legacy = Legacy
+instance Serialize Legacy where serialize Legacy = "legacy"
+
+data Shell = Shell
+instance Serialize Shell where serialize Shell = "shell"
+
+data TwoD = TwoD
+instance Serialize TwoD where serialize TwoD = "2d"
+
+data Cube = Cube
+instance Serialize Cube where serialize Cube = "cube"
+
+data Skybox = Skybox
+instance Serialize Skybox where serialize Skybox = "skybox"
+
+data SRGB = SRGB
+instance Serialize SRGB where serialize SRGB = "sRGB"
+
+data Gradient = Gradient
+instance Serialize Gradient where serialize Gradient = "gradient"
+
+data Checker = Checker
+instance Serialize Checker where serialize Checker = "checker"
+
+data Flat = Flat
+instance Serialize Flat where serialize Flat = "flat"
+
+data Edge = Edge
+instance Serialize Edge where serialize Edge = "edge"
+
+data Cross = Cross
+instance Serialize Cross where serialize Cross = "cross"
+
+data Random = Random
+instance Serialize Random where serialize Random = "random"
+
+data Rgb = Rgb
+instance Serialize Rgb where serialize Rgb = "rgb"
+
+data Normal = Normal
+instance Serialize Normal where serialize Normal = "normal"
+
+data Occlusion = Occlusion
+instance Serialize Occlusion where serialize Occlusion = "occlusion"
+
+data Roughness = Roughness
+instance Serialize Roughness where serialize Roughness = "roughness"
+
+data Metallic = Metallic
+instance Serialize Metallic where serialize Metallic = "metallic"
+
+data Opacity = Opacity
+instance Serialize Opacity where serialize Opacity = "opacity"
+
+data Emissive = Emissive
+instance Serialize Emissive where serialize Emissive = "emissive"
+
+data Orm = Orm
+instance Serialize Orm where serialize Orm = "orm"
+
+data Rgba = Rgba
+instance Serialize Rgba where serialize Rgba = "rgba"
+
+data Auto = Auto
+instance Serialize Auto where serialize Auto = "auto"
+
+data Never = Never
+instance Serialize Never where serialize Never = "never"
+
+data Allowed = Allowed
+instance Serialize Allowed where serialize Allowed = "allowed"
+
+data Init = Init
+instance Serialize Init where serialize Init = "init"
+
+data Free = Free
+instance Serialize Free where serialize Free = "free"
+
+data Ball = Ball
+instance Serialize Ball where serialize Ball = "ball"
+
+data Slide = Slide
+instance Serialize Slide where serialize Slide = "slide"
+
+data Hinge = Hinge
+instance Serialize Hinge where serialize Hinge = "hinge"
+
+data Sphere = Sphere
+instance Serialize Sphere where serialize Sphere = "sphere"
+
+data Capsule = Capsule
+instance Serialize Capsule where serialize Capsule = "capsule"
+
+data Ellipsoid = Ellipsoid
+instance Serialize Ellipsoid where serialize Ellipsoid = "ellipsoid"
+
+data Cylinder = Cylinder
+instance Serialize Cylinder where serialize Cylinder = "cylinder"
+
+data Box = Box
+instance Serialize Box where serialize Box = "box"
+
+data Track = Track
+instance Serialize Track where serialize Track = "track"
+
+data Trackcom = Trackcom
+instance Serialize Trackcom where serialize Trackcom = "trackcom"
+
+data Targetbody = Targetbody
+instance Serialize Targetbody where serialize Targetbody = "targetbody"
+
+data Targetbodycom = Targetbodycom
+instance Serialize Targetbodycom where serialize Targetbodycom = "targetbodycom"
+
+data Perspective = Perspective
+instance Serialize Perspective where serialize Perspective = "perspective"
+
+data Orthographic = Orthographic
+instance Serialize Orthographic where serialize Orthographic = "orthographic"
+
+data Depth = Depth
+instance Serialize Depth where serialize Depth = "depth"
+
+data Distance = Distance
+instance Serialize Distance where serialize Distance = "distance"
+
+data Segmentation = Segmentation
+instance Serialize Segmentation where serialize Segmentation = "segmentation"
+
+data Spot = Spot
+instance Serialize Spot where serialize Spot = "spot"
+
+data Directional = Directional
+instance Serialize Directional where serialize Directional = "directional"
+
+data Point = Point
+instance Serialize Point where serialize Point = "point"
+
+data Image = Image
+instance Serialize Image where serialize Image = "image"
+
+data Plane = Plane
+instance Serialize Plane where serialize Plane = "plane"
+
+data Hfield = Hfield
+instance Serialize Hfield where serialize Hfield = "hfield"
+
+data Mesh = Mesh
+instance Serialize Mesh where serialize Mesh = "mesh"
+
+data Sdf = Sdf
+instance Serialize Sdf where serialize Sdf = "sdf"
+
+data Euler = Euler
+instance Serialize Euler where serialize Euler = "Euler"
+
+data RK4 = RK4
+instance Serialize RK4 where serialize RK4 = "RK4"
+
+data Implicit = Implicit
+instance Serialize Implicit where serialize Implicit = "implicit"
+
+data ImplicitFast = ImplicitFast
+instance Serialize ImplicitFast where serialize ImplicitFast = "implicitfast"
+
+data Pyramidal = Pyramidal
+instance Serialize Pyramidal where serialize Pyramidal = "pyramidal"
+
+data Elliptic = Elliptic
+instance Serialize Elliptic where serialize Elliptic = "elliptic"
+
+data Dense = Dense
+instance Serialize Dense where serialize Dense = "dense"
+
+data Sparse = Sparse
+instance Serialize Sparse where serialize Sparse = "sparse"
+
+data PGS = PGS
+instance Serialize PGS where serialize PGS = "PGS"
+
+data CG = CG
+instance Serialize CG where serialize CG = "CG"
+
+data Newton = Newton
+instance Serialize Newton where serialize Newton = "Newton"
+
+data Enable = Enable
+instance Serialize Enable where serialize Enable = "enable"
+
+data Disable = Disable
+instance Serialize Disable where serialize Disable = "disable"
+
+data Local = Local
+instance Serialize Local where serialize Local = "local"
+
+data Global = Global
+instance Serialize Global where serialize Global = "global"
+
+data Radian = Radian
+instance Serialize Radian where serialize Radian = "radian"
+
+data Degree = Degree
+instance Serialize Degree where serialize Degree = "degree"

src/Mujoco.MJCF.Tendon.purs

@@ -2,10 +2,12 @@ module Mujoco.MJCF.Tendon where
 
 import Mujoco.Prelude
 
+import Mujoco.MJCF.Keyword as Kw
+
 type Common r =
   ( class :: String
   , group :: Int
-  , limited :: Auto \/ Boolean
+  , limited :: Kw.Auto \/ Boolean
   , range :: Real /\ Real
   , solimplimit :: Vec5 Real
   , solimpfriction :: Vec5 Real
@@ -22,7 +24,7 @@ type Common r =
 
 type Props_spatial =
   ( actuatorfrcrange :: Real /\ Real
-  , actuatorfrclimited :: Auto \/ Boolean
+  , actuatorfrclimited :: Kw.Auto \/ Boolean
   , width :: Real
   , material :: String
   , rgba :: Vec4 Real

src/Mujoco.MJCF.purs

@@ -1,11 +1,10 @@
 module Mujoco.MJCF
-  ( Angle(..)
+  ( Angle
-  , Cone(..)
+  , Cone
-  , Coordinate(..)
+  , Coordinate
-  , Enable(..)
+  , EnableDisable
-  , InertiaFromGeom(..)
+  , InertiaFromGeom
-  , Integrator(..)
+  , Jacobian
-  , Jacobian(..)
   , Props_compiler
   , Props_flag
   , Props_option
@@ -13,7 +12,7 @@ module Mujoco.MJCF
   , Props_mujoco
   , Props_statistic
   , Props_plugin
-  , Solver(..)
+  , Solver
   , plugin
   , compiler
   , flag
@@ -27,58 +26,24 @@ module Mujoco.MJCF
 
 import Mujoco.Prelude
 
+import Mujoco.MJCF.Keyword as Kw
+import Mujoco.MJCF.Keyword as X
 import Mujoco.MJCF.Asset as X
 import Mujoco.MJCF.Body as X
-import Mujoco.MJCF.Common (Auto(..)) as X
+import Mujoco.MJCF.Common as X
 import Mujoco.MJCF.Contact as X
 import Mujoco.XML.Node (empty, text, fragment) as X
 
 type Props_mujoco = (model :: String)
 mujoco = tag @Props_mujoco "mujoco" :: Tag Props_mujoco
 
-data Integrator = Euler | RK4 | Implicit | ImplicitFast
+type Cone = Kw.Pyramidal \/ Kw.Elliptic
-instance Serialize Integrator where
+type Jacobian = Kw.Dense \/ Kw.Sparse
-  serialize Euler = "Euler"
+type Solver = Kw.PGS \/ Kw.CG \/ Kw.Newton
-  serialize RK4 = "RK4"
+type EnableDisable = Kw.Enable \/ Kw.Disable
-  serialize Implicit = "implicit"
+type Coordinate = Kw.Local \/ Kw.Global
-  serialize ImplicitFast = "implicitfast"
+type Angle = Kw.Radian \/ Kw.Degree
-
+type InertiaFromGeom = Kw.Auto \/ Boolean
-data Cone = Pyramidal | Elliptic
-instance Serialize Cone where
-  serialize Pyramidal = "pyramidal"
-  serialize Elliptic = "elliptic"
-
-data Jacobian = Dense | Sparse
-instance Serialize Jacobian where
-  serialize Dense = "dense"
-  serialize Sparse = "sparse"
-
-data Solver = PGS | CG | Newton
-instance Serialize Solver where
-  serialize PGS = "PGS"
-  serialize CG = "CG"
-  serialize Newton = "Newton"
-
-data Enable = Disable | Enable
-instance Serialize Enable where
-  serialize Enable = "enable"
-  serialize Disable = "disable"
-
-data Coordinate = Local | Global
-instance Serialize Coordinate where
-  serialize Local = "local"
-  serialize Global = "global"
-
-data Angle = Radian | Degree
-instance Serialize Angle where
-  serialize Radian = "radian"
-  serialize Degree = "degree"
-
-data InertiaFromGeom = InertiaFromGeomFalse | InertiaFromGeomTrue | InertiaFromGeomAuto
-instance Serialize InertiaFromGeom where
-  serialize InertiaFromGeomFalse = "false"
-  serialize InertiaFromGeomTrue = "true"
-  serialize InertiaFromGeomAuto = "auto"
 
 type Props_option =
   ( timestep :: Real
@@ -91,7 +56,7 @@ type Props_option =
   , o_margin :: Real
   , o_solref :: Real /\ Real
   , o_solimp :: Vec5 Real
-  , integrator :: Integrator
+  , integrator :: Kw.Euler \/ Kw.RK4 \/ Kw.Implicit \/ Kw.ImplicitFast
   , cone :: Cone
   , jacobian :: Jacobian
   , iterations :: Int
@@ -110,31 +75,31 @@ type Props_option =
 option = tag @Props_option "mjcf:option" :: Tag Props_option
 
 type Props_flag =
-  ( constraint :: Enable
+  ( constraint :: EnableDisable
-  , equality :: Enable
+  , equality :: EnableDisable
-  , frictionloss :: Enable
+  , frictionloss :: EnableDisable
-  , limit :: Enable
+  , limit :: EnableDisable
-  , contact :: Enable
+  , contact :: EnableDisable
-  , spring :: Enable
+  , spring :: EnableDisable
-  , damper :: Enable
+  , damper :: EnableDisable
-  , gravity :: Enable
+  , gravity :: EnableDisable
-  , clampctrl :: Enable
+  , clampctrl :: EnableDisable
-  , warmstart :: Enable
+  , warmstart :: EnableDisable
-  , filterparent :: Enable
+  , filterparent :: EnableDisable
-  , actuation :: Enable
+  , actuation :: EnableDisable
-  , refsafe :: Enable
+  , refsafe :: EnableDisable
-  , sensor :: Enable
+  , sensor :: EnableDisable
-  , midphase :: Enable
+  , midphase :: EnableDisable
-  , nativeccd :: Enable
+  , nativeccd :: EnableDisable
-  , island :: Enable
+  , island :: EnableDisable
-  , eulerdamp :: Enable
+  , eulerdamp :: EnableDisable
-  , autoreset :: Enable
+  , autoreset :: EnableDisable
-  , override :: Enable
+  , override :: EnableDisable
-  , energy :: Enable
+  , energy :: EnableDisable
-  , fwdinv :: Enable
+  , fwdinv :: EnableDisable
-  , invdiscrete :: Enable
+  , invdiscrete :: EnableDisable
-  , multiccd :: Enable
+  , multiccd :: EnableDisable
-  , sleep :: Enable
+  , sleep :: EnableDisable
   )
 flag = tagNoContent @Props_flag "flag" :: TagNoContent Props_flag
 

test/Mujoco.MJCF.purs

@@ -38,17 +38,17 @@ spec =
         ]
 
       it "angle=radian" $ ok $ X.mujoco {}
-        [ X.compiler { angle: X.Radian }
+        [ X.compiler { angle: X.kw X.Radian }
         , X.worldbody {} unit
         ]
 
       it "autolimits + coordinate" $ ok $ X.mujoco {}
-        [ X.compiler { autolimits: true, coordinate: X.Local }
+        [ X.compiler { autolimits: true, coordinate: X.kw X.Local }
         , X.worldbody {} unit
         ]
 
       it "inertiafromgeom=auto" $ ok $ X.mujoco {}
-        [ X.compiler { inertiafromgeom: X.InertiaFromGeomAuto }
+        [ X.compiler { inertiafromgeom: X.kw X.Auto }
         , X.worldbody {} unit
         ]
 
@@ -75,12 +75,12 @@ spec =
 
     describe "option" do
       it "timestep + integrator" $ ok $ X.mujoco {}
-        [ X.option { timestep: 0.001, integrator: X.RK4 } unit
+        [ X.option { timestep: 0.001, integrator: X.kw 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.option { gravity: 0.0 /\ 0.0 /\ (-9.81), solver: X.kw X.Newton } unit
         , X.worldbody {} unit
         ]
 
@@ -110,8 +110,8 @@ spec =
           [ X.asset {}
               [ X.texture
                   { name: "grid"
-                  , type: X.Texture2d
+                  , type: X.kw X.TwoD
-                  , builtin: X.BuiltinChecker
+                  , builtin: X.kw X.Checker
                   , width: 512
                   , height: 512
                   , rgb1: 0.9 /\ 0.9 /\ 0.9
@@ -132,53 +132,53 @@ spec =
       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.joint { type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 }
-            , X.geom { type: X.G.Sphere, size: [0.1, 0.0, 0.0] } unit
+            , X.geom { type: X.kw X.Sphere, 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.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.G.Box, size: [0.1, 0.1, 0.1] } unit
+            , X.geom { type: X.kw X.Box, 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.joint { type: X.kw X.Hinge, stiffness: 100.0, damping: 10.0, armature: 0.1 }
-            , X.geom { type: X.G.Sphere, size: [0.05, 0.0, 0.0] } unit
+            , X.geom { type: X.kw X.Sphere, 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.G.Sphere, size: [0.1, 0.0, 0.0] } unit
+            , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit
             ]
 
       describe "geom" do
         it "sphere" $ ok $ w $
-          X.geom { type: X.G.Sphere, size: [1.0, 0.0, 0.0] } unit
+          X.geom { type: X.kw X.Sphere, size: [1.0, 0.0, 0.0] } unit
 
         it "capsule fromto" $ ok $ w $
-          X.geom { type: X.G.Capsule, fromto: [0.0, 0.0, 0.0, 0.0, 0.0, 1.0], size: [0.05, 0.0, 0.0] } unit
+          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 {}
           [ X.asset {}
               [ X.material { name: "red", rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0 } unit ]
           , X.worldbody {} $
-              X.geom { type: X.G.Box, size: [0.5, 0.5, 0.5], material: "red" } unit
+              X.geom { type: X.kw X.Box, size: [0.5, 0.5, 0.5], material: "red" } unit
           ]
 
         it "plane" $ ok $ w $
-          X.geom { type: X.G.Plane, size: [5.0, 5.0, 0.1] } unit
+          X.geom { type: X.kw X.Plane, size: [5.0, 5.0, 0.1] } unit
 
         it "friction + density" $ ok $ w $
-          X.geom { type: X.G.Sphere, size: [0.1, 0.0, 0.0], friction: 0.5 /\ 0.005 /\ 0.0001, density: 500.0 } unit
+          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 $
           X.body { pos: 0.0 /\ 0.0 /\ 0.0 }
-            [ X.geom { type: X.G.Sphere, size: [0.1, 0.0, 0.0] } unit
+            [ 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 }
             ]
 
@@ -188,8 +188,8 @@ spec =
 
         it "tracking" $ ok $ w $
           X.body { name: "target_body", pos: 0.0 /\ 0.0 /\ 0.5 }
-            [ X.geom { type: X.G.Sphere, size: [0.1, 0.0, 0.0] } unit
+            [ X.geom { type: X.kw X.Sphere, 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 }
+            , X.camera { name: "tracker", mode: X.kw X.Targetbody, target: "target_body", pos: 1.0 /\ 0.0 /\ 0.5 }
             ]
 
       describe "light" do
@@ -197,32 +197,32 @@ spec =
           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 }
+          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 $
           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.G.Sphere, size: [0.1, 0.0, 0.0] } unit
+            , X.geom { type: X.kw X.Sphere, 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.compiler { angle: X.kw X.Radian, inertiafromgeom: X.true_ }
             , X.option { timestep: 0.002, gravity: 0.0 /\ 0.0 /\ (-9.81) }
-                [ X.flag { contact: X.Enable } ]
+                [ X.flag { contact: X.kw 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.texture { name: "grid", type: X.kw X.TwoD, builtin: X.kw X.Checker, 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.G.Plane, size: [5.0, 5.0, 0.1], material: "floor_mat" } unit
+                [ X.geom { type: X.kw X.Plane, 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.G.Sphere, size: [0.1, 0.0, 0.0], rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0 } unit
+                    , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0], rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0 } unit
                     ]
                 ]
             ]
@@ -232,19 +232,19 @@ spec =
         , 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) }
           , X.joint { name: "v0_ry", damping: 1.0, stiffness: 10.0, axis: 0.0 /\ 1.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) }
-          , X.geom { type: X.G.Cylinder, size: [1.0, 0.05] } unit
+          , X.geom { type: X.kw X.Cylinder, size: [1.0, 0.05] } unit
           , X.body { pos: zero /\ zero /\ 0.51 }
             [ X.joint { name: "b0a_rx", damping: 1.0, stiffness: 10.0, axis: 1.0 /\ 0.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) }
             , X.joint { name: "b0a_ry", damping: 1.0, stiffness: 10.0, axis: 0.0 /\ 1.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) }
-            , X.geom { type: X.G.Cylinder, size: [0.05, 0.5] } unit
+            , X.geom { type: X.kw X.Cylinder, size: [0.05, 0.5] } unit
             , X.body { pos: zero /\ zero /\ one }
               [ X.joint { name: "b0b_rx", damping: 1.0, stiffness: 10.0, axis: 1.0 /\ 0.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) }
               , X.joint { name: "b0b_ry", damping: 1.0, stiffness: 10.0, axis: 0.0 /\ 1.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) }
-              , X.geom { type: X.G.Cylinder, size: [0.05, 0.5] } unit
+              , X.geom { type: X.kw X.Cylinder, size: [0.05, 0.5] } unit
               , X.body { pos: zero /\ zero /\ 0.5 }
                 [ X.joint { name: "v1_rx", damping: 1.0, stiffness: 10.0, axis: 1.0 /\ 0.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) }
                 , X.joint { name: "v1_ry", damping: 1.0, stiffness: 10.0, axis: 0.0 /\ 1.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) }
-                , X.geom { type: X.G.Cylinder, size: [1.0, 0.05] } unit
+                , X.geom { type: X.kw X.Cylinder, size: [1.0, 0.05] } unit
                 ]
               ]
             ]