{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeInType #-}

module Network.TypedProtocol.ReqResp.Codec where

import           Network.TypedProtocol.Codec
import           Network.TypedProtocol.ReqResp.Type
import           Network.TypedProtocol.PingPong.Codec (decodeTerminatedFrame)
import           Text.Read (readMaybe)


codecReqResp ::
    forall req resp m
  . (Monad m, Show req, Show resp, Read req, Read resp)
  => Codec (ReqResp req resp) CodecFailure m String
codecReqResp :: Codec (ReqResp req resp) CodecFailure m String
codecReqResp =
    Codec :: forall ps failure (m :: * -> *) bytes.
(forall (pr :: PeerRole) (st :: ps) (st' :: ps).
 PeerHasAgency pr st -> Message ps st st' -> bytes)
-> (forall (pr :: PeerRole) (st :: ps).
    PeerHasAgency pr st
    -> m (DecodeStep bytes failure m (SomeMessage st)))
-> Codec ps failure m bytes
Codec{forall k k (req' :: k) (resp' :: k) (pr :: PeerRole)
       (st :: ReqResp req' resp') (st' :: ReqResp req' resp').
Show (Message (ReqResp req' resp') st st') =>
PeerHasAgency pr st
-> Message (ReqResp req' resp') st st' -> String
forall (pr :: PeerRole) (st :: ReqResp req resp)
       (st' :: ReqResp req resp).
PeerHasAgency pr st -> Message (ReqResp req resp) st st' -> String
encode :: forall (pr :: PeerRole) (st :: ReqResp req resp)
       (st' :: ReqResp req resp).
PeerHasAgency pr st -> Message (ReqResp req resp) st st' -> String
encode :: forall k k (req' :: k) (resp' :: k) (pr :: PeerRole)
       (st :: ReqResp req' resp') (st' :: ReqResp req' resp').
Show (Message (ReqResp req' resp') st st') =>
PeerHasAgency pr st
-> Message (ReqResp req' resp') st st' -> String
encode, forall req' resp' (m' :: * -> *) (pr :: PeerRole)
       (st :: ReqResp req' resp').
(Monad m', Read req', Read resp') =>
PeerHasAgency pr st
-> m' (DecodeStep String CodecFailure m' (SomeMessage st))
forall (pr :: PeerRole) (st :: ReqResp req resp).
PeerHasAgency pr st
-> m (DecodeStep String CodecFailure m (SomeMessage st))
decode :: forall (pr :: PeerRole) (st :: ReqResp req resp).
PeerHasAgency pr st
-> m (DecodeStep String CodecFailure m (SomeMessage st))
decode :: forall req' resp' (m' :: * -> *) (pr :: PeerRole)
       (st :: ReqResp req' resp').
(Monad m', Read req', Read resp') =>
PeerHasAgency pr st
-> m' (DecodeStep String CodecFailure m' (SomeMessage st))
decode}
  where
    encode :: forall req' resp'
                     (pr  :: PeerRole)
                     (st  :: ReqResp req' resp')
                     (st' :: ReqResp req' resp')
           . (Show (Message (ReqResp req' resp') st st'))
           => PeerHasAgency pr st
           -> Message (ReqResp req' resp') st st'
           -> String
    encode :: PeerHasAgency pr st
-> Message (ReqResp req' resp') st st' -> String
encode (ClientAgency ClientHasAgency st
TokIdle) Message (ReqResp req' resp') st st'
msg = Message (ReqResp req' resp') st st' -> String
forall a. Show a => a -> String
show Message (ReqResp req' resp') st st'
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
    encode (ServerAgency ServerHasAgency st
TokBusy) Message (ReqResp req' resp') st st'
msg = Message (ReqResp req' resp') st st' -> String
forall a. Show a => a -> String
show Message (ReqResp req' resp') st st'
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

    decode :: forall req' resp' m'
                     (pr :: PeerRole)
                     (st :: ReqResp req' resp')
           .  (Monad m', Read req', Read resp')
           => PeerHasAgency pr st
           -> m' (DecodeStep String CodecFailure m' (SomeMessage st))
    decode :: PeerHasAgency pr st
-> m' (DecodeStep String CodecFailure m' (SomeMessage st))
decode PeerHasAgency pr st
stok =
      Char
-> (String
    -> Maybe String
    -> DecodeStep String CodecFailure m' (SomeMessage st))
-> m' (DecodeStep String CodecFailure m' (SomeMessage st))
forall (m :: * -> *) a.
Monad m =>
Char
-> (String -> Maybe String -> DecodeStep String CodecFailure m a)
-> m (DecodeStep String CodecFailure m a)
decodeTerminatedFrame Char
'\n' ((String
  -> Maybe String
  -> DecodeStep String CodecFailure m' (SomeMessage st))
 -> m' (DecodeStep String CodecFailure m' (SomeMessage st)))
-> (String
    -> Maybe String
    -> DecodeStep String CodecFailure m' (SomeMessage st))
-> m' (DecodeStep String CodecFailure m' (SomeMessage st))
forall a b. (a -> b) -> a -> b
$ \String
str Maybe String
trailing ->
        case (PeerHasAgency pr st
stok, (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') String
str) of
          (ClientAgency ClientHasAgency st
TokIdle, (String
"MsgReq", String
str'))
             | Just req'
resp <- String -> Maybe req'
forall a. Read a => String -> Maybe a
readMaybe String
str'
            -> SomeMessage 'StIdle
-> Maybe String
-> DecodeStep String CodecFailure m' (SomeMessage 'StIdle)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ReqResp req' resp') 'StIdle 'StBusy -> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (req' -> Message (ReqResp req' resp') 'StIdle 'StBusy
forall k req (resp :: k).
req -> Message (ReqResp req resp) 'StIdle 'StBusy
MsgReq req'
resp)) Maybe String
trailing
          (ClientAgency ClientHasAgency st
TokIdle, (String
"MsgDone", String
""))
            -> SomeMessage 'StIdle
-> Maybe String
-> DecodeStep String CodecFailure m' (SomeMessage 'StIdle)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ReqResp req' resp') 'StIdle 'StDone -> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (ReqResp req' resp') 'StIdle 'StDone
forall k k (req :: k) (resp :: k).
Message (ReqResp req resp) 'StIdle 'StDone
MsgDone) Maybe String
trailing
          (ServerAgency ServerHasAgency st
TokBusy, (String
"MsgResp", String
str'))
             | Just resp'
resp <- String -> Maybe resp'
forall a. Read a => String -> Maybe a
readMaybe String
str'
            -> SomeMessage 'StBusy
-> Maybe String
-> DecodeStep String CodecFailure m' (SomeMessage 'StBusy)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (ReqResp req' resp') 'StBusy 'StIdle -> SomeMessage 'StBusy
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (resp' -> Message (ReqResp req' resp') 'StBusy 'StIdle
forall k resp (req :: k).
resp -> Message (ReqResp req resp) 'StBusy 'StIdle
MsgResp resp'
resp)) Maybe String
trailing

          (ServerAgency ServerHasAgency st
_      , (String, String)
_     ) -> CodecFailure -> DecodeStep String CodecFailure m' (SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail CodecFailure
failure
            where failure :: CodecFailure
failure = String -> CodecFailure
CodecFailure (String
"unexpected server message: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str)
          (ClientAgency ClientHasAgency st
_      , (String, String)
_     ) -> CodecFailure -> DecodeStep String CodecFailure m' (SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail CodecFailure
failure
            where failure :: CodecFailure
failure = String -> CodecFailure
CodecFailure (String
"unexpected client message: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str)