{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GADTs #-}
module Control.Eff.Concurrent.Api
( Api
, Synchronicity(..)
, Server(..)
, fromServer
, proxyAsServer
, asServer
)
where
import Data.Kind
import Control.Lens
import Data.Typeable (Typeable, typeRep)
import Control.Eff.Concurrent.Process
data family Api (api :: Type) (reply :: Synchronicity)
data Synchronicity = Synchronous Type | Asynchronous
deriving (Typeable)
newtype Server api = Server { _fromServer :: ProcessId }
deriving (Eq,Ord,Typeable)
instance Read (Server api) where
readsPrec _ ('[':'#':rest1) =
case reads (dropWhile (/= '#') rest1) of
[(c, ']':rest2)] -> [(Server c, rest2)]
_ -> []
readsPrec _ _ = []
instance Typeable api => Show (Server api) where
show s@(Server c) =
"[#" ++ show (typeRep s) ++ "#" ++ show c ++ "]"
makeLenses ''Server
proxyAsServer :: proxy api -> ProcessId -> Server api
proxyAsServer = const Server
asServer :: forall api . ProcessId -> Server api
asServer = Server