typed-session-state-algorithm 0.4.0.0 → 0.4.1.0
raw patch · 4 files changed
+47/−43 lines, 4 files
Files
- src/TypedSession/State/Pipeline.hs +10/−6
- src/TypedSession/State/Type.hs +2/−2
- test/Main.hs +34/−34
- typed-session-state-algorithm.cabal +1/−1
src/TypedSession/State/Pipeline.hs view
@@ -329,16 +329,20 @@ , dnySet :: Set Int , stBound :: (Int, Int) , branchResultTypeInfo :: [(String, [(bst, [[String]], T bst)])]+ , branchFunList :: [(r, String, T bst)] } genBranchResultTIXFold :: forall r bst sig m- . (Has (State String :+: (State (Map String [(bst, [[String]], T bst)]))) sig m)+ . ( Has (State String :+: Writer [(r, String, T bst)] :+: (State (Map String [(bst, [[String]], T bst)]))) sig m+ , Enum r+ ) => XFold m (MsgT1 r bst) r bst genBranchResultTIXFold = ( \_ -> pure () , \_ -> pure ()- , \(_, (_, st, _)) -> do+ , \(ts, (r, st, _)) -> do+ tell [(r, st, ts !! (fromEnum r))] put st pure (restoreWrapper @String) , \(_, (bst, args, prot)) -> do@@ -410,13 +414,13 @@ trace (TracerProtocolMsgT prot4) prot5 <- xtraverse genMsgT1XTraverse prot4 trace (TracerProtocolMsgT1 prot5)- branchTIMap <-- fmap (fst . snd)+ (bfl, (_, (branchTIMap, _))) <-+ runWriter @[(r, String, T bst)] . runState @String (error internalError) . runState @(Map String [(bst, [[String]], T bst)]) Map.empty $ xfold genBranchResultTIXFold prot5- trace (TracerBranchResultTI branchTIMap)- pure (PipeResult prot4 prot5 dnys stBound (Map.toList branchTIMap))+ trace (TracerBranchResultTI bfl branchTIMap)+ pure (PipeResult prot4 prot5 dnys stBound (Map.toList branchTIMap) bfl) pipe :: forall r bst
src/TypedSession/State/Type.hs view
@@ -175,7 +175,7 @@ | TracerCollectBranchDynVal (Set Int) | TracerProtocolMsgT (Protocol (MsgT r bst) r bst) | TracerProtocolMsgT1 (Protocol (MsgT1 r bst) r bst)- | TracerBranchResultTI (Map String [(bst, [[String]], T bst)])+ | TracerBranchResultTI [(r, String, T bst)] (Map String [(bst, [[String]], T bst)]) traceWrapper :: String -> String -> String traceWrapper desc st =@@ -195,7 +195,7 @@ TracerCollectBranchDynVal dvs -> traceWrapper "CollectBranchDynVal" $ show dvs TracerProtocolMsgT p -> traceWrapper "MsgT" $ show p TracerProtocolMsgT1 p -> traceWrapper "MsgT1" $ show p- TracerBranchResultTI st -> traceWrapper "BranchResultTI" $ show st+ TracerBranchResultTI v1 st -> traceWrapper "BranchResultTI" $ show v1 <> "\n" <> show st ------------------------
test/Main.hs view
@@ -132,39 +132,39 @@ {- >>> error r2 --------------------------------------------Buyer----------------------Seller---------------------Buyer2----------------------Label 0 S0 S0 S1 s - Title [String] S0 -> S0 <- S1 s - [Branch Seller FindBookResult] S2 s S3 S1 s - * BranchSt_Found [] - Price [Int] S2 s <- {S2 Found} -> S1 s - [Branch Buyer OneOrTwo] S4 S5 s S1 s - * BranchSt_Two [] - PriceToBuyer2 [Int] {S1 Two} -> S5 s S1 s <- - [Branch Buyer2 SupportOrNotSupport] S6 s S5 s S7 - * BranchSt_NotSupport [] - NotSupport1 [] S6 s <- S5 s {S6 NotSupport} -> - TwoNotBuy [] S5 NotSupport -> S5 s <- S1 s - Goto 0 S0 S0 S1 s - * BranchSt_Support [] - SupportVal [Int] S6 s <- S5 s {S6 Support} -> - [Branch Buyer EnoughOrNotEnough] S8 S5 s S9 s - * BranchSt_Enough [] - TwoAccept [] {S5 Enough} -> S5 s <- S9 s - TwoDate [Int] S10 <- S10 -> S9 s - TwoSuccess [Int] S9 Enough -> S0 S9 s <- - Goto 0 S0 S0 S1 s - * BranchSt_NotEnough [] - TwoNotBuy1 [] {S5 NotEnough} -> S5 s <- S9 s - TwoFailed [] S9 NotEnough -> End S9 s <- - Terminal End End End - * BranchSt_One [] - OneAccept [] {S5 One} -> S5 s <- S1 s - OneDate [Int] S11 <- S11 -> S1 s - OneSuccess [Int] S1 One -> S0 S1 s <- - Goto 0 S0 S0 S1 s - * BranchSt_NotFound [] - NoBook [] S2 s <- {S2 NotFound} -> S1 s - SellerNoBook [] S1 NotFound -> S0 S1 s <- - Goto 0 S0 S0 S1 s +Label 0 S0 S0 S1 s+ Title [String] S0 -> S0 <- S1 s+ [Branch Seller FindBookResult] S2 s S3 S1 s+ * BranchSt_Found []+ Price [Int] S2 s <- {S2 Found} -> S1 s+ [Branch Buyer OneOrTwo] S4 S5 s S1 s+ * BranchSt_Two []+ PriceToBuyer2 [Int] {S1 Two} -> S5 s S1 s <-+ [Branch Buyer2 SupportOrNotSupport] S6 s S5 s S7+ * BranchSt_NotSupport []+ NotSupport1 [] S6 s <- S5 s {S6 NotSupport} ->+ TwoNotBuy [] S5 NotSupport -> S5 s <- S1 s+ Goto 0 S0 S0 S1 s+ * BranchSt_Support []+ SupportVal [Int] S6 s <- S5 s {S6 Support} ->+ [Branch Buyer EnoughOrNotEnough] S8 S5 s S9 s+ * BranchSt_Enough []+ TwoAccept [] {S5 Enough} -> S5 s <- S9 s+ TwoDate [Int] S10 <- S10 -> S9 s+ TwoSuccess [Int] S9 Enough -> S0 S9 s <-+ Goto 0 S0 S0 S1 s+ * BranchSt_NotEnough []+ TwoNotBuy1 [] {S5 NotEnough} -> S5 s <- S9 s+ TwoFailed [] S9 NotEnough -> End S9 s <-+ Terminal End End End+ * BranchSt_One []+ OneAccept [] {S5 One} -> S5 s <- S1 s+ OneDate [Int] S11 <- S11 -> S1 s+ OneSuccess [Int] S1 One -> S0 S1 s <-+ Goto 0 S0 S0 S1 s+ * BranchSt_NotFound []+ NoBook [] S2 s <- {S2 NotFound} -> S1 s+ SellerNoBook [] S1 NotFound -> S0 S1 s <-+ Goto 0 S0 S0 S1 s -}
typed-session-state-algorithm.cabal view
@@ -20,7 +20,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.4.0.0+version: 0.4.1.0 -- A short (one-line) description of the package. synopsis: Automatically generate status for typed-session.