module SocketServer(ClientMsg(..),SocketMsg(..),mapSocketMsg,socketServerF) where
import AllFudgets
import DialogueIO hiding (IOError)

data ClientMsg a = ClientMsg a | ClientEOS | ClientNew deriving (Int -> ClientMsg a -> ShowS
forall a. Show a => Int -> ClientMsg a -> ShowS
forall a. Show a => [ClientMsg a] -> ShowS
forall a. Show a => ClientMsg a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientMsg a] -> ShowS
$cshowList :: forall a. Show a => [ClientMsg a] -> ShowS
show :: ClientMsg a -> String
$cshow :: forall a. Show a => ClientMsg a -> String
showsPrec :: Int -> ClientMsg a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ClientMsg a -> ShowS
Show)
data SocketMsg a = SocketMsg a | SocketEOS deriving (Int -> SocketMsg a -> ShowS
forall a. Show a => Int -> SocketMsg a -> ShowS
forall a. Show a => [SocketMsg a] -> ShowS
forall a. Show a => SocketMsg a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SocketMsg a] -> ShowS
$cshowList :: forall a. Show a => [SocketMsg a] -> ShowS
show :: SocketMsg a -> String
$cshow :: forall a. Show a => SocketMsg a -> String
showsPrec :: Int -> SocketMsg a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SocketMsg a -> ShowS
Show)

mapSocketMsg :: (t -> a) -> SocketMsg t -> SocketMsg a
mapSocketMsg t -> a
f (SocketMsg t
a) = forall a. a -> SocketMsg a
SocketMsg (t -> a
f t
a)
mapSocketMsg t -> a
f SocketMsg t
SocketEOS = forall a. SocketMsg a
SocketEOS

instance Functor SocketMsg where fmap :: forall a b. (a -> b) -> SocketMsg a -> SocketMsg b
fmap = forall a b. (a -> b) -> SocketMsg a -> SocketMsg b
mapSocketMsg

socketServerF :: Int
-> (Socket -> String -> F a (SocketMsg a))
-> F (Int, a) (Int, ClientMsg a)
socketServerF Int
port Socket -> String -> F a (SocketMsg a)
f = 
    forall a b c d. F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF (forall {a} {b}. (a -> [b]) -> F a b
concatMapF forall {a} {b} {a} {a} {a}.
Either (Either (a, b) (a, SocketMsg a)) (a, a)
-> [Either (Either a (a, DynMsg a b)) (a, ClientMsg a)]
router) (forall {hi}. F hi (Int, F a (SocketMsg a))
listenerF forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
>+< forall a b. F (Int, DynFMsg a b) (Int, b)
dynListF)
  where
    router :: Either (Either (a, b) (a, SocketMsg a)) (a, a)
-> [Either (Either a (a, DynMsg a b)) (a, ClientMsg a)]
router = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a} {b} {a} {a} {a}.
(a, b) -> [Either (Either a (a, DynMsg a b)) (a, ClientMsg a)]
fromListener forall {a} {a} {a} {a} {b}.
(a, SocketMsg a)
-> [Either (Either a (a, DynMsg a b)) (a, ClientMsg a)]
fromDynList) forall {a} {a} {a} {b} {b}.
(a, a) -> [Either (Either a (a, DynMsg a b)) b]
fromOutside
      where
	fromListener :: (a, b) -> [Either (Either a (a, DynMsg a b)) (a, ClientMsg a)]
fromListener (a
i,b
f) = [forall {a} {a} {b}. a -> Either (Either a a) b
todyn (a
i,forall a b. b -> DynMsg a b
DynCreate b
f), forall {b} {a}. b -> Either a b
out (a
i,forall a. ClientMsg a
ClientNew)]

	fromDynList :: (a, SocketMsg a)
-> [Either (Either a (a, DynMsg a b)) (a, ClientMsg a)]
fromDynList (a
i,SocketMsg a
m) =
	  case SocketMsg a
m of
	    SocketMsg a
m' -> [forall {b} {a}. b -> Either a b
out (a
i,forall a. a -> ClientMsg a
ClientMsg a
m')]
	    SocketMsg a
SocketEOS    -> [forall {b} {a}. b -> Either a b
out (a
i,forall a. ClientMsg a
ClientEOS), forall {a} {a} {b}. a -> Either (Either a a) b
todyn (a
i,forall a b. DynMsg a b
DynDestroy)]

	fromOutside :: (a, a) -> [Either (Either a (a, DynMsg a b)) b]
fromOutside (a
i,a
m) = [forall {a} {a} {b}. a -> Either (Either a a) b
todyn (a
i,forall a b. a -> DynMsg a b
DynMsg a
m)]

        todyn :: a -> Either (Either a a) b
todyn = forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
	out :: b -> Either a b
out = forall a b. b -> Either a b
Right

    listenerF :: F hi (Int, F a (SocketMsg a))
listenerF =
        forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Int -> (LSocket -> f hi ho) -> f hi ho
openLSocketF Int
port forall a b. (a -> b) -> a -> b
$ \LSocket
lsocket ->
	forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
[Descriptor] -> f hi ho -> f hi ho
select [LSocket -> Descriptor
LSocketDe LSocket
lsocket] forall a b. (a -> b) -> a -> b
$
	forall {t} {a}. Num t => t -> F a (t, F a (SocketMsg a))
accepter Int
0
      where
	accepter :: t -> F a (t, F a (SocketMsg a))
accepter t
i = 
	  forall {a} {b}. Cont (F a b) (KEvent a)
getMessageFu forall a b. (a -> b) -> a -> b
$ \KEvent a
e ->
	  case KEvent a
e of
	    Low (DResp (AsyncInput (Descriptor
_,SocketAccepted Socket
socket String
peer))) ->
		  forall {ho} {hi}. ho -> F hi ho -> F hi ho
putF (t
i,Socket -> String -> F a (SocketMsg a)
f Socket
socket String
peer) forall a b. (a -> b) -> a -> b
$
		  t -> F a (t, F a (SocketMsg a))
accepter (t
iforall a. Num a => a -> a -> a
+t
1)
	    KEvent a
_ -> t -> F a (t, F a (SocketMsg a))
accepter t
i