erebos-tester-0.3.4: src/Script/Object.hs
module Script.Object (
ObjectId(..),
ObjectType(..),
Object(..), SomeObject(..),
toSomeObject, fromSomeObject,
destroySomeObject,
) where
import Data.Kind
import Data.Text (Text)
import Data.Typeable
import Script.Expr.Class
newtype ObjectId = ObjectId Int
class Typeable a => ObjectType m a where
type ConstructorArgs a :: Type
type ConstructorArgs a = ()
textObjectType :: proxy (m a) -> proxy a -> Text
textObjectValue :: proxy (m a) -> a -> Text
createObject :: ObjectId -> ConstructorArgs a -> m (Object m a)
destroyObject :: Object m a -> m ()
instance (Typeable m, ObjectType m a) => ExprType (Object m a) where
textExprType _ = textObjectType (Proxy @(m a)) (Proxy @a)
textExprValue = textObjectValue (Proxy @(m a)) . objImpl
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)