Skip to content

Commit abecdaf

Browse files
cootcoot
committed
typed-protocols: added application specific singletons for protocol states
We still have `singletons` as a dependency though.
1 parent 6b6118d commit abecdaf

File tree

18 files changed

+118
-141
lines changed

18 files changed

+118
-141
lines changed

‎typed-protocols-cborg/src/Network/TypedProtocol/Codec/CBOR.hs‎

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,6 @@ import qualified Data.ByteString.Builder as BS
2424
import qualified Data.ByteString.Builder.Extra as BS
2525
import qualified Data.ByteString.Lazy as LBS
2626
import qualified Data.ByteString.Lazy.Internal as LBS (smallChunkSize)
27-
import Data.Singletons
2827

2928
import Network.TypedProtocol.Codec
3029
import Network.TypedProtocol.Core
@@ -48,13 +47,13 @@ mkCodecCborStrictBS
4847
:: forall ps m. MonadST m
4948

5049
=> (forall (st :: ps) (st' :: ps).
51-
SingI st
50+
StateTokenI st
5251
=> ActiveState st
5352
=> Message ps st st' -> CBOR.Encoding)
5453

5554
-> (forall (st :: ps) s.
5655
ActiveState st
57-
=> Sing st
56+
=> StateToken st
5857
-> CBOR.Decoder s (SomeMessage st))
5958

6059
-> Codec ps DeserialiseFailure m BS.ByteString
@@ -104,13 +103,13 @@ mkCodecCborLazyBS
104103
:: forall ps m. MonadST m
105104

106105
=> (forall (st :: ps) (st' :: ps).
107-
SingI st
106+
StateTokenI st
108107
=> ActiveState st
109108
=> Message ps st st' -> CBOR.Encoding)
110109

111110
-> (forall (st :: ps) s.
112111
ActiveState st
113-
=> Sing st
112+
=> StateToken st
114113
-> CBOR.Decoder s (SomeMessage st))
115114

116115
-> Codec ps CBOR.DeserialiseFailure m LBS.ByteString

‎typed-protocols-examples/src/Network/TypedProtocol/Driver/Simple.hs‎

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -32,8 +32,6 @@ module Network.TypedProtocol.Driver.Simple
3232
, runDecoderWithChannel
3333
) where
3434

35-
import Data.Singletons
36-
3735
import Network.TypedProtocol.Channel
3836
import Network.TypedProtocol.Codec
3937
import Network.TypedProtocol.Core
@@ -91,7 +89,7 @@ driverSimple tracer Codec{encode, decode} channel@Channel{send} =
9189
Driver { sendMessage, recvMessage, initialDState = Nothing }
9290
where
9391
sendMessage :: forall (st :: ps) (st' :: ps).
94-
( SingI st
92+
( StateTokenI st
9593
, ActiveState st
9694
)
9795
=> ReflRelativeAgency (StateAgency st)
@@ -104,7 +102,7 @@ driverSimple tracer Codec{encode, decode} channel@Channel{send} =
104102
traceWith tracer (TraceSendMsg (AnyMessage msg))
105103

106104
recvMessage :: forall (st :: ps).
107-
( SingI st
105+
( StateTokenI st
108106
, ActiveState st
109107
)
110108
=> ReflRelativeAgency (StateAgency st)
@@ -113,7 +111,7 @@ driverSimple tracer Codec{encode, decode} channel@Channel{send} =
113111
-> Maybe bytes
114112
-> m (SomeMessage st, Maybe bytes)
115113
recvMessage !_refl trailing = do
116-
decoder <- decode sing
114+
decoder <- decode stateToken
117115
result <- runDecoderWithChannel channel trailing decoder
118116
case result of
119117
Right x@(SomeMessage msg, _trailing') -> do

‎typed-protocols-examples/src/Network/TypedProtocol/PingPong/Codec.hs‎

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -7,8 +7,6 @@
77

88
module Network.TypedProtocol.PingPong.Codec where
99

10-
import Data.Singletons
11-
1210
import Network.TypedProtocol.Codec
1311
import Network.TypedProtocol.Core
1412
import Network.TypedProtocol.PingPong.Type
@@ -29,7 +27,7 @@ codecPingPong =
2927

3028
decode :: forall (st :: PingPong).
3129
ActiveState st
32-
=> Sing st
30+
=> StateToken st
3331
-> m (DecodeStep String CodecFailure m (SomeMessage st))
3432
decode stok =
3533
decodeTerminatedFrame '\n' $ \str trailing ->
@@ -72,7 +70,7 @@ codecPingPongId =
7270
Codec{encode,decode}
7371
where
7472
encode :: forall (st :: PingPong) (st' :: PingPong)
75-
. ( SingI st
73+
. ( StateTokenI st
7674
, ActiveState st
7775
)
7876
=> Message PingPong st st'
@@ -81,7 +79,7 @@ codecPingPongId =
8179

8280
decode :: forall (st :: PingPong).
8381
ActiveState st
84-
=> Sing st
82+
=> StateToken st
8583
-> m (DecodeStep (AnyMessage PingPong) CodecFailure m (SomeMessage st))
8684
decode stok =
8785
pure $ DecodePartial $ \mb ->

‎typed-protocols-examples/src/Network/TypedProtocol/PingPong/Codec/CBOR.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,6 @@ module Network.TypedProtocol.PingPong.Codec.CBOR where
1010
import Control.Monad.Class.MonadST
1111

1212
import Data.ByteString.Lazy (ByteString)
13-
import Data.Singletons
1413

1514
import qualified Codec.CBOR.Decoding as CBOR (Decoder, decodeWord)
1615
import qualified Codec.CBOR.Encoding as CBOR (Encoding, encodeWord)
@@ -36,7 +35,7 @@ codecPingPong = mkCodecCborLazyBS encodeMsg decodeMsg
3635

3736
decodeMsg :: forall s (st :: PingPong).
3837
ActiveState st
39-
=> Sing st
38+
=> StateToken st
4039
-> CBOR.Decoder s (SomeMessage st)
4140
decodeMsg stok = do
4241
key <- CBOR.decodeWord

‎typed-protocols-examples/src/Network/TypedProtocol/PingPong/Type.hs‎

Lines changed: 6 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,6 @@
88

99
module Network.TypedProtocol.PingPong.Type where
1010

11-
import Data.Singletons
12-
1311
import Network.TypedProtocol.Core
1412

1513

@@ -44,14 +42,12 @@ data SPingPong (st :: PingPong) where
4442

4543
deriving instance Show (SPingPong st)
4644

47-
type instance Sing = SPingPong
48-
instance SingI StIdle where
49-
sing = SingIdle
50-
instance SingI StBusy where
51-
sing = SingBusy
52-
instance SingI StDone where
53-
sing = SingDone
54-
45+
instance StateTokenI StIdle where
46+
stateToken = SingIdle
47+
instance StateTokenI StBusy where
48+
stateToken = SingBusy
49+
instance StateTokenI StDone where
50+
stateToken = SingDone
5551

5652
instance Protocol PingPong where
5753

‎typed-protocols-examples/src/Network/TypedProtocol/ReqResp/Codec.hs‎

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,6 @@
88

99
module Network.TypedProtocol.ReqResp.Codec where
1010

11-
import Data.Singletons
12-
1311
import Network.TypedProtocol.Codec
1412
import Network.TypedProtocol.Core
1513
import Network.TypedProtocol.PingPong.Codec (decodeTerminatedFrame)
@@ -35,7 +33,7 @@ codecReqResp =
3533
decode :: forall req' resp' m'
3634
(st :: ReqResp req' resp')
3735
. (Monad m', Read req', Read resp', ActiveState st)
38-
=> Sing st
36+
=> StateToken st
3937
-> m' (DecodeStep String CodecFailure m' (SomeMessage st))
4038
decode stok =
4139
decodeTerminatedFrame '\n' $ \str trailing ->
@@ -62,15 +60,15 @@ codecReqRespId =
6260
where
6361
encode :: forall (st :: ReqResp req resp)
6462
(st' :: ReqResp req resp)
65-
. SingI st
63+
. StateTokenI st
6664
=> ActiveState st
6765
=> Message (ReqResp req resp) st st'
6866
-> AnyMessage (ReqResp req resp)
6967
encode msg = AnyMessage msg
7068

7169
decode :: forall (st :: ReqResp req resp)
7270
. ActiveState st
73-
=> Sing st
71+
=> StateToken st
7472
-> m (DecodeStep (AnyMessage (ReqResp req resp)) CodecFailure m (SomeMessage st))
7573
decode stok =
7674
pure $ DecodePartial $ \mb ->

‎typed-protocols-examples/src/Network/TypedProtocol/ReqResp/Codec/CBOR.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,6 @@ module Network.TypedProtocol.ReqResp.Codec.CBOR where
1010
import Control.Monad.Class.MonadST
1111

1212
import Data.ByteString.Lazy (ByteString)
13-
import Data.Singletons
1413

1514
import qualified Codec.CBOR.Decoding as CBOR (Decoder, decodeListLen,
1615
decodeWord)
@@ -46,7 +45,7 @@ codecReqResp = mkCodecCborLazyBS encodeMsg decodeMsg
4645

4746
decodeMsg :: forall s (st :: ReqResp req resp).
4847
ActiveState st
49-
=> Sing st
48+
=> StateToken st
5049
-> CBOR.Decoder s (SomeMessage st)
5150
decodeMsg stok = do
5251
_ <- CBOR.decodeListLen

‎typed-protocols-examples/src/Network/TypedProtocol/ReqResp/Type.hs‎

Lines changed: 6 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -9,8 +9,6 @@
99

1010
module Network.TypedProtocol.ReqResp.Type where
1111

12-
import Data.Singletons
13-
1412
import Network.TypedProtocol.Core
1513

1614

@@ -26,13 +24,12 @@ data SReqResp (st :: ReqResp req resp) where
2624

2725
deriving instance Show (SReqResp st)
2826

29-
type instance Sing = SReqResp
30-
instance SingI StIdle where
31-
sing = SingIdle
32-
instance SingI StBusy where
33-
sing = SingBusy
34-
instance SingI StDone where
35-
sing = SingDone
27+
instance StateTokenI StIdle where
28+
stateToken = SingIdle
29+
instance StateTokenI StBusy where
30+
stateToken = SingBusy
31+
instance StateTokenI StDone where
32+
stateToken = SingDone
3633

3734

3835
instance Protocol (ReqResp req resp) where

‎typed-protocols-examples/src/Network/TypedProtocol/ReqResp2/Client.hs‎

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,9 @@
11
{-# LANGUAGE BangPatterns #-}
22
{-# LANGUAGE DataKinds #-}
33
{-# LANGUAGE GADTs #-}
4-
{-# LANGUAGE KindSignatures #-}
5-
{-# LANGUAGE LambdaCase #-}
64
{-# LANGUAGE PolyKinds #-}
75
{-# LANGUAGE ScopedTypeVariables #-}
86
{-# LANGUAGE TypeApplications #-}
9-
{-# LANGUAGE TypeOperators #-}
107

118

129

‎typed-protocols-examples/src/Network/TypedProtocol/ReqResp2/Type.hs‎

Lines changed: 8 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -9,8 +9,6 @@
99

1010
module Network.TypedProtocol.ReqResp2.Type where
1111

12-
import Data.Singletons
13-
1412
import Network.TypedProtocol.Core
1513

1614

@@ -28,15 +26,14 @@ data SReqResp2 (st :: ReqResp2 req resp) where
2826

2927
deriving instance Show (SReqResp2 st)
3028

31-
type instance Sing = SReqResp2
32-
instance SingI StIdle where
33-
sing = SingIdle
34-
instance SingI StBusy where
35-
sing = SingBusy
36-
instance SingI StBusy' where
37-
sing = SingBusy'
38-
instance SingI StDone where
39-
sing = SingDone
29+
instance StateTokenI StIdle where
30+
stateToken = SingIdle
31+
instance StateTokenI StBusy where
32+
stateToken = SingBusy
33+
instance StateTokenI StBusy' where
34+
stateToken = SingBusy'
35+
instance StateTokenI StDone where
36+
stateToken = SingDone
4037

4138

4239
instance Protocol (ReqResp2 req resp) where

0 commit comments

Comments
 (0)