rename to runProtocol, remove ProtocolCmd constructor export

This commit is contained in:
Evgeny Poberezkin 2020-07-12 19:13:45 +01:00
parent f97a7885a0
commit 3d7992835f
2 changed files with 9 additions and 13 deletions

View File

@ -1,6 +1,5 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
@ -11,10 +10,10 @@
module Control.Protocol
( Protocol,
ProtocolCmd (..),
ProtocolCmd,
Command,
(->:),
interpret,
runProtocol,
)
where
@ -43,22 +42,19 @@ infix 6 ->:
Protocol cmd ps s (Inj ps (Inj ps s from fs') to ts') a
(->:) f t c = xfree $ ProtocolCmd f t c
interpret ::
runProtocol ::
forall m cmd ps s s' a.
Monad m =>
(forall from to b. (Sing (P from) -> Sing (P to) -> cmd from to b -> m b)) ->
Protocol cmd ps s s' a ->
m a
interpret runCommand = loop
runProtocol runCmd = loop
where
loop :: forall s1 s2 b. Protocol cmd ps s1 s2 b -> m b
loop = \case
Pure x -> return x
Bind c f -> do
x <- run c
loop (f x)
loop (Pure x) = return x
loop (Bind c f) = run c >>= loop . f
run :: forall s1 s2 b. ProtocolCmd cmd ps s1 s2 b -> m b
run (ProtocolCmd from to cmd) = runCommand from to cmd
run (ProtocolCmd from to cmd) = runCmd from to cmd
type family P (partyCmd :: (party, s, s)) where
P '(p, _, _) = p

View File

@ -10,7 +10,7 @@
module Simplex.Messaging.PrintScenario where
import Control.Monad.Writer
import Control.Protocol (interpret)
import Control.Protocol (runProtocol)
import Data.Singletons
import Simplex.Messaging.Protocol
import Simplex.Messaging.Types
@ -28,7 +28,7 @@ printScenario scn = ps 1 "" $ execWriter $ logScenario scn
prefix s = " - " <> s
logScenario :: MonadWriter [(String, String)] m => SimplexProtocol s s' a -> m a
logScenario = interpret $ \from to cmd -> do
logScenario = runProtocol $ \from to cmd -> do
tell [(party from, commandStr cmd <> " " <> party to)]
mockCommand cmd