Merge pull request #299 from barrucadu/make-dejafu-pure-again

Make dejafu pure again

README.markdown

@@ -45,10 +45,10 @@ There are a few different packages under the Déjà Fu umbrella:
 
 |   | Version | Summary |
 | - | ------- | ------- |
-| [concurrency][h:conc]    | 1.6.2.0  | Typeclasses, functions, and data types for concurrency and STM. |
-| [dejafu][h:dejafu]       | 2.0.0.1 | Systematic testing for Haskell concurrency. |
-| [hunit-dejafu][h:hunit]  | 2.0.0.0  | Deja Fu support for the HUnit test framework. |
-| [tasty-dejafu][h:tasty]  | 2.0.0.0  | Deja Fu support for the Tasty test framework. |
+| [concurrency][h:conc]    | 1.7.0.0  | Typeclasses, functions, and data types for concurrency and STM. |
+| [dejafu][h:dejafu]       | 2.1.0.0  | Systematic testing for Haskell concurrency. |
+| [hunit-dejafu][h:hunit]  | 2.0.0.1  | Deja Fu support for the HUnit test framework. |
+| [tasty-dejafu][h:tasty]  | 2.0.0.1  | Deja Fu support for the Tasty test framework. |
 
 Each package has its own README and CHANGELOG in its subdirectory.
 

concurrency/CHANGELOG.rst

@@ -7,6 +7,25 @@ standard Haskell versioning scheme.
 .. _PVP: https://pvp.haskell.org/
 
 
+1.7.0.0 (2019-03-24)
+--------------------
+
+* Git: :tag:`concurrency-1.7.0.0`
+* Hackage: :hackage:`concurrency-1.7.0.0`
+
+Added
+~~~~~
+
+* The ``Control.Monad.Conc.Class.supportsBoundThreads`` function, like
+  ``rtsSupportsBoundThreads`` but returns a monadic result.
+
+Deprecated
+~~~~~~~~~~
+
+* ``Control.Monad.Conc.Class.rtsSupportsBoundThreads``, in favour of
+  ``supportsBoundThreads``.
+
+
 1.6.2.0 (2018-11-28)
 --------------------
 

concurrency/Control/Monad/Conc/Class.hs

@@ -55,7 +55,7 @@ module Control.Monad.Conc.Class
   -- To a foreign library, the bound thread will look exactly like an
   -- ordinary operating system thread created using OS functions like
   -- pthread_create or CreateThread.
-  , IO.rtsSupportsBoundThreads
+  , rtsSupportsBoundThreads
   , runInBoundThread
   , runInUnboundThread
 
@@ -150,7 +150,7 @@ import qualified Control.Monad.Writer.Strict  as WS
 -- Do not be put off by the use of @UndecidableInstances@, it is safe
 -- here.
 --
--- @since 1.6.0.0
+-- @since 1.7.0.0
 class ( Monad m
       , MonadCatch m, MonadThrow m, MonadMask m
       , MonadSTM (STM m)
@@ -160,6 +160,7 @@ class ( Monad m
         (forkWithUnmask | forkWithUnmaskN)
       , (forkOnWithUnmask | forkOnWithUnmaskN)
       , (forkOSWithUnmask | forkOSWithUnmaskN)
+      , supportsBoundThreads
       , isCurrentThreadBound
       , getNumCapabilities
       , setNumCapabilities
@@ -271,6 +272,13 @@ class ( Monad m
   forkOSWithUnmaskN :: String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
   forkOSWithUnmaskN _ = forkOSWithUnmask
 
+  -- | Returns 'True' if bound threads can be forked.  If 'False',
+  -- 'isCurrentThreadBound' will always return 'False' and both
+  -- 'forkOS' and 'runInBoundThread' will fail.
+  --
+  -- @since 1.7.0.0
+  supportsBoundThreads :: m Bool
+
   -- | Returns 'True' if the calling thread is bound, that is, if it
   -- is safe to use foreign libraries that rely on thread-local state
   -- from the calling thread.
@@ -560,6 +568,18 @@ forkOnN name i ma = forkOnWithUnmaskN name i (const ma)
 forkOSN :: MonadConc m => String -> m () -> m (ThreadId m)
 forkOSN name ma = forkOSWithUnmaskN name (const ma)
 
+-- | 'True' if bound threads are supported.  If
+-- 'rtsSupportsBoundThreads' is 'False', 'isCurrentThreadBound' will
+-- always return 'False' and both 'forkOS' and 'runInBoundThread' will
+-- fail.
+--
+-- Use 'supportsBoundThreads' in 'MonadConc' instead.
+--
+-- @since 1.3.0.0
+{-# DEPRECATED rtsSupportsBoundThreads "Use 'supportsBoundThreads' instead" #-}
+rtsSupportsBoundThreads :: Bool
+rtsSupportsBoundThreads = IO.rtsSupportsBoundThreads
+
 -- | Run the computation passed as the first argument.  If the calling
 -- thread is not /bound/, a bound thread is created temporarily.
 -- @runInBoundThread@ doesn't finish until the inner computation
@@ -726,6 +746,7 @@ instance MonadConc IO where
     labelMe n
     ma umask
 
+  supportsBoundThreads = pure IO.rtsSupportsBoundThreads
   isCurrentThreadBound = IO.isCurrentThreadBound
 
   getNumCapabilities  = IO.getNumCapabilities
@@ -797,6 +818,7 @@ instance MonadConc m => MonadConc (IsConc m) where
   forkOSWithUnmask      ma = toIsConc (forkOSWithUnmask      (\umask -> unIsConc $ ma (\mx -> toIsConc (umask $ unIsConc mx))))
   forkOSWithUnmaskN n   ma = toIsConc (forkOSWithUnmaskN n   (\umask -> unIsConc $ ma (\mx -> toIsConc (umask $ unIsConc mx))))
 
+  supportsBoundThreads = toIsConc supportsBoundThreads
   isCurrentThreadBound = toIsConc isCurrentThreadBound
 
   getNumCapabilities  = toIsConc getNumCapabilities
@@ -845,6 +867,7 @@ instance C => MonadConc (T m) where                            { \
   forkOSWithUnmask      = liftedFork F forkOSWithUnmask        ; \
   forkOSWithUnmaskN n   = liftedFork F (forkOSWithUnmaskN n  ) ; \
                                                                  \
+  supportsBoundThreads = lift supportsBoundThreads             ; \
   isCurrentThreadBound = lift isCurrentThreadBound             ; \
                                                                  \
   getNumCapabilities  = lift getNumCapabilities                ; \

concurrency/concurrency.cabal

@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                concurrency
-version:             1.6.2.0
+version:             1.7.0.0
 synopsis:            Typeclasses, functions, and data types for concurrency and STM.
 
 description:
@@ -19,7 +19,7 @@ license:             MIT
 license-file:        LICENSE
 author:              Michael Walker
 maintainer:          mike@barrucadu.co.uk
-copyright:           (c) 2016--2017 Michael Walker
+copyright:           (c) 2016--2019 Michael Walker
 category:            Concurrency
 build-type:          Simple
 extra-source-files:  README.markdown CHANGELOG.rst
@@ -32,7 +32,7 @@ source-repository head
 source-repository this
   type:     git
   location: https://github.com/barrucadu/dejafu.git
-  tag:      concurrency-1.6.2.0
+  tag:      concurrency-1.7.0.0
 
 library
   exposed-modules:     Control.Monad.Conc.Class

dejafu-tests/dejafu-tests.cabal

@@ -23,13 +23,14 @@ library
 
                      , Integration
                      , Integration.Async
-                     , Integration.SingleThreaded
+                     , Integration.Litmus
+                     , Integration.MonadDejaFu
                      , Integration.MultiThreaded
+                     , Integration.Names
                      , Integration.Refinement
-                     , Integration.Litmus
                      , Integration.Regressions
                      , Integration.SCT
-                     , Integration.Names
+                     , Integration.SingleThreaded
 
                      , Examples
                      , Examples.AutoUpdate

dejafu-tests/lib/Integration.hs

@@ -4,6 +4,7 @@ import           Test.Tasty.Options         (OptionDescription)
 
 import qualified Integration.Async          as A
 import qualified Integration.Litmus         as L
+import qualified Integration.MonadDejaFu    as MD
 import qualified Integration.MultiThreaded  as M
 import qualified Integration.Names          as N
 import qualified Integration.Refinement     as R
@@ -19,6 +20,7 @@ tests =
   [ testGroup "Async"          A.tests
   , testGroup "Litmus"         L.tests
   , testGroup "MultiThreaded"  M.tests
+  , testGroup "MonadDejaFu"    MD.tests
   , testGroup "Names"          N.tests
   , testGroup "Refinement"     R.tests
   , testGroup "Regressions"    G.tests

dejafu-tests/lib/Integration/MonadDejaFu.hs

@@ -0,0 +1,66 @@
+module Integration.MonadDejaFu where
+
+import qualified Control.Concurrent.Classy as C
+
+import           Control.Monad.Catch.Pure  (runCatchT)
+import           Control.Monad.ST          (runST)
+import           Test.DejaFu.Conc          (Condition(..), Program,
+                                            roundRobinSched, runConcurrent)
+import           Test.DejaFu.Settings      (defaultMemType)
+import           Test.DejaFu.Types         (MonadDejaFu)
+import qualified Test.Tasty.HUnit          as TH
+
+import           Common
+
+tests :: [TestTree]
+tests =
+  [ testGroup "IO" ioTests
+  , testGroup "ST" stTests
+  ]
+
+--------------------------------------------------------------------------------
+
+ioTests :: [TestTree]
+ioTests = toTestList
+  [ TH.testCase "Supports bound threads" $
+      let res = single C.supportsBoundThreads
+      in TH.assertEqual "" (Right True) =<< res
+
+  , TH.testCase "Main thread is bound" $
+      let res = single C.isCurrentThreadBound
+      in TH.assertEqual "" (Right True) =<< res
+
+  , TH.testCase "Can fork bound threads" $
+      let res = single $ do
+            _ <- C.forkOS (pure ())
+            pure True
+      in TH.assertEqual "" (Right True) =<< res
+  ]
+
+--------------------------------------------------------------------------------
+
+stTests :: [TestTree]
+stTests = toTestList
+  [ TH.testCase "Doesn't support bound threads" $
+      let res = runST $ runCatchT $ single C.supportsBoundThreads
+      in TH.assertEqual "" (Right (Right False)) res
+
+  , TH.testCase "Main thread isn't bound" $
+      let res = runST $ runCatchT $ single C.isCurrentThreadBound
+      in TH.assertEqual "" (Right (Right False)) res
+
+  , TH.testCase "Can't fork bound threads" $
+      let res = runST $ runCatchT $ single $ do
+            _ <- C.forkOS (pure ())
+            pure True
+      in case res of
+           Right (Left (UncaughtException _)) -> pure ()
+           _ -> TH.assertFailure ("expected: Right (Left (UncaughtException _))\n but got: " ++ show res)
+  ]
+
+--------------------------------------------------------------------------------
+
+single :: MonadDejaFu n => Program pty n a -> n (Either Condition a)
+single program =
+  let fst3 (a, _, _) = a
+  in fst3 <$> runConcurrent roundRobinSched defaultMemType () program

dejafu/CHANGELOG.rst

@@ -6,6 +6,67 @@ standard Haskell versioning scheme.
 
 .. _PVP: https://pvp.haskell.org/
 
+
+2.1.0.0 (2019-03-24)
+--------------------
+
+* Git: :tag:`dejafu-2.1.0.0`
+* Hackage: :hackage:`dejafu-2.1.0.0`
+
+Added
+~~~~~
+
+* The ``Test.DejaFu.Types.MonadDejaFu`` typeclass, containing the
+  primitives needed to run a concurrent program.  There are instances
+  for:
+    * ``IO``, which is probably the ``MonadConc`` instance people used
+      previously, so there is no breaking change there.
+    * ``CatchT (ST t)``, meaning that concurrent programs can be run
+      without ``IO`` once more.
+
+* Thread action constructors for ``MonadConc``
+  ``supportsBoundThreads`` function:
+    * ``Test.DejaFu.Types.ThreadAction``, ``SupportsBoundThreads``
+    * ``Test.DejaFu.Types.Lookahead``, ``WillSupportsBoundThreads``
+
+Changed
+~~~~~~~
+
+* Many functions which had a ``MonadConc`` constraint now have a
+  ``MonadDejaFu`` constraint:
+    * In ``Test.DejaFu``
+        * ``autocheck``
+        * ``autocheckWay``
+        * ``autocheckWithSettings``
+        * ``dejafu``
+        * ``dejafuWay``
+        * ``dejafuWithSettings``
+        * ``dejafus``
+        * ``dejafusWay``
+        * ``dejafusWithSettings``
+        * ``runTest``
+        * ``runTestWay``
+        * ``runTestWithSettings``
+    * In ``Test.DejaFu.Conc``
+        * ``runConcurrent``
+        * ``recordSnapshot``
+        * ``runSnapshot``
+    * In ``Test.DejaFu.SCT``
+        * ``runSCT``
+        * ``resultsSet``
+        * ``runSCT'``
+        * ``resultsSet'``
+        * ``runSCTWithSettings``
+        * ``resultsSetWithSettings``
+        * ``runSCTWithSettings'``
+        * ``resultsSetWithSettings'``
+
+Miscellaneous
+~~~~~~~~~~~~~
+
+* The version bound on :hackage:`concurrency` is >=1.7 and <1.8.
+
+
 2.0.0.1 (2019-03-14)
 --------------------