typesafe texture/material in three.hs

1_three.js

// In three.js, there are several classes implementing textures:
//  - Texture (base class, for classic textures)
//  - DepthTexture, VideoTexture... (which extend Texture)

// Then materials use such textures as properties (map, normalmap...).
// So we can write something like:

const material1 = new THREE.MeshLambertianMaterial();
material1.map = new THREE.Texture();        // a Texture
const texture1 = material1.map;
// ...
material1.map = new THREE.VideoTexture();   // a VideoTexture
const videotexture1 = material1.map;
// ...

2_textureclass.hs

-- In three.hs, we use typeclasses to wrap three.js base classes.
-- So, to implement textures, we have:
--  - TextureClass (typeclass)
--  - Texture (newtype)
--  - DepthTexture, VideoTexture... (newtypes)

-- In materials (for example, MeshLambertMaterial), we can define properties using TextureClass:
map :: (TextureClass texture, FromJSVal texture) => Property MeshLambertMaterial (Maybe texture)
map = optional "map"

-- Thus, we can set the map property using a Texture or a VideoTexture:
material1 <- THREE.MeshLambertMaterial.new ()
texture1 <- THREE.Texture.new ()
material1 & THREE.MeshLambertMaterial.map .= Just texture1
-- ...
videotexture1 <- THREE.VideoTexture.new ()
material1 & THREE.MeshLambertMaterial.map .= Just videotexture1

-- But this isn't typesafe, since we can get a texture property with a potentially incorrect type:
(Just t1 :: Maybe Texture) <- material1 ^. THREE.MeshLambertMaterial.map        -- ok (base class)
(Just t2 :: Maybe VideoTexture) <- material1 ^. THREE.MeshLambertMaterial.map   -- ok (inherited class)
(Just t3 :: Maybe DepthTexture) <- material1 ^. THREE.MeshLambertMaterial.map   -- not ok (but compiles)

3_typecoerce.hs

-- Another solution is to define the property using Texture, instead of TextureClass:
map :: Property MeshLambertMaterial (Maybe Texture)
map = optional "map"

-- Thus, we can set this property using Texture or any "inherited" types (after coercion, still):
material1 <- THREE.MeshLambertMaterial.new ()
texture1 <- THREE.Texture.new ()
material1 & THREE.MeshLambertMaterial.map .= Just texture1
-- ...
texture2 <- unsafeCoerceTexture =<< THREE.VideoTexture.new ()
material1 & THREE.MeshLambertMaterial.map .= Just texture2

-- We get a texture property using the (correct) base type only:
(Just t1 :: Maybe Texture) <- material1 ^. THREE.MeshLambertMaterial.map
-- (Just t2 :: Maybe VideoTexture) <- material1 ^. THREE.MeshLambertMaterial.map  -- does not compile
-- (Just t3 :: Maybe DepthTexture) <- material1 ^. THREE.MeshLambertMaterial.map  -- does not compile

-- But we can coerce a texture to get the inherited type, without breaking typesafety:
mvt <- coerceVideoTexture t1
  case mvt of
    Just videotexture1 -> consoleLog "t1 is a VideoTexture"
    Nothing -> consoleLog "t1 is not a VideoTexture"


-- helper functions:
unsafeCoerceTexture :: (ToJSVal a) => a -> JSM Texture
unsafeCoerceTexture = fmap Texture . toJSVal

coerceVideoTexture :: (MakeObject a, ToJSVal a) => a -> JSM (Maybe VideoTexture)
coerceVideoTexture v = do
  r <- fromJSVal =<< v ! "isVideoTexture"
  case r of
    Just True -> Just . VideoTexture <$> toJSVal v
    _ -> pure Nothing