print allow comments

This commit is contained in:
Evgeny Poberezkin
2020-07-12 10:28:13 +01:00
parent 85b10f08ae
commit ac79fe45c2
3 changed files with 12 additions and 8 deletions

View File

@@ -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)]

View File

@@ -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 ->

View File

@@ -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"