packages feed

typed-session 0.3.0.0 → 0.3.0.1

raw patch · 5 files changed

+32/−27 lines, 5 filesdep ~io-classesdep ~typed-session-state-algorithmPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: io-classes, typed-session-state-algorithm

API changes (from Hackage documentation)

- TypedSession.TH: protDecsAndMsgDecs :: (Show r, Show bst, Enum r, Bounded r) => String -> Name -> Name -> PipeResult r bst -> Q [Dec]
- TypedSession.TH: roleDecs :: Name -> Q [Dec]
+ TypedSession.TH: protocol' :: (Enum r, Bounded r, Show r, Enum bst, Bounded bst, Show bst, Ord r) => String -> Name -> Name -> Bool -> QuasiQuoter

Files

src/TypedSession/TH.hs view
@@ -14,9 +14,9 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} {-# OPTIONS_GHC -split-sections #-} -module TypedSession.TH where+module TypedSession.TH (protocol, protocol') where -import Control.Monad (forM)+import Control.Monad (forM, when) import Data.Either (fromRight) import Data.IFunctor (Sing, SingI (..)) import Data.Kind@@ -78,7 +78,7 @@     _ -> error $ "Name: " ++ show name ++ " is not a data constructor"  protDecsAndMsgDecs :: forall r bst. (Show r, Show bst, Enum r, Bounded r) => String -> Name -> Name -> PipeResult r bst -> Q [Dec]-protDecsAndMsgDecs protN roleName bstName PipeResult{msgT, msgT1, dnySet, stBound = (fromVal, toVal), branchResultTypeInfo, branchFunList, allMsgBATypes} = do+protDecsAndMsgDecs protN roleName bstName PipeResult{msgT, msgT1, dnySet, stList, branchResultTypeInfo, branchFunList, allMsgBATypes} = do   let protName = mkName protN       protSName = mkName ("S" <> protN)       mkSiName i = mkName $ "S" <> show i@@ -94,7 +94,7 @@                   [(Bang NoSourceUnpackedness NoSourceStrictness, ConT bstName)]               else NormalC (mkSiName i) []       -- generate protocol data type-      dataProt = [DataD [] protName [] Nothing [genConstr i | i <- [fromVal .. toVal]] []]+      dataProt = [DataD [] protName [] Nothing [genConstr i | i <- stList] []]    let tAnyToType :: Name -> T bst -> TH.Type       tAnyToType s = \case@@ -138,7 +138,7 @@               else                 GadtC [mkSSiName i] [] (AppT (ConT protSName) (PromotedT $ mkSiName i))       -- generate protocol singleton data type-      dataSingletonProt = [DataD [] protSName [KindedTV aVar BndrReq (ConT protName)] Nothing [genSConstr i | i <- [fromVal .. toVal]] []]+      dataSingletonProt = [DataD [] protSName [KindedTV aVar BndrReq (ConT protName)] Nothing [genSConstr i | i <- stList] []]    -- generate type family Sing to Singleton protocol   let singSingletonProt = [TySynInstD (TySynEqn Nothing (ConT ''Sing) (ConT protSName))]@@ -219,7 +219,7 @@                 )             )             [FunD 'sing [Clause [] (NormalB (ConE (mkName $ "S" <> (if i == -1 then "End" else ("S" <> show i))))) []]]-        | i <- [fromVal .. toVal]+        | i <- stList         ]    xVar <- newName "x"@@ -333,7 +333,7 @@       ++ instanceSingToInt       ++ instanceMsg -protocol+protocol'   :: forall r bst    . ( Enum r      , Bounded r@@ -343,8 +343,8 @@      , Show bst      , Ord r      )-  => String -> Name -> Name -> QuasiQuoter-protocol protN roleName bstName =+  => String -> Name -> Name -> Bool -> QuasiQuoter+protocol' protN roleName bstName b =   QuasiQuoter     { quoteExp = const $ fail "No protocol parse for exp"     , quotePat = const $ fail "No protocol parse for pat"@@ -359,9 +359,23 @@       Left e -> fail (show e)       Right pipResult -> do         let graphStr = genGraph @r @bst pipResult-        runIO $ do+        when b $ runIO $ do           writeFile (protN <> ".prot") graphStr           putStrLn graphStr         d1 <- roleDecs roleName         d2 <- protDecsAndMsgDecs protN roleName bstName pipResult         pure (d1 ++ d2)++protocol+  :: forall r bst+   . ( Enum r+     , Bounded r+     , Show r+     , Enum bst+     , Bounded bst+     , Show bst+     , Ord r+     )+  => String -> Name -> Name -> QuasiQuoter+protocol protN roleName bstName =+  protocol' @r @bst protN roleName bstName False
test/Book3/Main.hs view
@@ -18,9 +18,9 @@ import Book3.Peer import Book3.Protocol import Book3.Type+import Control.Carrier.Lift (runM, sendM) import Control.Carrier.Random.Gen (runRandom) import Control.Concurrent.Class.MonadSTM-import Control.Effect.Labelled (runLabelledLift, sendM) import Control.Monad import Control.Monad.Class.MonadFork (MonadFork, forkIO) import Control.Monad.Class.MonadSay@@ -96,16 +96,16 @@    -- fork seller Peer thread   forkIO $ do-    runLabelledLift $ runRandom g1 $ runPeerWithDriver sellerDriver sellerPeer+    runM $ runRandom g1 $ runPeerWithDriver sellerDriver sellerPeer     atomically $ writeTMVar resultTMVar1 ()    -- fork buyer2 Peer thread   forkIO $ do-    runLabelledLift $ runRandom g2 $ runPeerWithDriver buyer2Driver buyer2Peer+    runM $ runRandom g2 $ runPeerWithDriver buyer2Driver buyer2Peer     atomically $ writeTMVar resultTMVar2 ()    -- run buyer Peer-  void $ runLabelledLift $ runRandom g3 $ runPeerWithDriver buyerDriver buyerPeer+  void $ runM $ runRandom g3 $ runPeerWithDriver buyerDriver buyerPeer    -- wait seller, buyer   atomically $ do
test/Book3/Peer.hs view
@@ -21,16 +21,9 @@ import Book3.Type import Control.Carrier.Lift import Control.Carrier.Random.Gen-import Control.Carrier.State.Strict (runState)-import Control.Effect.State-import Control.Monad-import Data.IFunctor (At (..), SingI (..), returnAt)+import Data.IFunctor (At (..), returnAt) import qualified Data.IFunctor as I-import Data.IntMap (IntMap)-import qualified Data.IntMap as IntMap-import System.Random (StdGen, mkStdGen, randomIO) import TypedSession.Core-import Unsafe.Coerce (unsafeCoerce)  budget :: Int budget = 16
test/Book3/Protocol.hs view
@@ -11,7 +11,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-}-{-# OPTIONS_GHC -ddump-splices #-} {-# OPTIONS_GHC -Wno-unused-do-bind #-}  module Book3.Protocol where@@ -20,7 +19,6 @@  import TypedSession.Codec import TypedSession.Core-import Language.Haskell.TH   [bookProtocol|
typed-session.cabal view
@@ -20,7 +20,7 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version:            0.3.0.0+version:            0.3.0.1  -- A short (one-line) description of the package. synopsis: typed session framework@@ -77,9 +77,9 @@     -- Other library packages from which modules are imported.     build-depends: base >= 4.20.0 && < 4.21                  , containers >= 0.7 && < 0.8-                 , io-classes >= 1.5.0 && < 1.6+                 , io-classes >= 1.7.0 && < 1.8                  , template-haskell >= 2.22.0 && < 2.23-                 , typed-session-state-algorithm >= 0.4.0 && < 0.5+                 , typed-session-state-algorithm >= 0.5.0 && < 0.6      -- Directories containing source files.     hs-source-dirs:   src