diff --git a/examples/Main.hs b/examples/Main.hs
--- a/examples/Main.hs
+++ b/examples/Main.hs
@@ -30,19 +30,19 @@
 
 main :: IO ()
 main = bracketOnError (do
-  supSpec <- newSupervisorSpec
+  supSpec <- newSupervisorSpec OneForOne
 
   sup1 <- newSupervisor supSpec
   sup2 <- newSupervisor supSpec
 
   sup1 `monitor` sup2
 
-  _ <- forkSupervised sup2 oneForOne job3
+  _ <- forkSupervised sup2 fibonacciRetryPolicy job3
 
-  j1 <- forkSupervised sup1 oneForOne job1
-  _ <- forkSupervised sup1 oneForOne (job2 j1)
-  _ <- forkSupervised sup1 oneForOne job4
-  _ <- forkSupervised sup1 oneForOne job5
+  j1 <- forkSupervised sup1 fibonacciRetryPolicy job1
+  _ <- forkSupervised sup1 fibonacciRetryPolicy (job2 j1)
+  _ <- forkSupervised sup1 fibonacciRetryPolicy job4
+  _ <- forkSupervised sup1 fibonacciRetryPolicy job5
   _ <- forkIO (go (eventStream sup1))
   return sup1) shutdownSupervisor (\_ -> threadDelay 10000000000)
   where
diff --git a/src/Control/Concurrent/Supervisor.hs b/src/Control/Concurrent/Supervisor.hs
--- a/src/Control/Concurrent/Supervisor.hs
+++ b/src/Control/Concurrent/Supervisor.hs
@@ -33,8 +33,8 @@
 -- | 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 :: IO SupervisorSpec
-newSupervisorSpec = Types.newSupervisorSpec 0
+newSupervisorSpec :: Types.RestartStrategy -> IO SupervisorSpec
+newSupervisorSpec strategy = Types.newSupervisorSpec strategy 0
 
 -- $supervise
 
diff --git a/src/Control/Concurrent/Supervisor/Bounded.hs b/src/Control/Concurrent/Supervisor/Bounded.hs
--- a/src/Control/Concurrent/Supervisor/Bounded.hs
+++ b/src/Control/Concurrent/Supervisor/Bounded.hs
@@ -35,13 +35,13 @@
 -- | 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 :: IO SupervisorSpec
-newSupervisorSpec = Types.newSupervisorSpec defaultEventQueueSize
+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 :: Int -> IO SupervisorSpec
+newSupervisorSpecBounded :: Types.RestartStrategy -> Int -> IO SupervisorSpec
 newSupervisorSpecBounded = Types.newSupervisorSpec
 
 --------------------------------------------------------------------------------
diff --git a/src/Control/Concurrent/Supervisor/Tutorial.hs b/src/Control/Concurrent/Supervisor/Tutorial.hs
--- a/src/Control/Concurrent/Supervisor/Tutorial.hs
+++ b/src/Control/Concurrent/Supervisor/Tutorial.hs
@@ -118,18 +118,18 @@
 --
 -- > main :: IO ()
 -- > main = bracketOnError (do
--- >   supSpec <- newSupervisorSpec
+-- >   supSpec <- newSupervisorSpec OneForOne
 -- >
 -- >   sup1 <- newSupervisor supSpec
 -- >   sup2 <- newSupervisor supSpec
 -- >
 -- >   sup1 `monitor` sup2
 -- >
--- >   _ <- forkSupervised sup2 oneForOne job3
+-- >   _ <- forkSupervised sup2 fibonacciRetryPolicy job3
 -- >
--- >   j1 <- forkSupervised sup1 oneForOne job1
--- >   _ <- forkSupervised sup1 oneForOne (job2 j1)
--- >   _ <- forkSupervised sup1 oneForOne job4
+-- >   j1 <- forkSupervised sup1 fibonacciRetryPolicy job1
+-- >   _ <- forkSupervised sup1 fibonacciRetryPolicy (job2 j1)
+-- >   _ <- forkSupervised sup1 fibonacciRetryPolicy job4
 -- >   _ <- forkIO (go (eventStream sup1))
 -- >   return sup1) shutdownSupervisor (\_ -> threadDelay 10000000000)
 -- >   where
@@ -147,10 +147,10 @@
 -- (from the same spec, but you can create a separate one as well)
 -- and we ask the first supervisor to monitor the second one.
 --
--- `oneForOne` is a smart constructor for our `RestartStrategy`,which creates
--- under the hood a `OneForOne`  strategy which is using the `fibonacciBackoff`
--- as `RetryPolicy` from the "retry" package. The clear advantage is that
--- you are not obliged to use it if you don't like this sensible default;
+-- `fibonacciRetryPolicy` is a constructor for the `RetryPolicy`, which creates
+-- under the hood a `RetryPolicy` from the "retry" package which is using
+-- the `fibonacciBackoff`. The clear advantage is that you are not obliged to use
+-- it if you don't like this sensible default;
 -- `RetryPolicy` is an monoid, so you can compose retry policies as you wish.
 --
 -- The `RetryPolicy` will also be responsible for determining whether a thread can be
diff --git a/src/Control/Concurrent/Supervisor/Types.hs b/src/Control/Concurrent/Supervisor/Types.hs
--- a/src/Control/Concurrent/Supervisor/Types.hs
+++ b/src/Control/Concurrent/Supervisor/Types.hs
@@ -25,8 +25,8 @@
   -- * Creating a new supervisor
   -- $sup
   , newSupervisor
-  -- * Restart Strategies
-  , oneForOne
+  -- * Restart Policies
+  , fibonacciRetryPolicy
   -- * Stopping a supervisor
   -- $shutdown
   , shutdownSupervisor
@@ -59,6 +59,7 @@
 --------------------------------------------------------------------------------
 data Supervisor_ q a = Supervisor_ {
         _sp_myTid    :: !(Maybe ThreadId)
+      , _sp_strategy :: !RestartStrategy
       , _sp_children :: !(IORef (Map.HashMap ThreadId (Child_ q)))
       , _sp_mailbox :: TChan DeadLetter
       , _sp_eventStream :: q SupervisionEvent
@@ -88,8 +89,8 @@
 data DeadLetter = DeadLetter ThreadId SomeException
 
 --------------------------------------------------------------------------------
-data Child_ q = Worker !RestartStrategy RestartAction
-              | Supvsr !RestartStrategy !(Supervisor_ q Initialised)
+data Child_ q = Worker !RetryStatus (RetryPolicyM IO) RestartAction
+              | Supvsr !RetryStatus (RetryPolicyM IO) !(Supervisor_ q Initialised)
 
 --------------------------------------------------------------------------------
 type RestartAction = ThreadId -> IO ThreadId
@@ -98,25 +99,22 @@
 data SupervisionEvent =
      ChildBorn !ThreadId !UTCTime
    | ChildDied !ThreadId !SomeException !UTCTime
-   | ChildRestarted !ThreadId !ThreadId !RestartStrategy !UTCTime
-   | ChildRestartLimitReached !ThreadId !RestartStrategy !UTCTime
+   | ChildRestarted !ThreadId !ThreadId !RetryStatus !UTCTime
+   | ChildRestartLimitReached !ThreadId !RetryStatus !UTCTime
    | ChildFinished !ThreadId !UTCTime
    deriving Show
 
 --------------------------------------------------------------------------------
 -- | Erlang inspired strategies. At the moment only the 'OneForOne' is
 -- implemented.
-data RestartStrategy =
-     OneForOne !Int RetryPolicy
-
-instance Show RestartStrategy where
-  show (OneForOne r _) = "OneForOne (Restarted " <> show r <> " times)"
+data RestartStrategy = OneForOne
+  deriving Show
 
 --------------------------------------------------------------------------------
 -- | Smart constructor which offers a default throttling based on
 -- fibonacci numbers.
-oneForOne :: RestartStrategy
-oneForOne = OneForOne 0 $ fibonacciBackoff 100
+fibonacciRetryPolicy :: RetryPolicyM IO
+fibonacciRetryPolicy = fibonacciBackoff 100
 
 -- $new
 -- In order to create a new supervisor, you need a `SupervisorSpec`,
@@ -127,12 +125,12 @@
 -- | 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 :: QueueLike q => Int -> IO (SupervisorSpec0 q)
-newSupervisorSpec size = do
+newSupervisorSpec :: QueueLike q => RestartStrategy -> Int -> IO (SupervisorSpec0 q)
+newSupervisorSpec strategy size = do
   tkn <- newTChanIO
   evt <- newQueueIO size
   ref <- newIORef Map.empty
-  return $ Supervisor_ Nothing ref tkn evt
+  return $ Supervisor_ Nothing strategy ref tkn evt
 
 -- $supervise
 
@@ -142,6 +140,7 @@
   mbx <- atomically $ dupTChan (_sp_mailbox spec)
   return Supervisor_ {
     _sp_myTid = Just tid
+  , _sp_strategy = _sp_strategy spec
   , _sp_mailbox = mbx
   , _sp_children = _sp_children spec
   , _sp_eventStream = _sp_eventStream spec
@@ -154,12 +153,12 @@
 -- to react. It's using a bounded queue to explicitly avoid memory leaks in case
 -- you do not want to drain the queue to listen to incoming events.
 eventStream :: QueueLike q => Supervisor0 q -> q SupervisionEvent
-eventStream (Supervisor_ _ _ _ e) = e
+eventStream (Supervisor_ _ _ _ _ e) = e
 
 --------------------------------------------------------------------------------
 -- | Returns the number of active threads at a given moment in time.
 activeChildren :: QueueLike q => Supervisor0 q -> IO Int
-activeChildren (Supervisor_ _ chRef _ _) = do
+activeChildren (Supervisor_ _ _ chRef _ _) = do
   readIORef chRef >>= return . length . Map.keys
 
 -- $shutdown
@@ -169,7 +168,7 @@
 -- be killed as well. To do so, we explore the children tree, killing workers as we go,
 -- and recursively calling `shutdownSupervisor` in case we hit a monitored `Supervisor`.
 shutdownSupervisor :: QueueLike q => Supervisor0 q -> IO ()
-shutdownSupervisor (Supervisor_ sId chRef _ _) = do
+shutdownSupervisor (Supervisor_ sId _ chRef _ _) = do
   case sId of
     Nothing -> return ()
     Just tid -> do
@@ -180,8 +179,8 @@
     processChildren [] = return ()
     processChildren (x:xs) = do
       case x of
-        (tid, Worker _ _) -> killThread tid
-        (_, Supvsr _ s) -> shutdownSupervisor s
+        (tid, Worker _ _ _) -> killThread tid
+        (_, Supvsr _ _ s) -> shutdownSupervisor s
       processChildren xs
 
 -- $fork
@@ -191,14 +190,14 @@
 forkSupervised :: QueueLike q
                => Supervisor0 q
                -- ^ The 'Supervisor'
-               -> RestartStrategy
-               -- ^ The 'RestartStrategy' to use
+               -> RetryPolicyM IO
+               -- ^ The retry policy to use
                -> IO ()
                -- ^ The computation to run
                -> IO ThreadId
-forkSupervised sup@Supervisor_{..} str act =
+forkSupervised sup@Supervisor_{..} policy act =
   bracket (supervised sup act) return $ \newChild -> do
-    let ch = Worker str (const (supervised sup act))
+    let ch = Worker defaultRetryStatus policy (const (supervised sup act))
     atomicModifyIORef' _sp_children $ \chMap -> (Map.insert newChild ch chMap, ())
     now <- getCurrentTime
     atomically $ writeQueue _sp_eventStream (ChildBorn newChild now)
@@ -207,16 +206,59 @@
 --------------------------------------------------------------------------------
 supervised :: QueueLike q => Supervisor0 q -> IO () -> IO ThreadId
 supervised Supervisor_{..} act = forkFinally act $ \res -> case res of
-  Left ex -> bracket myThreadId return $ \myId -> atomically $ 
+  Left ex -> bracket myThreadId return $ \myId -> atomically $
     writeTChan _sp_mailbox (DeadLetter myId ex)
   Right _ -> bracket myThreadId return $ \myId -> do
     now <- getCurrentTime
     atomicModifyIORef' _sp_children $ \chMap -> (Map.delete myId chMap, ())
     atomically $ writeQueue _sp_eventStream (ChildFinished myId now)
 
+restartChild :: QueueLike q => SupervisorSpec0 q -> UTCTime -> ThreadId -> IO Bool
+restartChild (Supervisor_ myId myStrategy myChildren myMailbox myStream) now newDeath = do
+  chMap <- readIORef myChildren
+  case Map.lookup newDeath chMap of
+    Nothing -> return False
+    Just (Worker rState rPolicy act) ->
+      runRetryPolicy rState rPolicy emitEventChildRestartLimitReached $ \newRState -> do
+        let ch = Worker newRState rPolicy act
+        newThreadId <- act newDeath
+        writeIORef myChildren (Map.insert newThreadId ch $! Map.delete newDeath chMap)
+        emitEventChildRestarted newThreadId newRState
+    Just (Supvsr rState rPolicy s@(Supervisor_ _ str mbx cld es)) ->
+      runRetryPolicy rState rPolicy emitEventChildRestartLimitReached $ \newRState -> do
+        let node = Supervisor_ myId myStrategy myChildren myMailbox myStream
+        let ch = (Supvsr newRState rPolicy s)
+        -- TODO: shutdown children?
+        newThreadId <- supervised node (handleEvents $ Supervisor_ Nothing str mbx cld es)
+        writeIORef myChildren (Map.insert newThreadId ch $! Map.delete newDeath chMap)
+        emitEventChildRestarted newThreadId newRState
+  where
+    emitEventChildRestarted newThreadId newRState = atomically $
+      writeQueue myStream (ChildRestarted newDeath newThreadId newRState now)
+    emitEventChildRestartLimitReached newRState = atomically $
+      writeQueue myStream (ChildRestartLimitReached newDeath newRState now)
+    runRetryPolicy :: RetryStatus
+                 -> RetryPolicyM IO
+                 -> (RetryStatus -> IO ())
+                 -> (RetryStatus -> IO ())
+                 -> IO Bool
+    runRetryPolicy rState rPolicy ifAbort ifThrottle = do
+     maybeDelay <- getRetryPolicyM rPolicy rState
+     case maybeDelay of
+       Nothing -> ifAbort rState >> return False
+       Just delay ->
+         let newRState = rState { rsIterNumber = rsIterNumber rState + 1
+                                , rsCumulativeDelay = rsCumulativeDelay rState + delay
+                                , rsPreviousDelay = Just (maybe 0 (const delay) (rsPreviousDelay rState))
+                                }
+         in threadDelay delay >> ifThrottle newRState >> return True
+
+restartOneForOne :: QueueLike q => SupervisorSpec0 q -> UTCTime -> ThreadId -> IO Bool
+restartOneForOne sup now newDeath = restartChild sup now newDeath
+
 --------------------------------------------------------------------------------
 handleEvents :: QueueLike q => SupervisorSpec0 q -> IO ()
-handleEvents sp@(Supervisor_ myId myChildren myMailbox myStream) = do
+handleEvents sup@(Supervisor_ _ myStrategy _ myMailbox myStream) = do
   (DeadLetter newDeath ex) <- atomically $ readTChan myMailbox
   now <- getCurrentTime
   atomically $ writeQueue myStream (ChildDied newDeath ex now)
@@ -225,39 +267,14 @@
   -- Note to the skeptical: It's perfectly fine do put `undefined` here,
   -- as `typeOf` does not inspect the content (try in GHCi!)
   case typeOf ex == (typeOf (undefined :: AsyncException)) of
-    True -> handleEvents sp
+    True -> handleEvents sup
     False -> do
-     chMap <- readIORef myChildren
-     case Map.lookup newDeath chMap of
-       Nothing -> return ()
-       Just (Worker str act) ->
-         applyStrategy str (\newStr -> do
-                                atomically $
-                                  writeQueue myStream (ChildRestartLimitReached newDeath newStr now)) $ \newStr -> do
-           let ch = Worker newStr act
-           newThreadId <- act newDeath
-           writeIORef myChildren (Map.insert newThreadId ch $! Map.delete newDeath chMap)
-           atomically $ writeQueue myStream (ChildRestarted newDeath newThreadId newStr now)
-       Just (Supvsr str s@(Supervisor_ _ mbx cld es)) ->
-         applyStrategy str (\newStr -> do
-                                atomically $
-                                  writeQueue myStream (ChildRestartLimitReached newDeath newStr now)) $ \newStr -> do
-           let node = Supervisor_ myId myChildren myMailbox myStream
-           let ch = (Supvsr newStr s)
-           newThreadId <- supervised node (handleEvents $ Supervisor_ Nothing mbx cld es)
-           writeIORef myChildren (Map.insert newThreadId ch $! Map.delete newDeath chMap)
-           atomically $ writeQueue myStream (ChildRestarted newDeath newThreadId newStr now)
-     handleEvents sp
-  where
-    applyStrategy :: RestartStrategy
-                  -> (RestartStrategy -> IO ())
-                  -> (RestartStrategy -> IO ())
-                  -> IO ()
-    applyStrategy (OneForOne currentRestarts retryPol) ifAbort ifThrottle = do
-      let newStr = OneForOne (currentRestarts + 1) retryPol
-      case getRetryPolicy retryPol (currentRestarts + 1) of
-        Nothing -> ifAbort newStr
-        Just delay -> threadDelay delay >> ifThrottle newStr
+      successful <- case myStrategy of
+        OneForOne -> restartOneForOne sup now newDeath
+      unless successful $ do
+        -- TODO: shutdown supervisor?
+        return ()
+      handleEvents sup
 
 -- $monitor
 
@@ -271,7 +288,7 @@
 -- Thanks to the fact that for the supervisor the restart means we just copy over
 -- its internal state, it should be perfectly fine to do so.
 monitor :: QueueLike q => Supervisor0 q -> Supervisor0 q -> IO ()
-monitor (Supervisor_ _ _ mbox _) (Supervisor_ mbId _ _ _) = do
+monitor (Supervisor_ _ _ _ mbox _) (Supervisor_ mbId _ _ _ _) = do
   case mbId of
     Nothing -> return ()
     Just tid -> atomically $
diff --git a/test/Tests.hs b/test/Tests.hs
--- a/test/Tests.hs
+++ b/test/Tests.hs
@@ -11,7 +11,6 @@
 import           Control.Monad
 import           Control.Retry
 import           Control.Monad.Trans.Class
-import           Control.Applicative
 import           Control.Concurrent
 import           Control.Concurrent.STM
 import           Control.Exception
@@ -84,9 +83,9 @@
     Nothing -> return []
 
 --------------------------------------------------------------------------------
-assertContainsNMsg :: (SupervisionEvent -> Bool) 
+assertContainsNMsg :: (SupervisionEvent -> Bool)
                    -> Int
-                   -> [SupervisionEvent] 
+                   -> [SupervisionEvent]
                    -> IO ()
 assertContainsNMsg _ 0 _ = HUnit.assertBool "" True
 assertContainsNMsg _ x [] = do
@@ -120,7 +119,7 @@
 assertContainsRestartMsg :: [SupervisionEvent] -> ThreadId -> IOProperty ()
 assertContainsRestartMsg [] _ = QM.assert False
 assertContainsRestartMsg (x:xs) tid = case x of
-  ((ChildRestarted old _ _ _)) -> 
+  ((ChildRestarted old _ _ _)) ->
     if old == tid then QM.assert True else assertContainsRestartMsg xs tid
   _ -> assertContainsRestartMsg xs tid
 
@@ -128,18 +127,18 @@
 -- Control.Concurrent.Supervisor tests
 test1SupThreadNoEx :: IOProperty ()
 test1SupThreadNoEx = forAllM randomLiveTime $ \ttl -> do
-  supSpec <- lift newSupervisorSpec
+  supSpec <- lift $ newSupervisorSpec OneForOne
   sup <- lift $ newSupervisor supSpec
-  _ <- lift (forkSupervised sup oneForOne (forever $ threadDelay ttl))
+  _ <- lift (forkSupervised sup fibonacciRetryPolicy (forever $ threadDelay ttl))
   assertActiveThreads sup (== 1)
   lift $ shutdownSupervisor sup
 
 --------------------------------------------------------------------------------
 test1SupThreadPrematureDemise :: IOProperty ()
 test1SupThreadPrematureDemise = forAllM randomLiveTime $ \ttl -> do
-  supSpec <- lift newSupervisorSpec
+  supSpec <- lift $ newSupervisorSpec OneForOne
   sup <- lift $ newSupervisor supSpec
-  tid <- lift (forkSupervised sup oneForOne (forever $ threadDelay ttl))
+  tid <- lift (forkSupervised sup fibonacciRetryPolicy (forever $ threadDelay ttl))
   lift $ do
     throwTo tid (AssertionFailed "You must die")
     threadDelay ttl --give time to restart the thread
@@ -150,10 +149,10 @@
 
 --------------------------------------------------------------------------------
 fromAction :: Supervisor -> ThreadAction -> IO ThreadId
-fromAction s Live = forkSupervised s oneForOne (forever $ threadDelay 100000000)
-fromAction s (DieAfter (TTL ttl)) = forkSupervised s oneForOne (threadDelay ttl)
-fromAction s (ThrowAfter (TTL ttl)) = forkSupervised s oneForOne (do
-  threadDelay ttl 
+fromAction s Live = forkSupervised s fibonacciRetryPolicy (forever $ threadDelay 100000000)
+fromAction s (DieAfter (TTL ttl)) = forkSupervised s fibonacciRetryPolicy (threadDelay ttl)
+fromAction s (ThrowAfter (TTL ttl)) = forkSupervised s fibonacciRetryPolicy (do
+  threadDelay ttl
   throwIO $ AssertionFailed "die")
 
 --------------------------------------------------------------------------------
@@ -172,7 +171,7 @@
 -- the side effects strikes.
 testKillingSpree :: IOProperty ()
 testKillingSpree = forAllM arbitrary $ \ep@(ExecutionPlan _ acts) -> do
-  supSpec <- lift newSupervisorSpec
+  supSpec <- lift $ newSupervisorSpec OneForOne
   sup <- lift $ newSupervisor supSpec
   _ <- forM acts $ lift . fromAction sup
   lift (threadDelay $ maxWait acts * 2)
@@ -187,7 +186,7 @@
 testSupCleanup :: IOProperty ()
 testSupCleanup = forAllM (vectorOf 100 arbitrary) $ \ttls -> do
   let acts = map DieAfter ttls
-  supSpec <- lift newSupervisorSpec
+  supSpec <- lift $ newSupervisorSpec OneForOne
   sup <- lift $ newSupervisor supSpec
   _ <- forM acts $ lift . fromAction sup
   lift (threadDelay $ maxWait acts * 2)
@@ -198,9 +197,9 @@
 
 testTooManyRestarts :: Assertion
 testTooManyRestarts = do
-  supSpec <- newSupervisorSpec
+  supSpec <- newSupervisorSpec OneForOne
   sup <- newSupervisor supSpec
-  _ <- forkSupervised sup (OneForOne 0 $ limitRetries 5) $ error "die"
+  _ <- forkSupervised sup (limitRetries 5) $ error "die"
   threadDelay 2000000
   q <- qToList (eventStream sup)
   assertContainsNLimitReached 1 q
diff --git a/test/Tests/Bounded.hs b/test/Tests/Bounded.hs
--- a/test/Tests/Bounded.hs
+++ b/test/Tests/Bounded.hs
@@ -11,7 +11,6 @@
 import           Control.Monad
 import           Control.Retry
 import           Control.Monad.Trans.Class
-import           Control.Applicative
 import           Control.Concurrent
 import           Control.Concurrent.STM
 import           Control.Exception
@@ -84,9 +83,9 @@
     Nothing -> return []
 
 --------------------------------------------------------------------------------
-assertContainsNMsg :: (SupervisionEvent -> Bool) 
+assertContainsNMsg :: (SupervisionEvent -> Bool)
                    -> Int
-                   -> [SupervisionEvent] 
+                   -> [SupervisionEvent]
                    -> IO ()
 assertContainsNMsg _ 0 _ = HUnit.assertBool "" True
 assertContainsNMsg _ x [] = do
@@ -120,7 +119,7 @@
 assertContainsRestartMsg :: [SupervisionEvent] -> ThreadId -> IOProperty ()
 assertContainsRestartMsg [] _ = QM.assert False
 assertContainsRestartMsg (x:xs) tid = case x of
-  ((ChildRestarted old _ _ _)) -> 
+  ((ChildRestarted old _ _ _)) ->
     if old == tid then QM.assert True else assertContainsRestartMsg xs tid
   _ -> assertContainsRestartMsg xs tid
 
@@ -128,18 +127,18 @@
 -- Control.Concurrent.Supervisor tests
 test1SupThreadNoEx :: IOProperty ()
 test1SupThreadNoEx = forAllM randomLiveTime $ \ttl -> do
-  supSpec <- lift newSupervisorSpec
+  supSpec <- lift $ newSupervisorSpec OneForOne
   sup <- lift $ newSupervisor supSpec
-  _ <- lift (forkSupervised sup oneForOne (forever $ threadDelay ttl))
+  _ <- lift (forkSupervised sup fibonacciRetryPolicy (forever $ threadDelay ttl))
   assertActiveThreads sup (== 1)
   lift $ shutdownSupervisor sup
 
 --------------------------------------------------------------------------------
 test1SupThreadPrematureDemise :: IOProperty ()
 test1SupThreadPrematureDemise = forAllM randomLiveTime $ \ttl -> do
-  supSpec <- lift newSupervisorSpec
+  supSpec <- lift $ newSupervisorSpec OneForOne
   sup <- lift $ newSupervisor supSpec
-  tid <- lift (forkSupervised sup oneForOne (forever $ threadDelay ttl))
+  tid <- lift (forkSupervised sup fibonacciRetryPolicy (forever $ threadDelay ttl))
   lift $ do
     throwTo tid (AssertionFailed "You must die")
     threadDelay ttl --give time to restart the thread
@@ -150,9 +149,9 @@
 
 --------------------------------------------------------------------------------
 fromAction :: Supervisor -> ThreadAction -> IO ThreadId
-fromAction s Live = forkSupervised s oneForOne (forever $ threadDelay 100000000)
-fromAction s (DieAfter (TTL ttl)) = forkSupervised s oneForOne (threadDelay ttl)
-fromAction s (ThrowAfter (TTL ttl)) = forkSupervised s oneForOne (do
+fromAction s Live = forkSupervised s fibonacciRetryPolicy (forever $ threadDelay 100000000)
+fromAction s (DieAfter (TTL ttl)) = forkSupervised s fibonacciRetryPolicy (threadDelay ttl)
+fromAction s (ThrowAfter (TTL ttl)) = forkSupervised s fibonacciRetryPolicy (do
   threadDelay ttl
   throwIO $ AssertionFailed "die")
 
@@ -172,7 +171,7 @@
 -- the side effects strikes.
 testKillingSpree :: IOProperty ()
 testKillingSpree = forAllM arbitrary $ \ep@(ExecutionPlan _ acts) -> do
-  supSpec <- lift newSupervisorSpec
+  supSpec <- lift $ newSupervisorSpec OneForOne
   sup <- lift $ newSupervisor supSpec
   _ <- forM acts $ lift . fromAction sup
   lift (threadDelay $ maxWait acts * 2)
@@ -187,7 +186,7 @@
 testSupCleanup :: IOProperty ()
 testSupCleanup = forAllM (vectorOf 100 arbitrary) $ \ttls -> do
   let acts = map DieAfter ttls
-  supSpec <- lift newSupervisorSpec
+  supSpec <- lift $ newSupervisorSpec OneForOne
   sup <- lift $ newSupervisor supSpec
   _ <- forM acts $ lift . fromAction sup
   lift (threadDelay $ maxWait acts * 2)
@@ -198,9 +197,9 @@
 
 testTooManyRestarts :: Assertion
 testTooManyRestarts = do
-  supSpec <- newSupervisorSpec
+  supSpec <- newSupervisorSpec OneForOne
   sup <- newSupervisor supSpec
-  _ <- forkSupervised sup (OneForOne 0 $ limitRetries 5) $ error "die"
+  _ <- forkSupervised sup (limitRetries 5) $ error "die"
   threadDelay 2000000
   q <- qToList (eventStream sup)
   assertContainsNLimitReached 1 q
diff --git a/threads-supervisor.cabal b/threads-supervisor.cabal
--- a/threads-supervisor.cabal
+++ b/threads-supervisor.cabal
@@ -1,5 +1,5 @@
 name:                threads-supervisor
-version:             1.0.4.1
+version:             1.1.0.0
 synopsis:            Simple, IO-based library for Erlang-style thread supervision
 description:         Simple, IO-based library for Erlang-style thread supervision
 license:             MIT
@@ -27,7 +27,7 @@
   build-depends:
     base                 >= 4.6 && < 6,
     unordered-containers >= 0.2.0.0 && < 0.5.0.0,
-    retry                >= 0.5 && < 0.10,
+    retry                >= 0.7 && < 0.10,
     stm                  >= 2.4,
     time                 >= 1.2
   hs-source-dirs: src