src/Script/Object.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

module Script.Object (
    ObjectId(..),
    ObjectType(..),
    Object(..), SomeObject(..),
    toSomeObject, fromSomeObject,
    destroySomeObject,
) where

import Data.Kind
import Data.Typeable


newtype ObjectId = ObjectId Int

class Typeable a => ObjectType m a where
    type ConstructorArgs a :: Type
    type ConstructorArgs a = ()

    createObject :: ObjectId -> ConstructorArgs a -> m (Object m a)
    destroyObject :: Object m a -> m ()

data Object m a = ObjectType m a => Object
    { objId :: ObjectId
    , objImpl :: a
    }

data SomeObject m = forall a. ObjectType m a => SomeObject
    { sobjId :: ObjectId
    , sobjImpl :: a
    }

toSomeObject :: Object m a -> SomeObject m
toSomeObject Object {..} = SomeObject { sobjId = objId, sobjImpl = objImpl }

fromSomeObject :: ObjectType m a => SomeObject m -> Maybe (Object m a)
fromSomeObject SomeObject {..} = do
    let objId = sobjId
    objImpl <- cast sobjImpl
    return Object {..}

destroySomeObject :: SomeObject m -> m ()
destroySomeObject (SomeObject oid impl) = destroyObject (Object oid impl)