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

module Network.TypedProtocol.PingPong.Codec where

import           Network.TypedProtocol.Codec
import           Network.TypedProtocol.PingPong.Type


codecPingPong
  :: forall m. Monad m
  => Codec PingPong CodecFailure m String
codecPingPong :: Codec PingPong CodecFailure m String
codecPingPong =
    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 (pr :: PeerRole) (st :: PingPong) (st' :: PingPong).
PeerHasAgency pr st -> Message PingPong st st' -> String
encode :: forall (pr :: PeerRole) (st :: PingPong) (st' :: PingPong).
PeerHasAgency pr st -> Message PingPong st st' -> String
encode :: forall (pr :: PeerRole) (st :: PingPong) (st' :: PingPong).
PeerHasAgency pr st -> Message PingPong st st' -> String
encode, forall (pr :: PeerRole) (st :: PingPong).
PeerHasAgency pr st
-> m (DecodeStep String CodecFailure m (SomeMessage st))
decode :: forall (pr :: PeerRole) (st :: PingPong).
PeerHasAgency pr st
-> m (DecodeStep String CodecFailure m (SomeMessage st))
decode :: forall (pr :: PeerRole) (st :: PingPong).
PeerHasAgency pr st
-> m (DecodeStep String CodecFailure m (SomeMessage st))
decode}
  where
    encode :: forall pr (st :: PingPong) (st' :: PingPong)
           .  PeerHasAgency pr st
           -> Message PingPong st st'
           -> String
    encode :: PeerHasAgency pr st -> Message PingPong st st' -> String
encode (ClientAgency ClientHasAgency st
TokIdle) Message PingPong st st'
MsgPing = String
"ping\n"
    encode (ClientAgency ClientHasAgency st
TokIdle) Message PingPong st st'
MsgDone = String
"done\n"
    encode (ServerAgency ServerHasAgency st
TokBusy) Message PingPong st st'
MsgPong = String
"pong\n"

    decode :: forall pr (st :: PingPong)
           .  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, String
str) of
          (ServerAgency ServerHasAgency st
TokBusy, String
"pong") -> 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 PingPong 'StBusy 'StIdle -> SomeMessage 'StBusy
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message PingPong 'StBusy 'StIdle
MsgPong) Maybe String
trailing
          (ClientAgency ClientHasAgency st
TokIdle, String
"ping") -> 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 PingPong 'StIdle 'StBusy -> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message PingPong 'StIdle 'StBusy
MsgPing) Maybe String
trailing
          (ClientAgency ClientHasAgency st
TokIdle, String
"done") -> 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 PingPong 'StIdle 'StDone -> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message PingPong 'StIdle 'StDone
MsgDone) Maybe String
trailing

          (ServerAgency ServerHasAgency st
_      , 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
_     ) -> 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)


decodeTerminatedFrame :: forall m a.
                         Monad m
                      => Char
                      -> (String -> Maybe String -> DecodeStep String CodecFailure m a)
                      -> m (DecodeStep String CodecFailure m a)
decodeTerminatedFrame :: Char
-> (String -> Maybe String -> DecodeStep String CodecFailure m a)
-> m (DecodeStep String CodecFailure m a)
decodeTerminatedFrame Char
terminator String -> Maybe String -> DecodeStep String CodecFailure m a
k = [String] -> m (DecodeStep String CodecFailure m a)
go []
  where
    go :: [String] -> m (DecodeStep String CodecFailure m a)
    go :: [String] -> m (DecodeStep String CodecFailure m a)
go [String]
chunks =
      DecodeStep String CodecFailure m a
-> m (DecodeStep String CodecFailure m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep String CodecFailure m a
 -> m (DecodeStep String CodecFailure m a))
-> DecodeStep String CodecFailure m a
-> m (DecodeStep String CodecFailure m a)
forall a b. (a -> b) -> a -> b
$ (Maybe String -> m (DecodeStep String CodecFailure m a))
-> DecodeStep String CodecFailure m a
forall bytes failure (m :: * -> *) a.
(Maybe bytes -> m (DecodeStep bytes failure m a))
-> DecodeStep bytes failure m a
DecodePartial ((Maybe String -> m (DecodeStep String CodecFailure m a))
 -> DecodeStep String CodecFailure m a)
-> (Maybe String -> m (DecodeStep String CodecFailure m a))
-> DecodeStep String CodecFailure m a
forall a b. (a -> b) -> a -> b
$ \Maybe String
mchunk ->
        case Maybe String
mchunk of
          Maybe String
Nothing    -> DecodeStep String CodecFailure m a
-> m (DecodeStep String CodecFailure m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep String CodecFailure m a
 -> m (DecodeStep String CodecFailure m a))
-> DecodeStep String CodecFailure m a
-> m (DecodeStep String CodecFailure m a)
forall a b. (a -> b) -> a -> b
$ CodecFailure -> DecodeStep String CodecFailure m a
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail CodecFailure
CodecFailureOutOfInput
          Just String
chunk ->
            case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
terminator) String
chunk of
              (String
c, Char
_:String
c') -> DecodeStep String CodecFailure m a
-> m (DecodeStep String CodecFailure m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep String CodecFailure m a
 -> m (DecodeStep String CodecFailure m a))
-> DecodeStep String CodecFailure m a
-> m (DecodeStep String CodecFailure m a)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> DecodeStep String CodecFailure m a
k ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> [String]
forall a. [a] -> [a]
reverse (String
cString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
chunks)))
                                      (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
c' then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
c)
              (String, String)
_         -> [String] -> m (DecodeStep String CodecFailure m a)
go (String
chunk String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
chunks)