initial commit

package.json

@@ -4,12 +4,13 @@
   "module": "index.js",
   "type": "module",
   "scripts": {
-    "fmt": "bun bun/fmt.js"
+    "fmt": "bun bun/fmt.js",
+    "spago": "spago"
   },
   "devDependencies": {
     "bun-types": "1.0.11",
     "purs-tidy": "^0.10.0",
-    "spago": "next"
+    "spago": "^1.0.0"
   },
   "peerDependencies": {
     "typescript": "^5.0.0"

spago.yaml

@@ -1,24 +1,33 @@
 package:
+  name: mujoco-mjcf
+  publish:
+    version: '0.0.1'
+    license: 'GPL-3.0-or-later'
+    location:
+      githubOwner: 'cakekindel'
+      githubRepo: 'purescript-mujoco-mjcf'
   build:
+    censorProjectWarnings:
+      - 'ImplicitQualifiedImport'
+      - 'ImplicitQualifiedImportReExport'
     strict: true
-    pedantic_packages: true
+    pedanticPackages: true
+  test:
+    main: Test.Main
     dependencies:
+      - spec
+      - spec-node
+  dependencies:
+    - arrays
+    - elmish
+    - elmish-html
+    - integers
+    - numbers
     - prelude
-    - aff
-    - effect
-    - either
-    - maybe
-    - foldable-traversable
-    - console
-    - newtype
-    - strings
-    - stringutils
-    - transformers
     - tuples
     - typelevel-prelude
-  name: project
+    - unsafe-coerce
 workspace:
-  extra_packages: {}
-  package_set:
-    url: https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.10-20230930/packages.json
-    hash: sha256-nTsd44o7/hrTdk0c6dh0wyBqhFFDJJIeKdQU6L1zv/A=
+  extraPackages: {}
+  packageSet:
+    registry: 73.2.0

src/Main.purs

@@ -1,7 +0,0 @@
-module Main where
-
-import Prelude
-import Effect (Effect)
-
-main :: Effect Unit
-main = pure unit

src/Mujoco.XML.Node.Prop.purs

@@ -0,0 +1,75 @@
+module Mujoco.XML.Node.Prop (class Serialize, serialize, serializeProps, class SerializeProps', serializeProps') where
+
+import Prelude
+
+import Data.Array as Array
+import Data.Int as Int
+import Data.Number.Format (toString) as Number
+import Data.Symbol (class IsSymbol, reflectSymbol)
+import Data.Tuple (Tuple)
+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 Type.Prelude (Proxy(..))
+import Unsafe.Coerce (unsafeCoerce)
+
+class Serialize a where
+  serialize :: a -> String
+
+instance Serialize String where
+  serialize = identity
+else instance Serialize Int where
+  serialize = Int.toStringAs Int.decimal
+else instance Serialize Number where
+  serialize = Number.toString
+else instance Serialize Boolean where
+  serialize = show
+else instance Serialize a => Serialize (Array a) where
+  serialize = Array.intercalate " " <<< map serialize
+else instance (Serialize a, Serialize b) => Serialize (Tuple a b) where
+  serialize (a /\ b) = serialize [serialize a, serialize b]
+
+serializeProps :: forall @props part missing propsrl. RowToList props propsrl => SerializeProps' props propsrl => Union part missing props => Record part -> {}
+serializeProps =
+  (unsafeCoerce :: Record props -> {})
+  <<< serializeProps' @props @propsrl
+  <<< (unsafeCoerce :: Record part -> Record props)
+
+class SerializeProps' :: Row Type -> RowList Type -> Constraint
+class SerializeProps' p prl | prl -> p where
+  serializeProps' :: Record p -> Record p
+
+instance
+  ( IsSymbol k
+  , RowToList p' prl'
+  , RowToList p (RL.Cons k v prl')
+  , Cons k v p' p
+  , SerializeProps' p' prl'
+  , Serialize v
+  ) => SerializeProps' p (RL.Cons k v prl') where
+  serializeProps' =
+    patchUnsafe @k serialize
+    <<< remember @k
+    <<< serializeProps' @p' @prl'
+    <<< forget @k
+instance SerializeProps' () RL.Nil where
+  serializeProps' = identity
+
+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
+    btoa = unsafeCoerce :: b -> a
+  in
+    if Record.unsafeHas k r then
+      Record.unsafeSet k (btoa $ f $ Record.unsafeGet k r) r
+    else
+      r
+
+forget :: forall @k @r' @r a. Cons k a r' r => Record r -> Record r'
+forget = unsafeCoerce
+
+remember :: forall @k @r' @r a. Cons k a r' r => Record r' -> Record r
+remember = unsafeCoerce

src/Mujoco.XML.Node.purs

@@ -0,0 +1,98 @@
+module Mujoco.XML.Node
+  ( Node
+  , render
+  , tag
+  , tagNoContent
+  , class Children
+  , asChildren
+  , fragment
+  , empty
+  , text
+  ) where
+
+import Prelude
+
+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 Prim.Row (class Union)
+import Prim.RowList (class RowToList)
+import Unsafe.Coerce (unsafeCoerce)
+
+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
+  -> a
+  -> Node
+
+type TagNoContent props
+   = forall r missing propsrl
+   . Union r missing props
+  => React.ValidReactProps (Record r)
+  => RowToList props propsrl
+  => SerializeProps' props propsrl
+  => Record r
+  -> Node
+
+foreign import data Node :: Type
+
+render :: Node -> String
+render = React.renderToString <<< toReact
+
+fromReact :: ReactElement -> Node
+fromReact = unsafeCoerce
+
+toReact :: Node -> ReactElement
+toReact = unsafeCoerce
+
+tag
+  :: forall @props propsrl
+   . RowToList props propsrl
+  => SerializeProps' props propsrl
+  => String
+  -> ( forall r missing a.
+        Union r missing props
+     => Children a
+     => React.ValidReactProps (Record r)
+     => Record r
+     -> a
+     -> Node
+     )
+tag el p a = fromReact $ HTML.tag el (serializeProps @props p) $ toReact <$> asChildren a
+
+tagNoContent
+  :: forall @props propsrl
+   . RowToList props propsrl
+  => SerializeProps' props propsrl
+  => String
+  -> ( forall r missing.
+        Union r missing props
+     => React.ValidReactProps (Record r)
+     => Record r
+     -> Node
+     )
+tagNoContent el p = fromReact $ HTML.tagNoContent el (serializeProps @props p)
+
+fragment :: Array Node -> Node
+fragment = fromReact <<< HTML.fragment <<< map toReact
+
+empty :: Node
+empty = fromReact HTML.empty
+
+text :: String -> Node
+text = fromReact <<< HTML.text
+
+class Children a where
+  asChildren :: a -> Array Node
+
+instance Children (Array Node) where asChildren = identity
+instance Children String where asChildren s = [ unsafeCoerce s ]
+instance Children Node where asChildren e = [ e ]
+instance Children Unit where asChildren _ = []

src/Mujoco.purs

@@ -0,0 +1 @@
+module Mujoco where

test/Main.purs

@@ -0,0 +1,13 @@
+module Test.Main where
+
+import Prelude
+
+import Effect (Effect)
+import Test.Mujoco.XML.Node.Prop as Test.Mujoco.XML.Node.Prop
+import Test.Spec.Reporter.Console (consoleReporter)
+import Test.Spec.Runner.Node (runSpecAndExitProcess)
+
+main :: Effect Unit
+main =
+  runSpecAndExitProcess [consoleReporter] do
+    Test.Mujoco.XML.Node.Prop.spec

test/Mujoco.XML.Node.Prop.purs

@@ -0,0 +1,51 @@
+module Test.Mujoco.XML.Node.Prop where
+
+import Prelude
+
+import Data.Tuple.Nested (type (/\), (/\))
+import Mujoco.XML.Node.Prop (class SerializeProps', serialize, serializeProps)
+import Prim.Row (class Union)
+import Prim.RowList (class RowToList)
+import Test.Spec (Spec, describe, it)
+import Test.Spec.Assertions (shouldEqual)
+import Unsafe.Coerce (unsafeCoerce)
+
+type Props =
+  ( int :: Int
+  , string :: String
+  , array :: Array Int
+  , array2 :: Array (Array Int)
+  , tuple :: Int /\ Int
+  , tuple3 :: Int /\ Int /\ Int
+  , bool :: Boolean
+  )
+
+spec :: Spec Unit
+spec =
+  describe "Mujoco.XML.Node.Prop" do
+    describe "Serialize" do
+      it "serializes boolean" $ serialize true `shouldEqual` "true"
+      it "serializes string" $ serialize "a" `shouldEqual` "a"
+      it "serializes array" $ serialize ["a", "b"] `shouldEqual` "a b"
+      it "serializes nested array" $ serialize [["a", "b"], ["c"]] `shouldEqual` "a b c"
+      it "serializes int" $ serialize 1 `shouldEqual` "1"
+      it "serializes int array" $ serialize [1, 2] `shouldEqual` "1 2"
+      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"
+
+    describe "SerializeProps" do
+      let
+        serializeProps'
+          :: forall part missing propsrl x
+           . RowToList Props propsrl
+          => SerializeProps' Props propsrl
+          => Union part missing Props
+          => Record part
+          -> Record x
+        serializeProps' = unsafeCoerce <<< serializeProps @Props
+
+      it "handles empty" $ serializeProps' {} `shouldEqual` {}
+      it "handles int" $ serializeProps' { int: 1 } `shouldEqual` { int: "1" }
+      it "handles string" $ serializeProps' { string: "a" } `shouldEqual` { string: "a" }
+      it "handles array2" $ serializeProps' { array2: [[1, 2, 3], [4, 5]] } `shouldEqual` { array2: "1 2 3 4 5" }