{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}

module Network.TypedProtocol.Documentation.Types
( AgencyID (..)
, StateRef (..)
, ProtocolDescription (..)
, MessageDescription (..)
, Description (..)
)
where

import Data.SerDoc.Info
import Language.Haskell.TH.Syntax
import Data.Aeson

-- | Represents agency at the term level. Used to indicate which side has
-- agency in a particular protocol state.
data AgencyID
  = ClientAgencyID
  | ServerAgencyID
  | NobodyAgencyID
  deriving (Int -> AgencyID -> ShowS
[AgencyID] -> ShowS
AgencyID -> String
(Int -> AgencyID -> ShowS)
-> (AgencyID -> String) -> ([AgencyID] -> ShowS) -> Show AgencyID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgencyID -> ShowS
showsPrec :: Int -> AgencyID -> ShowS
$cshow :: AgencyID -> String
show :: AgencyID -> String
$cshowList :: [AgencyID] -> ShowS
showList :: [AgencyID] -> ShowS
Show, ReadPrec [AgencyID]
ReadPrec AgencyID
Int -> ReadS AgencyID
ReadS [AgencyID]
(Int -> ReadS AgencyID)
-> ReadS [AgencyID]
-> ReadPrec AgencyID
-> ReadPrec [AgencyID]
-> Read AgencyID
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AgencyID
readsPrec :: Int -> ReadS AgencyID
$creadList :: ReadS [AgencyID]
readList :: ReadS [AgencyID]
$creadPrec :: ReadPrec AgencyID
readPrec :: ReadPrec AgencyID
$creadListPrec :: ReadPrec [AgencyID]
readListPrec :: ReadPrec [AgencyID]
Read, Eq AgencyID
Eq AgencyID =>
(AgencyID -> AgencyID -> Ordering)
-> (AgencyID -> AgencyID -> Bool)
-> (AgencyID -> AgencyID -> Bool)
-> (AgencyID -> AgencyID -> Bool)
-> (AgencyID -> AgencyID -> Bool)
-> (AgencyID -> AgencyID -> AgencyID)
-> (AgencyID -> AgencyID -> AgencyID)
-> Ord AgencyID
AgencyID -> AgencyID -> Bool
AgencyID -> AgencyID -> Ordering
AgencyID -> AgencyID -> AgencyID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AgencyID -> AgencyID -> Ordering
compare :: AgencyID -> AgencyID -> Ordering
$c< :: AgencyID -> AgencyID -> Bool
< :: AgencyID -> AgencyID -> Bool
$c<= :: AgencyID -> AgencyID -> Bool
<= :: AgencyID -> AgencyID -> Bool
$c> :: AgencyID -> AgencyID -> Bool
> :: AgencyID -> AgencyID -> Bool
$c>= :: AgencyID -> AgencyID -> Bool
>= :: AgencyID -> AgencyID -> Bool
$cmax :: AgencyID -> AgencyID -> AgencyID
max :: AgencyID -> AgencyID -> AgencyID
$cmin :: AgencyID -> AgencyID -> AgencyID
min :: AgencyID -> AgencyID -> AgencyID
Ord, AgencyID -> AgencyID -> Bool
(AgencyID -> AgencyID -> Bool)
-> (AgencyID -> AgencyID -> Bool) -> Eq AgencyID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AgencyID -> AgencyID -> Bool
== :: AgencyID -> AgencyID -> Bool
$c/= :: AgencyID -> AgencyID -> Bool
/= :: AgencyID -> AgencyID -> Bool
Eq, Int -> AgencyID
AgencyID -> Int
AgencyID -> [AgencyID]
AgencyID -> AgencyID
AgencyID -> AgencyID -> [AgencyID]
AgencyID -> AgencyID -> AgencyID -> [AgencyID]
(AgencyID -> AgencyID)
-> (AgencyID -> AgencyID)
-> (Int -> AgencyID)
-> (AgencyID -> Int)
-> (AgencyID -> [AgencyID])
-> (AgencyID -> AgencyID -> [AgencyID])
-> (AgencyID -> AgencyID -> [AgencyID])
-> (AgencyID -> AgencyID -> AgencyID -> [AgencyID])
-> Enum AgencyID
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: AgencyID -> AgencyID
succ :: AgencyID -> AgencyID
$cpred :: AgencyID -> AgencyID
pred :: AgencyID -> AgencyID
$ctoEnum :: Int -> AgencyID
toEnum :: Int -> AgencyID
$cfromEnum :: AgencyID -> Int
fromEnum :: AgencyID -> Int
$cenumFrom :: AgencyID -> [AgencyID]
enumFrom :: AgencyID -> [AgencyID]
$cenumFromThen :: AgencyID -> AgencyID -> [AgencyID]
enumFromThen :: AgencyID -> AgencyID -> [AgencyID]
$cenumFromTo :: AgencyID -> AgencyID -> [AgencyID]
enumFromTo :: AgencyID -> AgencyID -> [AgencyID]
$cenumFromThenTo :: AgencyID -> AgencyID -> AgencyID -> [AgencyID]
enumFromThenTo :: AgencyID -> AgencyID -> AgencyID -> [AgencyID]
Enum, AgencyID
AgencyID -> AgencyID -> Bounded AgencyID
forall a. a -> a -> Bounded a
$cminBound :: AgencyID
minBound :: AgencyID
$cmaxBound :: AgencyID
maxBound :: AgencyID
Bounded, (forall (m :: * -> *). Quote m => AgencyID -> m Exp)
-> (forall (m :: * -> *). Quote m => AgencyID -> Code m AgencyID)
-> Lift AgencyID
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => AgencyID -> m Exp
forall (m :: * -> *). Quote m => AgencyID -> Code m AgencyID
$clift :: forall (m :: * -> *). Quote m => AgencyID -> m Exp
lift :: forall (m :: * -> *). Quote m => AgencyID -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => AgencyID -> Code m AgencyID
liftTyped :: forall (m :: * -> *). Quote m => AgencyID -> Code m AgencyID
Lift)

instance ToJSON AgencyID where
  toJSON :: AgencyID -> Value
toJSON AgencyID
ClientAgencyID = Value
"client"
  toJSON AgencyID
ServerAgencyID = Value
"server"
  toJSON AgencyID
NobodyAgencyID = Value
"nobody"

data StateRef
  = AnyState
  | State !String
  deriving (Int -> StateRef -> ShowS
[StateRef] -> ShowS
StateRef -> String
(Int -> StateRef -> ShowS)
-> (StateRef -> String) -> ([StateRef] -> ShowS) -> Show StateRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StateRef -> ShowS
showsPrec :: Int -> StateRef -> ShowS
$cshow :: StateRef -> String
show :: StateRef -> String
$cshowList :: [StateRef] -> ShowS
showList :: [StateRef] -> ShowS
Show, ReadPrec [StateRef]
ReadPrec StateRef
Int -> ReadS StateRef
ReadS [StateRef]
(Int -> ReadS StateRef)
-> ReadS [StateRef]
-> ReadPrec StateRef
-> ReadPrec [StateRef]
-> Read StateRef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StateRef
readsPrec :: Int -> ReadS StateRef
$creadList :: ReadS [StateRef]
readList :: ReadS [StateRef]
$creadPrec :: ReadPrec StateRef
readPrec :: ReadPrec StateRef
$creadListPrec :: ReadPrec [StateRef]
readListPrec :: ReadPrec [StateRef]
Read, Eq StateRef
Eq StateRef =>
(StateRef -> StateRef -> Ordering)
-> (StateRef -> StateRef -> Bool)
-> (StateRef -> StateRef -> Bool)
-> (StateRef -> StateRef -> Bool)
-> (StateRef -> StateRef -> Bool)
-> (StateRef -> StateRef -> StateRef)
-> (StateRef -> StateRef -> StateRef)
-> Ord StateRef
StateRef -> StateRef -> Bool
StateRef -> StateRef -> Ordering
StateRef -> StateRef -> StateRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StateRef -> StateRef -> Ordering
compare :: StateRef -> StateRef -> Ordering
$c< :: StateRef -> StateRef -> Bool
< :: StateRef -> StateRef -> Bool
$c<= :: StateRef -> StateRef -> Bool
<= :: StateRef -> StateRef -> Bool
$c> :: StateRef -> StateRef -> Bool
> :: StateRef -> StateRef -> Bool
$c>= :: StateRef -> StateRef -> Bool
>= :: StateRef -> StateRef -> Bool
$cmax :: StateRef -> StateRef -> StateRef
max :: StateRef -> StateRef -> StateRef
$cmin :: StateRef -> StateRef -> StateRef
min :: StateRef -> StateRef -> StateRef
Ord, StateRef -> StateRef -> Bool
(StateRef -> StateRef -> Bool)
-> (StateRef -> StateRef -> Bool) -> Eq StateRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StateRef -> StateRef -> Bool
== :: StateRef -> StateRef -> Bool
$c/= :: StateRef -> StateRef -> Bool
/= :: StateRef -> StateRef -> Bool
Eq)

instance ToJSON StateRef where
  toJSON :: StateRef -> Value
toJSON StateRef
AnyState = Value
Null
  toJSON (State String
str) = String -> Value
forall a. ToJSON a => a -> Value
toJSON String
str

-- | Term-level representation of a typed protocol.
data ProtocolDescription codec =
  ProtocolDescription
    { forall codec. ProtocolDescription codec -> String
protocolName :: String
      -- ^ Human-readable protocol name
    , forall codec. ProtocolDescription codec -> [Description]
protocolDescription :: [Description]
    , forall codec. ProtocolDescription codec -> String
protocolIdentifier :: String
      -- ^ Machine-readable identifier, may be used for things like protocol
      -- version negotiation.
    , forall codec.
ProtocolDescription codec -> [(StateRef, [Description], AgencyID)]
protocolStates :: [(StateRef, [Description], AgencyID)]
      -- ^ List of the protocol's possible states, each entry being a state ID,
      -- a human-readable description, and an indication of agency (client or
      -- server).
    , forall codec.
ProtocolDescription codec -> [MessageDescription codec]
protocolMessages :: [MessageDescription codec]
    }
    deriving (Int -> ProtocolDescription codec -> ShowS
[ProtocolDescription codec] -> ShowS
ProtocolDescription codec -> String
(Int -> ProtocolDescription codec -> ShowS)
-> (ProtocolDescription codec -> String)
-> ([ProtocolDescription codec] -> ShowS)
-> Show (ProtocolDescription codec)
forall codec. Int -> ProtocolDescription codec -> ShowS
forall codec. [ProtocolDescription codec] -> ShowS
forall codec. ProtocolDescription codec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall codec. Int -> ProtocolDescription codec -> ShowS
showsPrec :: Int -> ProtocolDescription codec -> ShowS
$cshow :: forall codec. ProtocolDescription codec -> String
show :: ProtocolDescription codec -> String
$cshowList :: forall codec. [ProtocolDescription codec] -> ShowS
showList :: [ProtocolDescription codec] -> ShowS
Show)

instance ToJSON (ProtocolDescription codec) where
  toJSON :: ProtocolDescription codec -> Value
toJSON ProtocolDescription codec
p = [Pair] -> Value
object
    [ Key
"name" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ProtocolDescription codec -> String
forall codec. ProtocolDescription codec -> String
protocolName ProtocolDescription codec
p
    , Key
"description" Key -> [[String]] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Description -> [String]) -> [Description] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map Description -> [String]
descriptionParagraphs (ProtocolDescription codec -> [Description]
forall codec. ProtocolDescription codec -> [Description]
protocolDescription ProtocolDescription codec
p)
    , Key
"identifier" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ProtocolDescription codec -> String
forall codec. ProtocolDescription codec -> String
protocolIdentifier ProtocolDescription codec
p
    , Key
"states" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=
        [ [Pair] -> Value
object
            [ Key
"id" Key -> StateRef -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StateRef
stateRef
            , Key
"description" Key -> [[String]] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Description -> [String]) -> [Description] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map Description -> [String]
descriptionParagraphs [Description]
desc
            , Key
"agency" Key -> AgencyID -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= AgencyID
agency
            ]
        | (StateRef
stateRef, [Description]
desc, AgencyID
agency) <- ProtocolDescription codec -> [(StateRef, [Description], AgencyID)]
forall codec.
ProtocolDescription codec -> [(StateRef, [Description], AgencyID)]
protocolStates ProtocolDescription codec
p
        ]
    , Key
"messages" Key -> [MessageDescription codec] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ProtocolDescription codec -> [MessageDescription codec]
forall codec.
ProtocolDescription codec -> [MessageDescription codec]
protocolMessages ProtocolDescription codec
p
    ]

-- | Term-level representation of a typed protocol message.
data MessageDescription codec =
  MessageDescription
    { forall codec. MessageDescription codec -> String
messageName :: String
    , forall codec. MessageDescription codec -> [Description]
messageDescription :: [Description]
    , forall codec. MessageDescription codec -> [String]
messagePayload :: [String]
      -- ^ List of payload values for this message (free-form descriptions or
      -- type names)
    , forall codec. MessageDescription codec -> StateRef
messageFromState :: StateRef
      -- ^ References a 'protocolState' in the parent 'ProtocolDescription' by
      -- name.
    , forall codec. MessageDescription codec -> StateRef
messageToState :: StateRef
      -- ^ References a 'protocolState' in the parent 'ProtocolDescription' by
      -- name.
    , forall codec. MessageDescription codec -> FieldInfo codec
messageInfo :: FieldInfo codec
    }
    deriving (Int -> MessageDescription codec -> ShowS
[MessageDescription codec] -> ShowS
MessageDescription codec -> String
(Int -> MessageDescription codec -> ShowS)
-> (MessageDescription codec -> String)
-> ([MessageDescription codec] -> ShowS)
-> Show (MessageDescription codec)
forall codec. Int -> MessageDescription codec -> ShowS
forall codec. [MessageDescription codec] -> ShowS
forall codec. MessageDescription codec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall codec. Int -> MessageDescription codec -> ShowS
showsPrec :: Int -> MessageDescription codec -> ShowS
$cshow :: forall codec. MessageDescription codec -> String
show :: MessageDescription codec -> String
$cshowList :: forall codec. [MessageDescription codec] -> ShowS
showList :: [MessageDescription codec] -> ShowS
Show)

instance ToJSON (MessageDescription codec) where
  toJSON :: MessageDescription codec -> Value
toJSON MessageDescription codec
m = [Pair] -> Value
object
    [ Key
"name" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MessageDescription codec -> String
forall codec. MessageDescription codec -> String
messageName MessageDescription codec
m
    , Key
"description" Key -> [[String]] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Description -> [String]) -> [Description] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map Description -> [String]
descriptionParagraphs (MessageDescription codec -> [Description]
forall codec. MessageDescription codec -> [Description]
messageDescription MessageDescription codec
m)
    , Key
"payload" Key -> [String] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MessageDescription codec -> [String]
forall codec. MessageDescription codec -> [String]
messagePayload MessageDescription codec
m
    , Key
"from-state" Key -> StateRef -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MessageDescription codec -> StateRef
forall codec. MessageDescription codec -> StateRef
messageFromState MessageDescription codec
m
    , Key
"to-state" Key -> StateRef -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MessageDescription codec -> StateRef
forall codec. MessageDescription codec -> StateRef
messageToState MessageDescription codec
m
    ]