{-# LANGUAGE DeriveAnyClass #-}

module Hercules.API.Agent.Socket.Frame where

import Control.Applicative
import Data.Void (Void)
import Hercules.API.Prelude

-- | Adds serial number 'n' to payloads 'p' and allows acknowledgement for
-- a related stream that travels in the opposite direction.
data Frame o a
  = -- | Message
    Msg {Frame o a -> Integer
n :: Integer, Frame o a -> a
p :: a}
  | -- | Out of band message: not redelivered, not acknowledged.
    Oob {Frame o a -> o
o :: o}
  | -- | Acknowledgement
    Ack {n :: Integer}
  | -- | Exception
    Exception {Frame o a -> Text
message :: Text}
  deriving ((forall x. Frame o a -> Rep (Frame o a) x)
-> (forall x. Rep (Frame o a) x -> Frame o a)
-> Generic (Frame o a)
forall x. Rep (Frame o a) x -> Frame o a
forall x. Frame o a -> Rep (Frame o a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall o a x. Rep (Frame o a) x -> Frame o a
forall o a x. Frame o a -> Rep (Frame o a) x
$cto :: forall o a x. Rep (Frame o a) x -> Frame o a
$cfrom :: forall o a x. Frame o a -> Rep (Frame o a) x
Generic, Int -> Frame o a -> ShowS
[Frame o a] -> ShowS
Frame o a -> String
(Int -> Frame o a -> ShowS)
-> (Frame o a -> String)
-> ([Frame o a] -> ShowS)
-> Show (Frame o a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall o a. (Show a, Show o) => Int -> Frame o a -> ShowS
forall o a. (Show a, Show o) => [Frame o a] -> ShowS
forall o a. (Show a, Show o) => Frame o a -> String
showList :: [Frame o a] -> ShowS
$cshowList :: forall o a. (Show a, Show o) => [Frame o a] -> ShowS
show :: Frame o a -> String
$cshow :: forall o a. (Show a, Show o) => Frame o a -> String
showsPrec :: Int -> Frame o a -> ShowS
$cshowsPrec :: forall o a. (Show a, Show o) => Int -> Frame o a -> ShowS
Show, Frame o a -> Frame o a -> Bool
(Frame o a -> Frame o a -> Bool)
-> (Frame o a -> Frame o a -> Bool) -> Eq (Frame o a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall o a. (Eq a, Eq o) => Frame o a -> Frame o a -> Bool
/= :: Frame o a -> Frame o a -> Bool
$c/= :: forall o a. (Eq a, Eq o) => Frame o a -> Frame o a -> Bool
== :: Frame o a -> Frame o a -> Bool
$c== :: forall o a. (Eq a, Eq o) => Frame o a -> Frame o a -> Bool
Eq, Frame o a -> ()
(Frame o a -> ()) -> NFData (Frame o a)
forall a. (a -> ()) -> NFData a
forall o a. (NFData a, NFData o) => Frame o a -> ()
rnf :: Frame o a -> ()
$crnf :: forall o a. (NFData a, NFData o) => Frame o a -> ()
NFData, [Frame o a] -> Encoding
[Frame o a] -> Value
Frame o a -> Encoding
Frame o a -> Value
(Frame o a -> Value)
-> (Frame o a -> Encoding)
-> ([Frame o a] -> Value)
-> ([Frame o a] -> Encoding)
-> ToJSON (Frame o a)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall o a. (ToJSON o, ToJSON a) => [Frame o a] -> Encoding
forall o a. (ToJSON o, ToJSON a) => [Frame o a] -> Value
forall o a. (ToJSON o, ToJSON a) => Frame o a -> Encoding
forall o a. (ToJSON o, ToJSON a) => Frame o a -> Value
toEncodingList :: [Frame o a] -> Encoding
$ctoEncodingList :: forall o a. (ToJSON o, ToJSON a) => [Frame o a] -> Encoding
toJSONList :: [Frame o a] -> Value
$ctoJSONList :: forall o a. (ToJSON o, ToJSON a) => [Frame o a] -> Value
toEncoding :: Frame o a -> Encoding
$ctoEncoding :: forall o a. (ToJSON o, ToJSON a) => Frame o a -> Encoding
toJSON :: Frame o a -> Value
$ctoJSON :: forall o a. (ToJSON o, ToJSON a) => Frame o a -> Value
ToJSON, Value -> Parser [Frame o a]
Value -> Parser (Frame o a)
(Value -> Parser (Frame o a))
-> (Value -> Parser [Frame o a]) -> FromJSON (Frame o a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall o a. (FromJSON a, FromJSON o) => Value -> Parser [Frame o a]
forall o a. (FromJSON a, FromJSON o) => Value -> Parser (Frame o a)
parseJSONList :: Value -> Parser [Frame o a]
$cparseJSONList :: forall o a. (FromJSON a, FromJSON o) => Value -> Parser [Frame o a]
parseJSON :: Value -> Parser (Frame o a)
$cparseJSON :: forall o a. (FromJSON a, FromJSON o) => Value -> Parser (Frame o a)
FromJSON)

mapOob :: (a -> b) -> Frame a c -> Frame b c
mapOob :: (a -> b) -> Frame a c -> Frame b c
mapOob a -> b
f (Oob a
a) = b -> Frame b c
forall o a. o -> Frame o a
Oob (a -> b
f a
a)
mapOob a -> b
_ (Msg Integer
a c
b) = Integer -> c -> Frame b c
forall o a. Integer -> a -> Frame o a
Msg Integer
a c
b
mapOob a -> b
_ (Ack Integer
a) = Integer -> Frame b c
forall o a. Integer -> Frame o a
Ack Integer
a
mapOob a -> b
_ (Exception Text
e) = Text -> Frame b c
forall o a. Text -> Frame o a
Exception Text
e

removeOob :: Alternative f => Frame o a -> f (Frame Void a)
removeOob :: Frame o a -> f (Frame Void a)
removeOob (Msg Integer
a a
b) = Frame Void a -> f (Frame Void a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Frame Void a -> f (Frame Void a))
-> Frame Void a -> f (Frame Void a)
forall a b. (a -> b) -> a -> b
$ Integer -> a -> Frame Void a
forall o a. Integer -> a -> Frame o a
Msg Integer
a a
b
removeOob (Ack Integer
a) = Frame Void a -> f (Frame Void a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Frame Void a -> f (Frame Void a))
-> Frame Void a -> f (Frame Void a)
forall a b. (a -> b) -> a -> b
$ Integer -> Frame Void a
forall o a. Integer -> Frame o a
Ack Integer
a
removeOob (Oob {}) = f (Frame Void a)
forall (f :: * -> *) a. Alternative f => f a
empty
removeOob (Exception Text
e) = Frame Void a -> f (Frame Void a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Frame Void a -> f (Frame Void a))
-> Frame Void a -> f (Frame Void a)
forall a b. (a -> b) -> a -> b
$ Text -> Frame Void a
forall o a. Text -> Frame o a
Exception Text
e