generated from tpl/purs
60 lines
1.8 KiB
Plaintext
60 lines
1.8 KiB
Plaintext
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 {}
|