{-# 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