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

module Network.TypedProtocol.PingPong.Codec where

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


codecPingPong
  :: forall m. Monad m
  => Codec PingPong CodecFailure m String
codecPingPong :: forall (m :: * -> *).
Monad m =>
Codec PingPong CodecFailure m String
codecPingPong =
    Codec{Message PingPong st st' -> String
forall (st :: PingPong) (st' :: PingPong).
Message PingPong st st' -> String
forall (st :: PingPong) (st' :: PingPong).
(StateTokenI st, ActiveState st) =>
Message PingPong st st' -> String
encode :: forall (st :: PingPong) (st' :: PingPong).
Message PingPong st st' -> String
encode :: forall (st :: PingPong) (st' :: PingPong).
(StateTokenI st, ActiveState st) =>
Message PingPong st st' -> String
encode, StateToken st
-> m (DecodeStep String CodecFailure m (SomeMessage st))
forall (st :: PingPong).
ActiveState st =>
StateToken st
-> m (DecodeStep String CodecFailure m (SomeMessage st))
decode :: forall (st :: PingPong).
ActiveState st =>
StateToken st
-> m (DecodeStep String CodecFailure m (SomeMessage st))
decode :: forall (st :: PingPong).
ActiveState st =>
StateToken st
-> m (DecodeStep String CodecFailure m (SomeMessage st))
decode}
  where
    encode :: forall (st :: PingPong) (st' :: PingPong).
              Message PingPong st st'
           -> String
    encode :: forall (st :: PingPong) (st' :: PingPong).
Message PingPong st st' -> String
encode Message PingPong st st'
R:MessagePingPongfromto st st'
MsgPing = String
"ping\n"
    encode Message PingPong st st'
R:MessagePingPongfromto st st'
MsgDone = String
"done\n"
    encode Message PingPong st st'
R:MessagePingPongfromto st st'
MsgPong = String
"pong\n"

    decode :: forall (st :: PingPong).
              ActiveState st
           => StateToken st
           -> m (DecodeStep String CodecFailure m (SomeMessage st))
    decode :: forall (st :: PingPong).
ActiveState st =>
StateToken st
-> m (DecodeStep String CodecFailure m (SomeMessage st))
decode StateToken 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 (StateToken st
SPingPong st
stok, String
str) of
          (SPingPong st
SingBusy, String
"pong") ->
            SomeMessage st
-> Maybe String
-> DecodeStep String CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message PingPong st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message PingPong st 'StIdle
Message PingPong 'StBusy 'StIdle
MsgPong) Maybe String
trailing
          (SPingPong st
SingIdle, String
"ping") ->
            SomeMessage st
-> Maybe String
-> DecodeStep String CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message PingPong st 'StBusy -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message PingPong st 'StBusy
Message PingPong 'StIdle 'StBusy
MsgPing) Maybe String
trailing
          (SPingPong st
SingIdle, String
"done") ->
            SomeMessage st
-> Maybe String
-> DecodeStep String CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message PingPong st 'StDone -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message PingPong st 'StDone
Message PingPong 'StIdle 'StDone
MsgDone) Maybe String
trailing

          (SPingPong 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)


decodeTerminatedFrame :: forall m a.
                         Monad m
                      => Char
                      -> (String -> Maybe String -> DecodeStep String CodecFailure m a)
                      -> m (DecodeStep String CodecFailure m a)
decodeTerminatedFrame :: forall (m :: * -> *) a.
Monad m =>
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 a. a -> 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 a. a -> 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 a. a -> 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 a. [a] -> 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)



codecPingPongId
  :: forall m. Monad m
  => Codec PingPong CodecFailure m (AnyMessage PingPong)
codecPingPongId :: forall (m :: * -> *).
Monad m =>
Codec PingPong CodecFailure m (AnyMessage PingPong)
codecPingPongId =
    Codec{Message PingPong st st' -> AnyMessage PingPong
forall (st :: PingPong) (st' :: PingPong).
(StateTokenI st, ActiveState st) =>
Message PingPong st st' -> AnyMessage PingPong
encode :: forall (st :: PingPong) (st' :: PingPong).
(StateTokenI st, ActiveState st) =>
Message PingPong st st' -> AnyMessage PingPong
encode :: forall (st :: PingPong) (st' :: PingPong).
(StateTokenI st, ActiveState st) =>
Message PingPong st st' -> AnyMessage PingPong
encode,StateToken st
-> m (DecodeStep
        (AnyMessage PingPong) CodecFailure m (SomeMessage st))
forall (st :: PingPong).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage PingPong) CodecFailure m (SomeMessage st))
decode :: forall (st :: PingPong).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage PingPong) CodecFailure m (SomeMessage st))
decode :: forall (st :: PingPong).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage PingPong) CodecFailure m (SomeMessage st))
decode}
  where
    encode :: forall (st :: PingPong) (st' :: PingPong)
           .  ( StateTokenI st
              , ActiveState st
              )
           => Message PingPong st st'
           -> AnyMessage PingPong
    encode :: forall (st :: PingPong) (st' :: PingPong).
(StateTokenI st, ActiveState st) =>
Message PingPong st st' -> AnyMessage PingPong
encode Message PingPong st st'
msg = Message PingPong st st' -> AnyMessage PingPong
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage Message PingPong st st'
msg

    decode :: forall (st :: PingPong).
              ActiveState st
           => StateToken st
           -> m (DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st))
    decode :: forall (st :: PingPong).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage PingPong) CodecFailure m (SomeMessage st))
decode StateToken st
stok =
      DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
-> m (DecodeStep
        (AnyMessage PingPong) CodecFailure m (SomeMessage st))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
 -> m (DecodeStep
         (AnyMessage PingPong) CodecFailure m (SomeMessage st)))
-> DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
-> m (DecodeStep
        (AnyMessage PingPong) CodecFailure m (SomeMessage st))
forall a b. (a -> b) -> a -> b
$ (Maybe (AnyMessage PingPong)
 -> m (DecodeStep
         (AnyMessage PingPong) CodecFailure m (SomeMessage st)))
-> DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
(Maybe bytes -> m (DecodeStep bytes failure m a))
-> DecodeStep bytes failure m a
DecodePartial ((Maybe (AnyMessage PingPong)
  -> m (DecodeStep
          (AnyMessage PingPong) CodecFailure m (SomeMessage st)))
 -> DecodeStep
      (AnyMessage PingPong) CodecFailure m (SomeMessage st))
-> (Maybe (AnyMessage PingPong)
    -> m (DecodeStep
            (AnyMessage PingPong) CodecFailure m (SomeMessage st)))
-> DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
forall a b. (a -> b) -> a -> b
$ \Maybe (AnyMessage PingPong)
mb ->
        case Maybe (AnyMessage PingPong)
mb of
          Maybe (AnyMessage PingPong)
Nothing -> DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
-> m (DecodeStep
        (AnyMessage PingPong) CodecFailure m (SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
 -> m (DecodeStep
         (AnyMessage PingPong) CodecFailure m (SomeMessage st)))
-> DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
-> m (DecodeStep
        (AnyMessage PingPong) CodecFailure m (SomeMessage st))
forall a b. (a -> b) -> a -> b
$ CodecFailure
-> DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail (String -> CodecFailure
CodecFailure String
"expected more data")
          Just (AnyMessage Message PingPong st st'
msg) -> DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
-> m (DecodeStep
        (AnyMessage PingPong) CodecFailure m (SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
 -> m (DecodeStep
         (AnyMessage PingPong) CodecFailure m (SomeMessage st)))
-> DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
-> m (DecodeStep
        (AnyMessage PingPong) CodecFailure m (SomeMessage st))
forall a b. (a -> b) -> a -> b
$
            case (StateToken st
SPingPong st
stok, Message PingPong st st'
msg) of
              (SPingPong st
SingBusy, Message PingPong st st'
R:MessagePingPongfromto st st'
MsgPong) ->
                SomeMessage st
-> Maybe (AnyMessage PingPong)
-> DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message PingPong st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message PingPong st st'
Message PingPong st st'
msg) Maybe (AnyMessage PingPong)
forall a. Maybe a
Nothing
              (SPingPong st
SingIdle, Message PingPong st st'
R:MessagePingPongfromto st st'
MsgPing) ->
                SomeMessage st
-> Maybe (AnyMessage PingPong)
-> DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message PingPong st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message PingPong st st'
Message PingPong st st'
msg) Maybe (AnyMessage PingPong)
forall a. Maybe a
Nothing
              (SPingPong st
SingIdle, Message PingPong st st'
R:MessagePingPongfromto st st'
MsgDone) ->
                SomeMessage st
-> Maybe (AnyMessage PingPong)
-> DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message PingPong st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message PingPong st st'
Message PingPong st st'
msg) Maybe (AnyMessage PingPong)
forall a. Maybe a
Nothing

              (SPingPong st
SingIdle, Message PingPong st st'
_) ->
                CodecFailure
-> DecodeStep (AnyMessage PingPong) 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]
++ Message PingPong st st' -> String
forall a. Show a => a -> String
show Message PingPong st st'
msg)
              (SPingPong st
SingBusy, Message PingPong st st'
_) ->
                CodecFailure
-> DecodeStep (AnyMessage PingPong) 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]
++ Message PingPong st st' -> String
forall a. Show a => a -> String
show Message PingPong st st'
msg)

              (a :: SPingPong st
a@SPingPong st
SingDone, Message PingPong st st'
_) -> StateToken 'StDone -> forall a. a
forall ps (st :: ps).
(StateAgency st ~ 'NobodyAgency, ActiveState st) =>
StateToken st -> forall a. a
notActiveState StateToken 'StDone
SPingPong st
a