distributed-process-fsm has been merged into the Cloud Haskell monorepo

This includes updating the test suite to use Tasty (rather than test-framework), and updating dependency bounds

Author: LaurentRDC

packages/distributed-process-fsm/distributed-process-fsm.cabal

@@ -1,85 +1,64 @@
+cabal-version:  3.0
 name:           distributed-process-fsm
-version:        0.0.1
-cabal-version:  >=1.8
+version:        0.0.2
 build-type:     Simple
-license:        BSD3
+license:        BSD-3-Clause
 license-file:   LICENCE
 Copyright:      Tim Watson 2017
 Author:         Tim Watson
-Maintainer:     Tim Watson <[email protected]>
+Maintainer:     The Haskell Distributed team
 Stability:      experimental
 Homepage:       http://github.com/haskell-distributed/distributed-process-fsm
 Bug-Reports:    http://github.com/haskell-distributed/distributed-process-fsm/issues
 synopsis:       The Cloud Haskell implementation of Erlang/OTP gen_statem
 description:    Cloud Haskell framework for building finite state machines around CSPs
 category:       Control
-Tested-With:    GHC==7.10.3 GHC==8.0.1 GHC==8.0.2
-data-dir:       ""
+Tested-With:    GHC==8.10.7 GHC==9.0.2 GHC==9.2.8 GHC==9.4.5 GHC==9.6.4 GHC==9.8.2 GHC==9.10.1 GHC==9.12.1
 
 source-repository head
   type:      git
-  location:  https://github.com/haskell-distributed/distributed-process-fsm
+  location:  https://github.com/haskell-distributed/distributed-process
+
+common warnings
+    ghc-options: -Wall
+                 -Wcompat
+                 -Widentities
+                 -Wincomplete-uni-patterns
+                 -Wincomplete-record-updates
+                 -Wredundant-constraints
+                 -fhide-source-paths
+                 -Wpartial-fields
+                 -Wunused-packages
 
 library
-  build-depends:
-                   base >= 4.8.2.0 && < 5,
-                   distributed-process >= 0.6.6 && < 0.8,
-                   distributed-process-extras >= 0.3.1 && < 0.4,
-                   distributed-process-client-server >= 0.2.5.1 && < 0.3,
-                   binary >= 0.6.3.0 && < 0.9,
-                   deepseq >= 1.3.0.1 && < 1.6,
-                   mtl,
-                   containers >= 0.4 && < 0.6,
-                   unordered-containers >= 0.2.3.0 && < 0.3,
-                   stm >= 2.4 && < 2.5,
-                   time > 1.4 && < 1.9,
-                   transformers,
-                   exceptions >= 0.5 && < 11
-  extensions:      CPP
-  hs-source-dirs:   src
-  ghc-options:      -Wall
-  exposed-modules:
-                   Control.Distributed.Process.FSM,
-                   Control.Distributed.Process.FSM.Client,
-                   Control.Distributed.Process.FSM.Internal.Types,
-                   Control.Distributed.Process.FSM.Internal.Process
+  import:            warnings
+  default-language:  Haskell2010
+  build-depends:     base >= 4.14 && < 5,
+                     distributed-process >= 0.6.6 && < 0.8,
+                     distributed-process-extras >= 0.3.1 && < 0.4,
+                     distributed-process-client-server >= 0.2.5.1 && < 0.3,
+                     binary >= 0.8 && < 0.10,
+                     mtl >= 2.0 && <2.4,
+                     containers >= 0.4 && < 0.8,
+                     exceptions >= 0.10
+  hs-source-dirs:    src
+  exposed-modules:   Control.Distributed.Process.FSM,
+                     Control.Distributed.Process.FSM.Client,
+                     Control.Distributed.Process.FSM.Internal.Types,
+                     Control.Distributed.Process.FSM.Internal.Process
 
 test-suite FsmTests
-  type:            exitcode-stdio-1.0
- --  x-uses-tf:       true
-  build-depends:
-                   base >= 4.4 && < 5,
-                   ansi-terminal >= 0.5 && < 0.7,
-                   network >= 2.3 && < 2.7,
-                   network-transport >= 0.4 && < 0.6,
-                   network-transport-tcp >= 0.4 && < 0.7,
-                   distributed-process >= 0.6.6 && < 0.8,
-                   distributed-process-extras >= 0.3.1 && < 0.4,
-                   distributed-process-client-server >= 0.2.5.1 && < 0.3,
-                   distributed-process-fsm,
-                   distributed-process-systest >= 0.1.1 && < 0.3,
-                   distributed-static,
-                   binary >= 0.6.3.0 && < 0.9,
-                   bytestring,
-                   containers,
-                   data-accessor,
-                   deepseq >= 1.3.0.1 && < 1.5,
-                   fingertree < 0.2,
-                   hashable,
-                   mtl,
-                   stm >= 2.3 && < 2.5,
-                   time,
-                   transformers,
-                   unordered-containers >= 0.2.3.0 && < 0.3,
-                   test-framework >= 0.6 && < 0.9,
-                   test-framework-hunit,
-                   QuickCheck >= 2.4,
-                   test-framework-quickcheck2,
-                   HUnit >= 1.2 && < 2,
-                   rematch >= 0.2.0.0,
-                   ghc-prim
-  hs-source-dirs:
-                   tests
-  ghc-options:     -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind -eventlog
-  extensions:      CPP
-  main-is:         TestFSM.hs
+  import:            warnings
+  type:              exitcode-stdio-1.0
+  build-depends:     base >= 4.14 && < 5,
+                     network-transport >= 0.4 && < 0.6,
+                     network-transport-tcp >= 0.4 && <= 0.9,
+                     distributed-process >= 0.6.6 && < 0.8,
+                     distributed-process-extras >= 0.3.1 && < 0.4,
+                     distributed-process-fsm,
+                     binary,
+                     tasty >= 1.5 && <1.6,
+                     tasty-hunit >=0.10 && <0.11,
+  hs-source-dirs:    tests
+  ghc-options:       -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
+  main-is:           TestFSM.hs

packages/distributed-process-fsm/tests/TestFSM.hs

@@ -18,18 +18,13 @@ import Control.Distributed.Process.Extras.Time hiding (timeout)
 import Control.Distributed.Process.Extras.Timer
 import Control.Distributed.Process.FSM hiding (State, liftIO)
 import Control.Distributed.Process.FSM.Client (call, callTimeout)
-import Control.Distributed.Process.SysTest.Utils
 import Control.Monad (replicateM_, forM_)
-import Control.Rematch (equalTo)
 
-#if ! MIN_VERSION_base(4,6,0)
-import Prelude hiding (catch, drop)
-#else
 import Prelude hiding (drop, (*>))
-#endif
 
-import Test.Framework as TF (defaultMain, testGroup, Test)
-import Test.Framework.Providers.HUnit
+
+import Test.Tasty(TestTree, testGroup, defaultMain)
+import Test.Tasty.HUnit (testCase, assertEqual, assertBool)
 
 import Network.Transport.TCP
 import qualified Network.Transport as NT
@@ -154,7 +149,7 @@ republicationOfEvents = do
   send pid "hello"  -- triggers `nextEvent ()`
 
   res <- receiveChanTimeout (asTimeout $ seconds 5) rp :: Process (Maybe ())
-  res `shouldBe` equalTo (Just ())
+  liftIO $ assertEqual mempty (Just ()) res
 
   send pid Off
 
@@ -163,7 +158,7 @@ republicationOfEvents = do
   send pid On
 
   res' <- receiveChanTimeout (asTimeout $ seconds 20) rp :: Process (Maybe ())
-  res' `shouldBe` equalTo (Just ())
+  liftIO $ assertEqual mempty (Just ()) res
 
   kill pid "thankyou byebye"
 
@@ -180,15 +175,15 @@ verifyOuterStateHandler = do
   () <- receiveChan rpOn
 
   resp <- callTimeout pid "hello there" (seconds 3):: Process (Maybe String)
-  resp `shouldBe` equalTo (Nothing :: Maybe String)
+  liftIO $ assertEqual mempty (Nothing :: Maybe String) resp
 
   send pid Off
   send pid ()
   Nothing <- receiveChanTimeout (asTimeout $ seconds 3) rpOn
   () <- receiveChan rpOff
 
   res <- call pid "hello" :: Process String
-  res `shouldBe` equalTo "hello"
+  liftIO $ assertEqual mempty "hello" res
 
   kill pid "bye bye"
 
@@ -202,7 +197,7 @@ verifyMailboxHandling = do
 
   sleep $ seconds 5
   alive <- isProcessAlive pid
-  alive `shouldBe` equalTo True
+  liftIO $ assertBool mempty alive
 
   -- we should resume after the ExitNormal handler runs, and get back into the ()
   -- handler due to safeWait (*>) which adds a `safe` filter check for the given type
@@ -211,18 +206,18 @@ verifyMailboxHandling = do
   exit pid ExitShutdown
   monitor pid >>= waitForDown
   alive' <- isProcessAlive pid
-  alive' `shouldBe` equalTo False
+  liftIO $ assertBool mempty (not alive')
 
 verifyStopBehaviour :: Process ()
 verifyStopBehaviour = do
   pid <- start Off initCount switchFsm
   alive <- isProcessAlive pid
-  alive `shouldBe` equalTo True
+  liftIO $ assertBool mempty alive
 
   exit pid $ ExitOther "foobar"
   monitor pid >>= waitForDown
   alive' <- isProcessAlive pid
-  alive' `shouldBe` equalTo False
+  liftIO $ assertBool mempty (not alive')
 
 notSoQuirkyDefinitions :: Process ()
 notSoQuirkyDefinitions = do
@@ -235,41 +230,40 @@ quirkyOperators = do
 walkingAnFsmTree :: ProcessId -> Process ()
 walkingAnFsmTree pid = do
   mSt <- pushButton pid
-  mSt `shouldBe` equalTo On
+  liftIO $ assertEqual mempty On mSt
 
   mSt' <- pushButton pid
-  mSt' `shouldBe` equalTo Off
+  liftIO $ assertEqual mempty Off mSt'
 
   mCk <- check pid
-  mCk `shouldBe` equalTo (2 :: StateData)
+  liftIO $ assertEqual mempty (2 :: StateData) mCk
 
   -- verify that the process implementation turns exit signals into handlers...
   exit pid ExitNormal
   sleep $ seconds 6
   alive <- isProcessAlive pid
-  alive `shouldBe` equalTo True
+  liftIO $ assertBool mempty alive
 
   mCk2 <- check pid
-  mCk2 `shouldBe` equalTo (0 :: StateData)
+  liftIO $ assertEqual mempty (0 :: StateData) mCk2
 
   mrst' <- pushButton pid
-  mrst' `shouldBe` equalTo On
+  liftIO $ assertEqual mempty On mrst'
 
   exit pid ExitShutdown
   monitor pid >>= waitForDown
   alive' <- isProcessAlive pid
-  alive' `shouldBe` equalTo False
+  liftIO $ assertBool mempty (not alive')
 
 myRemoteTable :: RemoteTable
 myRemoteTable =
   Control.Distributed.Process.Extras.__remoteTable $  initRemoteTable
 
-tests :: NT.Transport  -> IO [Test]
+tests :: NT.Transport  -> IO TestTree
 tests transport = do
   {- verboseCheckWithResult stdArgs -}
   localNode <- newLocalNode transport myRemoteTable
-  return [
-        testGroup "Language/DSL"
+  return $ testGroup "Language/DSL"
         [
           testCase "Traversing an FSM definition (operators)"
            (runProcess localNode quirkyOperators)
@@ -284,15 +278,13 @@ tests transport = do
         , testCase "Traversing an FSM definition (event re-publication)"
            (runProcess localNode republicationOfEvents)
         ]
-    ]
 
 main :: IO ()
 main = testMain $ tests
 
 -- | Given a @builder@ function, make and run a test suite on a single transport
-testMain :: (NT.Transport -> IO [Test]) -> IO ()
+testMain :: (NT.Transport -> IO TestTree) -> IO ()
 testMain builder = do
-  Right (transport, _) <- createTransportExposeInternals
-                                    "127.0.0.1" "0" ("127.0.0.1",) defaultTCPParameters
+  Right (transport, _) <- createTransportExposeInternals (defaultTCPAddr "127.0.0.1" "0") defaultTCPParameters
   testData <- builder transport
   defaultMain testData