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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Wayland.Server
( Request(..)
, ObjectID
, Global
, DisplayM(..)
, Resource(..)
, fromRequest
, withDisplay
, bindSocket
, processRequests
, flushEvents
, sendEvent
, destroyResource
, registerGlobal
, unregisterGlobal
) where
import Data.Typeable (Typeable, cast)
import Data.Kind (Type)
import Control.Monad.State.Strict (StateT, MonadState(..), MonadIO(..))
import Lens.Micro.Mtl.Internal (Zoom(..), Zoomed)
data DisplayState
data Global
newtype ObjectID = ObjectID String
deriving (Show, Eq, Ord)
class Resource r where
type ResourceRequest r :: Type
type ResourceEvent r :: Type
objectID :: r -> ObjectID
data Request = forall a. Typeable a => Request a
newtype DisplayM s a = DisplayM { runDisplayM :: StateT s (StateT DisplayState IO) a }
deriving (Functor, Applicative, Monad, MonadIO, MonadState s)
type instance Zoomed (DisplayM s) = Zoomed (StateT s (StateT DisplayState IO))
instance Zoom (DisplayM s) (DisplayM t) s t where
zoom l (DisplayM m) = DisplayM (zoom l m)
fromRequest :: Typeable a => Request -> Maybe a
fromRequest (Request x) = cast x
withDisplay :: s -> DisplayM s a -> IO (s, a)
withDisplay _ _ = undefined
bindSocket :: DisplayM s String
bindSocket = undefined
processRequests :: (Request -> DisplayM s ()) -> DisplayM s ()
processRequests _ = undefined
sendEvent :: Resource r => r -> ResourceEvent r -> DisplayM s ()
sendEvent _ _ = undefined
flushEvents :: DisplayM s ()
flushEvents = undefined
destroyResource :: Resource r => r -> DisplayM s ()
destroyResource _ = undefined
registerGlobal :: Resource r => Typeable req => (r -> req) -> DisplayM s Global
registerGlobal _ = undefined
unregisterGlobal :: Global -> DisplayM s ()
unregisterGlobal _ = undefined
|
