-- | Type-safe network sockets, as described in
-- [Client/Server Applications with Fudgets](http://www.altocumulus.org/Fudgets/ftp/client-server.pdf).
module TypedSockets(TPort,tPort,tSocketServerF,TServerAddress,tServerAddress,tTransceiverF,ClientMsg(..),SocketMsg(..)) where

import Fudgets
import SocketServer
import Debug.Trace
--import DialogueIO hiding (IOError)

newtype TPort a b = TPort Port

tPort :: (Show a, Read a,Show b,Read b) => Port -> TPort a b
tPort :: Port -> TPort a b
tPort Port
p = Port -> TPort a b
forall a b. Port -> TPort a b
TPort Port
p

newtype TSocket t r = TSocket Socket
newtype TLSocket t r = TLSocket LSocket
data TServerAddress c s = TServerAddress Host (TPort c s)

tServerAddress :: Host -> TPort c s -> TServerAddress c s
tServerAddress Host
host TPort c s
port = Host -> TPort c s -> TServerAddress c s
forall c s. Host -> TPort c s -> TServerAddress c s
TServerAddress Host
host TPort c s
port

tSocketServerF ::
  (Read c, Show s) => 
  TPort c s -> (Peer -> F s (SocketMsg c) -> F a (SocketMsg b)) ->
  F (Int, a) (Int, ClientMsg b)
tSocketServerF :: TPort c s
-> (Host -> F s (SocketMsg c) -> F a (SocketMsg b))
-> F (Port, a) (Port, ClientMsg b)
tSocketServerF (TPort Port
p) Host -> F s (SocketMsg c) -> F a (SocketMsg b)
f = Port
-> (Socket -> Host -> F a (SocketMsg b))
-> F (Port, a) (Port, ClientMsg b)
forall a1 a2.
Port
-> (Socket -> Host -> F a1 (SocketMsg a2))
-> F (Port, a1) (Port, ClientMsg a2)
socketServerF Port
p (\ Socket
s Host
p -> Host -> F s (SocketMsg c) -> F a (SocketMsg b)
f Host
p (Socket -> F s (SocketMsg c)
forall a a. (Show a, Read a) => Socket -> F a (SocketMsg a)
textTransceiver Socket
s))

--texttransceiver :: (Show t,Read r) => Socket -> F t (SocketMsg r)
textTransceiver :: Socket -> F a (SocketMsg a)
textTransceiver Socket
s = SP Host (SocketMsg a)
postSP SP Host (SocketMsg a) -> F Host Host -> F Host (SocketMsg a)
forall a b e. SP a b -> F e a -> F e b
>^^=< Socket -> F Host Host
transceiverF Socket
s F Host (SocketMsg a) -> (a -> Host) -> F a (SocketMsg a)
forall c d e. F c d -> (e -> c) -> F e d
>=^< a -> Host
forall a. Show a => a -> Host
pre
  where
    pre :: a -> Host
pre a
s = a -> ShowS
forall a. Show a => a -> ShowS
shows a
s Host
"\n"

    postSP :: SP Host (SocketMsg a)
postSP = (Host -> Either (SocketMsg a) Host)
-> (Either (SocketMsg a) (SocketMsg a) -> SocketMsg a)
-> SP
     (Either (SocketMsg a) Host) (Either (SocketMsg a) (SocketMsg a))
-> SP Host (SocketMsg a)
forall t1 a t2 b. (t1 -> a) -> (t2 -> b) -> SP a t2 -> SP t1 b
prepostMapSP Host -> Either (SocketMsg a) Host
forall a. Host -> Either (SocketMsg a) Host
eos Either (SocketMsg a) (SocketMsg a) -> SocketMsg a
forall p. Either p p -> p
stripEither (SP
   (Either (SocketMsg a) Host) (Either (SocketMsg a) (SocketMsg a))
 -> SP Host (SocketMsg a))
-> SP
     (Either (SocketMsg a) Host) (Either (SocketMsg a) (SocketMsg a))
-> SP Host (SocketMsg a)
forall a b. (a -> b) -> a -> b
$
             SP Host (SocketMsg a)
-> SP
     (Either (SocketMsg a) Host) (Either (SocketMsg a) (SocketMsg a))
forall a1 b a2. SP a1 b -> SP (Either a2 a1) (Either a2 b)
idLeftSP ((Host -> Maybe (SocketMsg a)) -> SP Host (SocketMsg a)
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP Host -> Maybe (SocketMsg a)
forall a. Read a => Host -> Maybe (SocketMsg a)
reader SP Host (SocketMsg a) -> SP Host Host -> SP Host (SocketMsg a)
forall a1 b a2. SP a1 b -> SP a2 a1 -> SP a2 b
-==- SP Host Host
inputLinesSP)

    eos :: Host -> Either (SocketMsg a) Host
eos Host
"" = SocketMsg a -> Either (SocketMsg a) Host
forall a b. a -> Either a b
Left SocketMsg a
forall a. SocketMsg a
SocketEOS
    eos Host
s = Host -> Either (SocketMsg a) Host
forall a b. b -> Either a b
Right Host
s

    reader :: Host -> Maybe (SocketMsg a)
reader Host
s = case ReadS a
forall a. Read a => ReadS a
reads Host
s of 
      [(a
a,Host
"")] -> SocketMsg a -> Maybe (SocketMsg a)
forall a. a -> Maybe a
Just (a -> SocketMsg a
forall a. a -> SocketMsg a
SocketMsg a
a)
      [(a, Host)]
_ -> Host -> Maybe (SocketMsg a) -> Maybe (SocketMsg a)
forall a. Host -> a -> a
trace (Host
"No parse from socket: "Host -> ShowS
forall a. [a] -> [a] -> [a]
++Host
s) Maybe (SocketMsg a)
forall a. Maybe a
Nothing

tTransceiverF :: (Show c, Read s) => TServerAddress c s -> F c (SocketMsg s)
tTransceiverF :: TServerAddress c s -> F c (SocketMsg s)
tTransceiverF (TServerAddress Host
host (TPort Port
port)) = 
   Host -> Port -> (Socket -> F c (SocketMsg s)) -> F c (SocketMsg s)
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Host -> Port -> (Socket -> f b ho) -> f b ho
openSocketF Host
host Port
port Socket -> F c (SocketMsg s)
forall a a. (Show a, Read a) => Socket -> F a (SocketMsg a)
textTransceiver