Merge pull request #21 from adinapoli/issue-16-increase-test-coverage

Fixed #16 and #20

.gitignore

@@ -11,3 +11,4 @@ examples/**.hi
 examples/**.o
 threads-supervisor-example*
 .stack-work
+*.tix

README.md

@@ -26,6 +26,10 @@
 
 # Changelog
 
+* 1.2.0.0 (**Breaking changes, sorry!**)
+    - Remove `SupervisorSpec`
+    - Rename `monitor` to `monitorWith`
+
 * 1.1.0.0
     - (**Breaking Change**) Support lts-5.1 and retry-0.7 (https://github.com/adinapoli/threads-supervisor/pull/9)
 

examples/Main.hs

@@ -2,10 +2,10 @@
 
 module Main where
 
-import Control.Concurrent.Supervisor
 import Control.Concurrent
-import Control.Exception
 import Control.Concurrent.STM
+import Control.Concurrent.Supervisor
+import Control.Exception
 
 job1 :: IO ()
 job1 = do
@@ -30,12 +30,11 @@ job5 = threadDelay 100 >> error "dead"
 
 main :: IO ()
 main = bracketOnError (do
-  supSpec <- newSupervisorSpec OneForOne
-
-  sup1 <- newSupervisor supSpec
-  sup2 <- newSupervisor supSpec
+  sup1 <- newSupervisor OneForOne
+  sup2 <- newSupervisor OneForOne
 
-  sup1 `monitor` sup2
+  sup2ThreadId <- monitorWith fibonacciRetryPolicy sup1 sup2
+  putStrLn $ "Supervisor 2 has ThreadId: " ++ show sup2ThreadId
 
   _ <- forkSupervised sup2 fibonacciRetryPolicy job3
 
@@ -44,9 +43,11 @@ main = bracketOnError (do
   _ <- forkSupervised sup1 fibonacciRetryPolicy job4
   _ <- forkSupervised sup1 fibonacciRetryPolicy job5
   _ <- forkIO (go (eventStream sup1))
+  -- We kill sup2
+  throwTo sup2ThreadId (AssertionFailed "sup2, die please.")
   return sup1) shutdownSupervisor (\_ -> threadDelay 10000000000)
   where
    go eS = do
-     newE <- atomically $ readTQueue eS
+     newE <- atomically $ readQueue eS
      print newE
      go eS

src/Control/Concurrent/Supervisor.hs

@@ -6,38 +6,25 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 
 module Control.Concurrent.Supervisor
-  ( SupervisorSpec
-  , Supervisor
+  ( Supervisor
   , Child
-  , newSupervisorSpec
   , newSupervisor
   , module T
   ) where
 
-import Control.Concurrent.Supervisor.Types as T hiding (newSupervisor, newSupervisorSpec)
-import qualified Control.Concurrent.Supervisor.Types as Types
 import           Control.Concurrent.STM
+import           Control.Concurrent.Supervisor.Types as T hiding (Supervisor, newSupervisor)
+import qualified Control.Concurrent.Supervisor.Types as Types
 
-type SupervisorSpec = Types.SupervisorSpec0 TQueue
-type Supervisor = Types.Supervisor0 TQueue
+type Supervisor = Types.Supervisor TQueue
 
 --------------------------------------------------------------------------------
 type Child = Types.Child_ TQueue
 
 --------------------------------------------------------------------------------
--- | Creates a new 'SupervisorSpec'. The reason it doesn't return a
--- 'Supervisor' is to force you to call 'supervise' explicitly, in order to start the
--- supervisor thread.
-newSupervisorSpec :: Types.RestartStrategy -> IO SupervisorSpec
-newSupervisorSpec strategy = Types.newSupervisorSpec strategy 0
-
--- $supervise
-
---------------------------------------------------------------------------------
-newSupervisor :: SupervisorSpec -> IO Supervisor
-newSupervisor spec = Types.newSupervisor spec
+-- NOTE: The `maxBound` value will be ignore by the underlying implementation.
+newSupervisor :: RestartStrategy -> IO Supervisor
+newSupervisor str = Types.newSupervisor str maxBound 

src/Control/Concurrent/Supervisor/Bounded.hs

@@ -7,50 +7,30 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 
 module Control.Concurrent.Supervisor.Bounded
-  ( SupervisorSpec
-  , Supervisor
+  ( Supervisor
   , Child
-  , newSupervisorSpec
-  , newSupervisorSpecBounded
   , newSupervisor
+  , defaultEventQueueSize
   , module T
   ) where
 
-import Control.Concurrent.Supervisor.Types as T hiding (newSupervisor, newSupervisorSpec)
-import qualified Control.Concurrent.Supervisor.Types as Types
 import           Control.Concurrent.STM
+import           Control.Concurrent.Supervisor.Types as T hiding (Supervisor, newSupervisor)
+import qualified Control.Concurrent.Supervisor.Types as Types
 
-type SupervisorSpec = Types.SupervisorSpec0 TBQueue
-type Supervisor = Types.Supervisor0 TBQueue
+type Supervisor = Types.Supervisor TBQueue
 
 --------------------------------------------------------------------------------
 type Child = Types.Child_ TBQueue
 
---------------------------------------------------------------------------------
--- | Creates a new 'SupervisorSpec'. The reason it doesn't return a
--- 'Supervisor' is to force you to call 'supervise' explicitly, in order to start the
--- supervisor thread.
-newSupervisorSpec :: Types.RestartStrategy -> IO SupervisorSpec
-newSupervisorSpec strategy = Types.newSupervisorSpec strategy defaultEventQueueSize
-
---------------------------------------------------------------------------------
--- | Like 'newSupervisorSpec', but give the user control over the size of the
--- event queue.
-newSupervisorSpecBounded :: Types.RestartStrategy -> Int -> IO SupervisorSpec
-newSupervisorSpecBounded = Types.newSupervisorSpec
-
 --------------------------------------------------------------------------------
 -- | The default size of the queue where `SupervisionEvent`(s) are written.
 defaultEventQueueSize :: Int
 defaultEventQueueSize = 10000
 
--- $supervise
-
 --------------------------------------------------------------------------------
-newSupervisor :: SupervisorSpec -> IO Supervisor
-newSupervisor spec = Types.newSupervisor spec
+newSupervisor :: RestartStrategy -> Int -> IO Supervisor
+newSupervisor = Types.newSupervisor

src/Control/Concurrent/Supervisor/Tutorial.hs

@@ -23,9 +23,6 @@ module Control.Concurrent.Supervisor.Tutorial
     -- * Different type of jobs
     -- $jobs
 
-    -- * Creating a SupervisorSpec
-    -- $createSpec
-
     -- * Creating a Supervisor
     -- $createSupervisor
 
@@ -87,22 +84,11 @@ module Control.Concurrent.Supervisor.Tutorial
 --
 -- These jobs represent a significant pool of our everyday computations in the IO monad
 
--- $createSpec
--- A 'SupervisorSpec' simply holds the state of our supervision, and can be safely shared
--- between supervisors. Under the hood, both the `SupervisorSpec` and the `Supervisor`
--- share the same structure; in fact, they are  just type synonyms:
---
--- > type SupervisorSpec = Supervisor_ Uninitialised
--- > type Supervisor = Supervisor_ Initialised
--- The important difference though, is that the `SupervisorSpec` does not imply the creation
--- of an asynchronous thread, which the latter does. To keep separated the initialisation
--- of the data structure from the logic of supervising, we use  phantom types to
--- force you create a spec first.
--- Creating a spec it just a matter of calling `newSupervisorSpec`.
-
 -- $createSupervisor
--- Creating a 'Supervisor' from a 'SupervisionSpec', is as simple as calling `newSupervisor`.
--- immediately after doing so, a new thread will be started, monitoring any subsequent IO actions
+-- Creating a 'Supervisor' is as simple as calling `newSupervisor`, specifying the `RestartStrategy`
+-- you want to use as well as the size of the `EventStream` (this depends whether you are using a Bounded
+-- supervisor or not).
+-- Immediately after doing so, a new thread will be started, monitoring any subsequent IO actions
 -- submitted to it.
 
 -- $boundedVsUnbounded
@@ -118,12 +104,11 @@ module Control.Concurrent.Supervisor.Tutorial
 --
 -- > main :: IO ()
 -- > main = bracketOnError (do
--- >   supSpec <- newSupervisorSpec OneForOne
 -- >
--- >   sup1 <- newSupervisor supSpec
--- >   sup2 <- newSupervisor supSpec
+-- >   sup1 <- newSupervisor OneForOne
+-- >   sup2 <- newSupervisor OneForOne
 -- >
--- >   sup1 `monitor` sup2
+-- >   monitorWith fibonacciRetryPolicy sup1 sup2
 -- >
 -- >   _ <- forkSupervised sup2 fibonacciRetryPolicy job3
 -- >
@@ -138,14 +123,12 @@ module Control.Concurrent.Supervisor.Tutorial
 -- >      print newE
 -- >      go eS
 --
--- What we have done here, was to spawn our supervisor out from a spec,
--- any using our swiss knife `forkSupervised` to spawn for supervised
+-- What we have done here, was to spawn two supervisors and we have used
+-- our swiss knife `forkSupervised` to spawn four supervised
 -- IO computations. As you can see, if we partially apply `forkSupervised`,
 -- its type resemble `forkIO` one; this is by design, as we want to keep
--- this API as IO-friendly as possible
--- in the very same example, we also create another supervisor
--- (from the same spec, but you can create a separate one as well)
--- and we ask the first supervisor to monitor the second one.
+-- this API as IO-friendly as possible.
+-- Note also how we can ask the first supervisor to monitor the second one.
 --
 -- `fibonacciRetryPolicy` is a constructor for the `RetryPolicy`, which creates
 -- under the hood a `RetryPolicy` from the "retry" package which is using