print allow comments
This commit is contained in:
@@ -1,5 +1,6 @@
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
@@ -20,18 +21,18 @@ printScenario scn = ps 1 "" $ execWriter $ logScenario scn
|
||||
ps :: Int -> String -> [(String, String)] -> IO ()
|
||||
ps _ _ [] = return ()
|
||||
ps i p ((p', l) : ls)
|
||||
| p' == "" = prt i $ "## " <> l <> "\n"
|
||||
| p' /= p = prt (i + 1) $ show i <> ". " <> p' <> ":\n" <> l'
|
||||
| otherwise = prt i l'
|
||||
| p' == "" = part i $ "\n" <> l <> "\n"
|
||||
| p' /= p = part (i + 1) $ show i <> ". " <> p' <> ":\n" <> prefix l
|
||||
| otherwise = part i $ prefix l
|
||||
where
|
||||
prt i' s = putStrLn s >> ps i' p' ls
|
||||
l' = " - " <> l
|
||||
part i' s = putStrLn s >> ps i' p' ls
|
||||
prefix s = " - " <> s
|
||||
|
||||
logScenario :: SimplexProtocol s s' a -> Writer [(String, String)] a
|
||||
logScenario :: MonadWriter [(String, String)] m => SimplexProtocol s s' a -> m a
|
||||
logScenario (Pure x) = return x
|
||||
logScenario (Bind p f) = logProtocol p >>= \x -> logScenario (f x)
|
||||
|
||||
logProtocol :: ProtocolCmd SimplexCommand '[Recipient, Broker, Sender] s s' a -> Writer [(String, String)] a
|
||||
logProtocol :: MonadWriter [(String, String)] m => SimplexProtocolCmd s s' a -> m a
|
||||
logProtocol (Comment s) = tell [("", s)]
|
||||
logProtocol (ProtocolCmd from to cmd) = do
|
||||
tell [(party from, commandStr cmd <> " " <> party to)]
|
||||
|
||||
@@ -25,6 +25,8 @@ import Simplex.Messaging.Types
|
||||
|
||||
type SimplexProtocol = Protocol SimplexCommand '[Recipient, Broker, Sender]
|
||||
|
||||
type SimplexProtocolCmd = ProtocolCmd SimplexCommand '[Recipient, Broker, Sender]
|
||||
|
||||
data SimplexCommand :: Command Party ConnState where
|
||||
CreateConn ::
|
||||
PublicKey ->
|
||||
|
||||
@@ -27,7 +27,7 @@ s = SSender
|
||||
|
||||
establishConnection :: SimplexProtocol '[None, None, None] '[Secured, Secured, Secured] ()
|
||||
establishConnection = do
|
||||
comment "Establish simplex messaging connection and send first message"
|
||||
comment "## Establish simplex messaging connection and send first message"
|
||||
r ->: b $ CreateConn "BODbZxmtKUUF1l8pj4nVjQ"
|
||||
r ->: b $ Subscribe "RU"
|
||||
r ->: s $ SendInvite "invitation RU" -- invitation - TODo
|
||||
@@ -38,6 +38,7 @@ establishConnection = do
|
||||
s ->: b $ SendMsg "SU" "welcome" -- welcome message
|
||||
b ->: r $ PushMsg "RU" Message {msgId = "def", msg = "welcome"}
|
||||
r ->: b $ DeleteMsg "RU" "def"
|
||||
comment "The connection is established (\"Secured\"), sending the message"
|
||||
s ->: b $ SendMsg "SU" "hello there"
|
||||
b ->: r $ PushMsg "RU" Message {msgId = "ghi", msg = "hello there"}
|
||||
r ->: b $ DeleteMsg "RU" "ghi"
|
||||
|
||||
Reference in New Issue
Block a user