{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeAbstractions #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module TypedSession.State.Type where

import Control.Monad
import Data.Kind (Constraint, Type)
import Prettyprinter
import Prettyprinter.Render.String (renderString)

type family XMsg eta
type family XLabel eta
type family XBranch eta
type family XBranchSt eta
type family XGoto eta
type family XTerminal eta

-- | ForallX
type ForallX (f :: Type -> Constraint) eta =
  (f (XMsg eta), f (XLabel eta), f (XBranch eta), f (XBranchSt eta), f (XGoto eta), f (XTerminal eta))

-- | BranchSt
data BranchSt eta r bst = BranchSt (XBranchSt eta) bst (Protocol eta r bst)
  deriving ((forall a b. (a -> b) -> BranchSt eta r a -> BranchSt eta r b)
-> (forall a b. a -> BranchSt eta r b -> BranchSt eta r a)
-> Functor (BranchSt eta r)
forall a b. a -> BranchSt eta r b -> BranchSt eta r a
forall a b. (a -> b) -> BranchSt eta r a -> BranchSt eta r b
forall eta r a b. a -> BranchSt eta r b -> BranchSt eta r a
forall eta r a b. (a -> b) -> BranchSt eta r a -> BranchSt eta r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall eta r a b. (a -> b) -> BranchSt eta r a -> BranchSt eta r b
fmap :: forall a b. (a -> b) -> BranchSt eta r a -> BranchSt eta r b
$c<$ :: forall eta r a b. a -> BranchSt eta r b -> BranchSt eta r a
<$ :: forall a b. a -> BranchSt eta r b -> BranchSt eta r a
Functor)

-- | MsgOrLabel
data MsgOrLabel eta r
  = Msg (XMsg eta) String [String] r r
  | Label (XLabel eta) Int
  deriving ((forall a b. (a -> b) -> MsgOrLabel eta a -> MsgOrLabel eta b)
-> (forall a b. a -> MsgOrLabel eta b -> MsgOrLabel eta a)
-> Functor (MsgOrLabel eta)
forall a b. a -> MsgOrLabel eta b -> MsgOrLabel eta a
forall a b. (a -> b) -> MsgOrLabel eta a -> MsgOrLabel eta b
forall eta a b. a -> MsgOrLabel eta b -> MsgOrLabel eta a
forall eta a b. (a -> b) -> MsgOrLabel eta a -> MsgOrLabel eta b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall eta a b. (a -> b) -> MsgOrLabel eta a -> MsgOrLabel eta b
fmap :: forall a b. (a -> b) -> MsgOrLabel eta a -> MsgOrLabel eta b
$c<$ :: forall eta a b. a -> MsgOrLabel eta b -> MsgOrLabel eta a
<$ :: forall a b. a -> MsgOrLabel eta b -> MsgOrLabel eta a
Functor)

infixr 5 :>

-- | Protocol
data Protocol eta r bst
  = (MsgOrLabel eta r) :> (Protocol eta r bst)
  | Branch (XBranch eta) r [BranchSt eta r bst]
  | Goto (XGoto eta) Int
  | Terminal (XTerminal eta)
  deriving ((forall a b. (a -> b) -> Protocol eta r a -> Protocol eta r b)
-> (forall a b. a -> Protocol eta r b -> Protocol eta r a)
-> Functor (Protocol eta r)
forall a b. a -> Protocol eta r b -> Protocol eta r a
forall a b. (a -> b) -> Protocol eta r a -> Protocol eta r b
forall eta r a b. a -> Protocol eta r b -> Protocol eta r a
forall eta r a b. (a -> b) -> Protocol eta r a -> Protocol eta r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall eta r a b. (a -> b) -> Protocol eta r a -> Protocol eta r b
fmap :: forall a b. (a -> b) -> Protocol eta r a -> Protocol eta r b
$c<$ :: forall eta r a b. a -> Protocol eta r b -> Protocol eta r a
<$ :: forall a b. a -> Protocol eta r b -> Protocol eta r a
Functor)

-- | XTraverse
type XTraverse m eta gama r bst =
  ( (XMsg eta, (String, [String], r, r, Protocol eta r bst)) -> m (XMsg gama)
  , (XLabel eta, (Int, Protocol eta r bst)) -> m (XLabel gama)
  , (XBranch eta, (r, [BranchSt eta r bst]))
    -> m
        ( XBranch gama
        , m (Protocol gama r bst) -> m (Protocol gama r bst)
        )
  , (XBranchSt eta, (bst, Protocol eta r bst)) -> m (XBranchSt gama)
  , (XGoto eta, Int) -> m (XGoto gama)
  , (XTerminal eta) -> m (XTerminal gama)
  )

-- | xtraverse
xtraverse
  :: (Monad m)
  => XTraverse m eta gama r bst
  -> Protocol eta r bst
  -> m (Protocol gama r bst)
xtraverse :: forall (m :: * -> *) eta gama r bst.
Monad m =>
XTraverse m eta gama r bst
-> Protocol eta r bst -> m (Protocol gama r bst)
xtraverse xt :: XTraverse m eta gama r bst
xt@((XMsg eta, (String, [String], r, r, Protocol eta r bst))
-> m (XMsg gama)
xmsg, (XLabel eta, (Int, Protocol eta r bst)) -> m (XLabel gama)
xlabel, (XBranch eta, (r, [BranchSt eta r bst]))
-> m (XBranch gama,
      m (Protocol gama r bst) -> m (Protocol gama r bst))
xbranch, (XBranchSt eta, (bst, Protocol eta r bst)) -> m (XBranchSt gama)
xbranchSt, (XGoto eta, Int) -> m (XGoto gama)
xgoto, XTerminal eta -> m (XTerminal gama)
xterminal) Protocol eta r bst
prot = case Protocol eta r bst
prot of
  MsgOrLabel eta r
msgOrLabel :> Protocol eta r bst
prots -> do
    res <- case MsgOrLabel eta r
msgOrLabel of
      Msg XMsg eta
xv String
a [String]
b r
c r
d -> do
        xv' <- (XMsg eta, (String, [String], r, r, Protocol eta r bst))
-> m (XMsg gama)
xmsg (XMsg eta
xv, (String
a, [String]
b, r
c, r
d, Protocol eta r bst
prots))
        pure (Msg xv' a b c d)
      Label XLabel eta
xv Int
i -> do
        xv' <- (XLabel eta, (Int, Protocol eta r bst)) -> m (XLabel gama)
xlabel (XLabel eta
xv, (Int
i, Protocol eta r bst
prots))
        pure (Label xv' i)
    prots' <- xtraverse xt prots
    pure (res :> prots')
  Branch XBranch eta
xv r
r [BranchSt eta r bst]
ls -> do
    (xv', wrapper) <- (XBranch eta, (r, [BranchSt eta r bst]))
-> m (XBranch gama,
      m (Protocol gama r bst) -> m (Protocol gama r bst))
xbranch (XBranch eta
xv, (r
r, [BranchSt eta r bst]
ls))
    ls' <- forM ls $ \(BranchSt XBranchSt eta
xbst bst
bst Protocol eta r bst
prot1) -> do
      xbst' <- (XBranchSt eta, (bst, Protocol eta r bst)) -> m (XBranchSt gama)
xbranchSt (XBranchSt eta
xbst, (bst
bst, Protocol eta r bst
prot1))
      prot' <- wrapper $ xtraverse xt prot1
      pure (BranchSt xbst' bst prot')
    pure (Branch xv' r ls')
  Goto XGoto eta
xv Int
i -> do
    xv' <- (XGoto eta, Int) -> m (XGoto gama)
xgoto (XGoto eta
xv, Int
i)
    pure (Goto xv' i)
  Terminal XTerminal eta
xv -> do
    xv' <- XTerminal eta -> m (XTerminal gama)
xterminal XTerminal eta
xv
    pure (Terminal xv')

-- | XFold
type XFold m eta r bst =
  ( (XMsg eta, (String, [String], r, r, Protocol eta r bst)) -> m ()
  , (XLabel eta, Int) -> m ()
  , (XBranch eta, (r, [BranchSt eta r bst])) -> m (m () -> m ())
  , (XBranchSt eta, (bst, Protocol eta r bst)) -> m ()
  , (XGoto eta, Int) -> m ()
  , (XTerminal eta) -> m ()
  )

-- | xfold
xfold :: (Monad m) => XFold m eta r bst -> Protocol eta r bst -> m ()
xfold :: forall (m :: * -> *) eta r bst.
Monad m =>
XFold m eta r bst -> Protocol eta r bst -> m ()
xfold xt :: XFold m eta r bst
xt@((XMsg eta, (String, [String], r, r, Protocol eta r bst)) -> m ()
xmsg, (XLabel eta, Int) -> m ()
xlabel, (XBranch eta, (r, [BranchSt eta r bst])) -> m (m () -> m ())
xbranch, (XBranchSt eta, (bst, Protocol eta r bst)) -> m ()
xbranchst, (XGoto eta, Int) -> m ()
xgoto, XTerminal eta -> m ()
xterminal) Protocol eta r bst
prot = case Protocol eta r bst
prot of
  MsgOrLabel eta r
msgOrLabel :> Protocol eta r bst
prots -> do
    case MsgOrLabel eta r
msgOrLabel of
      Msg XMsg eta
xv String
a [String]
b r
c r
d -> (XMsg eta, (String, [String], r, r, Protocol eta r bst)) -> m ()
xmsg (XMsg eta
xv, (String
a, [String]
b, r
c, r
d, Protocol eta r bst
prots))
      Label XLabel eta
xv Int
i -> (XLabel eta, Int) -> m ()
xlabel (XLabel eta
xv, Int
i)
    XFold m eta r bst -> Protocol eta r bst -> m ()
forall (m :: * -> *) eta r bst.
Monad m =>
XFold m eta r bst -> Protocol eta r bst -> m ()
xfold XFold m eta r bst
xt Protocol eta r bst
prots
  Branch XBranch eta
xv r
r [BranchSt eta r bst]
ls -> do
    wrapper <- (XBranch eta, (r, [BranchSt eta r bst])) -> m (m () -> m ())
xbranch (XBranch eta
xv, (r
r, [BranchSt eta r bst]
ls))
    forM_ ls $ \(BranchSt XBranchSt eta
xbst bst
bst Protocol eta r bst
prot1) -> do
      (XBranchSt eta, (bst, Protocol eta r bst)) -> m ()
xbranchst (XBranchSt eta
xbst, (bst
bst, Protocol eta r bst
prot1))
      m () -> m ()
wrapper (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ XFold m eta r bst -> Protocol eta r bst -> m ()
forall (m :: * -> *) eta r bst.
Monad m =>
XFold m eta r bst -> Protocol eta r bst -> m ()
xfold XFold m eta r bst
xt Protocol eta r bst
prot1
  Goto XGoto eta
xv Int
i -> (XGoto eta, Int) -> m ()
xgoto (XGoto eta
xv, Int
i)
  Terminal XTerminal eta
xv -> XTerminal eta -> m ()
xterminal XTerminal eta
xv

-- | ProtocolError
data ProtocolError r bst
  = DefLabelMultTimes Int
  | LabelUndefined Int
  | BranchFirstMsgMustHaveTheSameSender r String r
  | UndecideStateCanNotSendMsg String
  | UndecideStateCanNotStartBranch [BranchSt (GenConst r) r bst]
  | TerminalNeedAllRoleDecide String
  | BranchAtLeastOneBranch

instance (Show r, Show bst) => Show (ProtocolError r bst) where
  show :: ProtocolError r bst -> String
show = \case
    DefLabelMultTimes Int
msgOrLabel -> String
"Defining Label multiple times: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
msgOrLabel
    LabelUndefined Int
prot -> String
"Label Undefined: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
prot
    BranchFirstMsgMustHaveTheSameSender r
psender String
msgName r
from ->
      String
"The first message of each branch must have the same sender. Sender: "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> r -> String
forall a. Show a => a -> String
show r
psender
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" But Msg: "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msgName
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'s sender is "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> r -> String
forall a. Show a => a -> String
show r
from
    UndecideStateCanNotSendMsg String
msgName -> String
"Msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msgName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" error, Undecide State can't send msg!"
    UndecideStateCanNotStartBranch [BranchSt (GenConst r) r bst]
brs -> String
"Undecide State can't start branch! " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [BranchSt (GenConst r) r bst] -> String
forall a. Show a => a -> String
show [BranchSt (GenConst r) r bst]
brs
    TerminalNeedAllRoleDecide String
msgName -> String
"Msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msgName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", Terminal need all role decide!"
    ProtocolError r bst
BranchAtLeastOneBranch -> String
"Branch at least one branch!"

------------------------

data Creat

type instance XMsg Creat = ()
type instance XLabel Creat = ()
type instance XBranch Creat = ()
type instance XBranchSt Creat = ()
type instance XGoto Creat = ()
type instance XTerminal Creat = ()

data Idx

type instance XMsg Idx = (Int, Int, Int)
type instance XLabel Idx = Int
type instance XBranch Idx = Int
type instance XBranchSt Idx = ()
type instance XGoto Idx = Int
type instance XTerminal Idx = Int

data AddNums

type instance XMsg AddNums = ([Int], [Int], Int)
type instance XLabel AddNums = [Int]
type instance XBranch AddNums = [Int]
type instance XBranchSt AddNums = ()
type instance XGoto AddNums = [Int]
type instance XTerminal AddNums = [Int]

data GenConst r

type instance XMsg (GenConst r) = (([Int], [Int]), (r, r), Int)
type instance XLabel (GenConst r) = ([Int], Int)
type instance XBranch (GenConst r) = [Int]
type instance XBranchSt (GenConst r) = ()
type instance XGoto (GenConst r) = ([Int], Int)
type instance XTerminal (GenConst r) = [Int]

data T bst
  = TNum Int
  | BstList Int bst
  | TAny Int
  | TEnd
instance (Show bst) => Show (T bst) where
  show :: T bst -> String
show = \case
    TNum Int
i -> String
"S" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
    BstList Int
i bst
bst -> String
"S" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ bst -> String
forall a. Show a => a -> String
show bst
bst
    TAny Int
i -> String
"S" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" s"
    T bst
TEnd -> String
"End"

data MsgT r bst

type instance XMsg (MsgT r bst) = ([T bst], (r, r), Int)
type instance XLabel (MsgT r bst) = ([T bst], Int)
type instance XBranch (MsgT r bst) = [T bst]
type instance XBranchSt (MsgT r bst) = ()
type instance XGoto (MsgT r bst) = ([T bst], Int)
type instance XTerminal (MsgT r bst) = [T bst]

data MsgT1 r bst

type instance XMsg (MsgT1 r bst) = ((T bst, T bst, T bst), (r, r), Int)
type instance XLabel (MsgT1 r bst) = ([T bst], Int)
type instance XBranch (MsgT1 r bst) = [T bst]
type instance XBranchSt (MsgT1 r bst) = ()
type instance XGoto (MsgT1 r bst) = ([T bst], Int)
type instance XTerminal (MsgT1 r bst) = [T bst]

------------------------

instance (Pretty (Protocol eta r bst), Show (XBranchSt eta), Show bst) => Pretty (BranchSt eta r bst) where
  pretty :: forall ann. BranchSt eta r bst -> Doc ann
pretty (BranchSt XBranchSt eta
xbst bst
bst Protocol eta r bst
prot) = Doc ann
"* BranchSt" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (XBranchSt eta -> String
forall a. Show a => a -> String
show XBranchSt eta
xbst) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (bst -> String
forall a. Show a => a -> String
show bst
bst) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (Protocol eta r bst -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Protocol eta r bst -> Doc ann
pretty Protocol eta r bst
prot)

instance (Show (XMsg eta), Show (XLabel eta), Show r) => Pretty (MsgOrLabel eta r) where
  pretty :: forall ann. MsgOrLabel eta r -> Doc ann
pretty = \case
    Msg XMsg eta
xv String
cst [String]
args r
from r
to ->
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep [Doc ann
"Msg", Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
angles (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ XMsg eta -> String
forall a. Show a => a -> String
show XMsg eta
xv), String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
cst, [String] -> Doc ann
forall ann. [String] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [String]
args, String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (r -> String
forall a. Show a => a -> String
show r
from), String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (r -> String
forall a. Show a => a -> String
show r
to)]
    Label XLabel eta
xv Int
i -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep [Doc ann
"Label", String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ XLabel eta -> String
forall a. Show a => a -> String
show XLabel eta
xv, Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i]

instance (ForallX Show eta, Show r, Show bst) => Pretty (Protocol eta r bst) where
  pretty :: forall ann. Protocol eta r bst -> Doc ann
pretty = \case
    MsgOrLabel eta r
msgOrLabel :> Protocol eta r bst
prots -> MsgOrLabel eta r -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. MsgOrLabel eta r -> Doc ann
pretty MsgOrLabel eta r
msgOrLabel Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Protocol eta r bst -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Protocol eta r bst -> Doc ann
pretty Protocol eta r bst
prots
    Branch XBranch eta
is r
r [BranchSt eta r bst]
ls -> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"[Branch]" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (XBranch eta -> String
forall a. Show a => a -> String
show XBranch eta
is) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (r -> String
forall a. Show a => a -> String
show r
r) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((BranchSt eta r bst -> Doc ann)
-> [BranchSt eta r bst] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BranchSt eta r bst -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. BranchSt eta r bst -> Doc ann
pretty [BranchSt eta r bst]
ls)
    Goto XGoto eta
xv Int
i -> Doc ann
"Goto" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (XGoto eta -> String
forall a. Show a => a -> String
show XGoto eta
xv) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i
    Terminal XTerminal eta
xv -> Doc ann
"Terminal" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (XTerminal eta -> String
forall a. Show a => a -> String
show XTerminal eta
xv)

-----------------------------
instance (Pretty (Protocol eta r bst), Show (XBranchSt eta), Show bst) => Show (BranchSt eta r bst) where
  show :: BranchSt eta r bst -> String
show = SimpleDocStream Any -> String
forall ann. SimpleDocStream ann -> String
renderString (SimpleDocStream Any -> String)
-> (BranchSt eta r bst -> SimpleDocStream Any)
-> BranchSt eta r bst
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions (Doc Any -> SimpleDocStream Any)
-> (BranchSt eta r bst -> Doc Any)
-> BranchSt eta r bst
-> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchSt eta r bst -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. BranchSt eta r bst -> Doc ann
pretty

instance (Show (XMsg eta), Show (XLabel eta), Show r) => Show (MsgOrLabel eta r) where
  show :: MsgOrLabel eta r -> String
show = SimpleDocStream Any -> String
forall ann. SimpleDocStream ann -> String
renderString (SimpleDocStream Any -> String)
-> (MsgOrLabel eta r -> SimpleDocStream Any)
-> MsgOrLabel eta r
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions (Doc Any -> SimpleDocStream Any)
-> (MsgOrLabel eta r -> Doc Any)
-> MsgOrLabel eta r
-> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgOrLabel eta r -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. MsgOrLabel eta r -> Doc ann
pretty

instance (ForallX Show eta, Show r, Show bst) => Show (Protocol eta r bst) where
  show :: Protocol eta r bst -> String
show = SimpleDocStream Any -> String
forall ann. SimpleDocStream ann -> String
renderString (SimpleDocStream Any -> String)
-> (Protocol eta r bst -> SimpleDocStream Any)
-> Protocol eta r bst
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions (Doc Any -> SimpleDocStream Any)
-> (Protocol eta r bst -> Doc Any)
-> Protocol eta r bst
-> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Protocol eta r bst -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. Protocol eta r bst -> Doc ann
pretty