diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,9 @@
 # Revision history for monad-schedule
 
+## 0.1.2.2
+
+* Compatibility with GHC 9.8
+
 ## 0.1.2.0 -- 2022-06-26
 
 * Added test suite
diff --git a/monad-schedule.cabal b/monad-schedule.cabal
--- a/monad-schedule.cabal
+++ b/monad-schedule.cabal
@@ -1,55 +1,71 @@
-cabal-version:      2.4
-name:               monad-schedule
-version:            0.1.2.1
-license:            MIT
-license-file:       LICENSE
-author:             Manuel Bärenz
-maintainer:         programming@manuelbaerenz.de
-synopsis:           A new, simple, composable concurrency abstraction.
-description:        A monad @m@ is said to allow scheduling if you can pass a number of actions @m a@ to it,
-                    and those can be executed at the same time concurrently.
-                    You can observe the result of the actions after some time:
-                    Some actions will complete first, and the results of these are returned then as a list @'NonEmpty' a@.
-                    Other actions are still running, and for these you will receive continuations of type @m a@,
-                    which you can further run or schedule to completion as you like.
-category:           Concurrency
+cabal-version:   2.4
+name:            monad-schedule
+version:         0.1.2.2
+license:         MIT
+license-file:    LICENSE
+author:          Manuel Bärenz
+maintainer:      programming@manuelbaerenz.de
+synopsis:        A new, simple, composable concurrency abstraction.
+description:
+  A monad @m@ is said to allow scheduling if you can pass a number of actions @m a@ to it,
+  and those can be executed at the same time concurrently.
+  You can observe the result of the actions after some time:
+  Some actions will complete first, and the results of these are returned then as a list @'NonEmpty' a@.
+  Other actions are still running, and for these you will receive continuations of type @m a@,
+  which you can further run or schedule to completion as you like.
 
+category:        Concurrency
+extra-doc-files: CHANGELOG.md
 
-extra-source-files: CHANGELOG.md
+tested-with:
+  GHC == 8.8.4
+  GHC == 8.10.7
+  GHC == 9.0.2
+  GHC == 9.2.5
+  GHC == 9.4.5
+  GHC == 9.6.2
+  GHC == 9.8.1
 
+source-repository head
+  type:     git
+  location: https://github.com/turion/monad-schedule
+
 common deps
   build-depends:
-    , base >= 4.13.0 && <= 4.19
-    , stm >= 2.5
-    , transformers >= 0.5
-    , free >= 5.1
-    , time-domain >= 0.1
+    , base          >=4.13.0 && <4.20.0
+    , free          >=5.1 && < 5.3
+    , stm           ^>=2.5
+    , time-domain   ^>=0.1
+    , transformers  >=0.5 && < 0.7
 
 library
-  import: deps
+  import:           deps
   exposed-modules:
-      Control.Monad.Schedule.Class
-      Control.Monad.Schedule.OSThreadPool
-      Control.Monad.Schedule.RoundRobin
-      Control.Monad.Schedule.Sequence
-      Control.Monad.Schedule.Trans
-      Control.Monad.Schedule.Yield
+    Control.Monad.Schedule.Class
+    Control.Monad.Schedule.OSThreadPool
+    Control.Monad.Schedule.RoundRobin
+    Control.Monad.Schedule.Sequence
+    Control.Monad.Schedule.Trans
+    Control.Monad.Schedule.Yield
+
   hs-source-dirs:   src
   default-language: Haskell2010
 
 test-suite test
-  import: deps
-  type: exitcode-stdio-1.0
-  main-is: Main.hs
+  import:           deps
+  type:             exitcode-stdio-1.0
+  main-is:          Main.hs
   other-modules:
     Trans
     Yield
-  hs-source-dirs: test
+
+  hs-source-dirs:   test
   build-depends:
-    , test-framework >= 0.8
-    , test-framework-quickcheck2 >= 0.3
-    , test-framework-hunit >= 0.3
-    , HUnit >= 1.3
-    , QuickCheck >= 2.12
+    , HUnit                       ^>=1.6
     , monad-schedule
-  default-language:    Haskell2010
+    , QuickCheck                  ^>=2.14
+    , test-framework              ^>=0.8
+    , test-framework-hunit        ^>=0.3
+    , test-framework-quickcheck2  ^>=0.3
+
+  default-language: Haskell2010
diff --git a/src/Control/Monad/Schedule/Class.hs b/src/Control/Monad/Schedule/Class.hs
--- a/src/Control/Monad/Schedule/Class.hs
+++ b/src/Control/Monad/Schedule/Class.hs
@@ -3,16 +3,12 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-module Control.Monad.Schedule.Class where
 
+module Control.Monad.Schedule.Class where
 
 -- base
 import Control.Arrow
@@ -25,12 +21,11 @@
 import Data.Functor.Identity
 import Data.Kind (Type)
 import Data.List.NonEmpty hiding (length)
+import qualified Data.List.NonEmpty as NonEmpty
 import Data.Maybe (fromJust)
 import Data.Void
-import Prelude hiding (map, zip)
 import Unsafe.Coerce (unsafeCoerce)
-
-import qualified Data.List.NonEmpty as NonEmpty
+import Prelude hiding (map, zip)
 
 -- transformers
 import Control.Monad.Trans.Accum
@@ -66,9 +61,10 @@
   --   together with completions for the unfinished actions.
   schedule :: NonEmpty (m a) -> m (NonEmpty a, [m a])
 
--- | Keeps 'schedule'ing actions until all are finished.
---   Returns the same set of values as 'sequence',
---   but utilises concurrency and may thus change the order of the values.
+{- | Keeps 'schedule'ing actions until all are finished.
+  Returns the same set of values as 'sequence',
+  but utilises concurrency and may thus change the order of the values.
+-}
 scheduleAndFinish :: (Monad m, MonadSchedule m) => NonEmpty (m a) -> m (NonEmpty a)
 scheduleAndFinish actions = do
   (finishedFirst, running) <- schedule actions
@@ -78,23 +74,24 @@
       finishedLater <- scheduleAndFinish $ a :| as
       return $ finishedFirst <> finishedLater
 
--- | Uses 'scheduleAndFinish' to execute all actions concurrently,
---   then orders them again.
---   Thus it behaves semantically like 'sequence',
---   but leverages concurrency.
+{- | Uses 'scheduleAndFinish' to execute all actions concurrently,
+  then orders them again.
+  Thus it behaves semantically like 'sequence',
+  but leverages concurrency.
+-}
 sequenceScheduling :: (Monad m, MonadSchedule m) => NonEmpty (m a) -> m (NonEmpty a)
-sequenceScheduling
-  =   zip [1..]
-  >>> map strength
-  >>> scheduleAndFinish
-  >>> fmap (sortWith fst >>> map snd)
+sequenceScheduling =
+  zip [1 ..]
+    >>> map strength
+    >>> scheduleAndFinish
+    >>> fmap (sortWith fst >>> map snd)
   where
-    strength :: Functor m => (a, m b) -> m (a, b)
-    strength (a, mb) = (a, ) <$> mb
+    strength :: (Functor m) => (a, m b) -> m (a, b)
+    strength (a, mb) = (a,) <$> mb
 
 -- | When there are no effects, return all values immediately
 instance MonadSchedule Identity where
-  schedule as = ( , []) <$> sequence as
+  schedule as = (,[]) <$> sequence as
 
 {- |
 Fork all actions concurrently in separate threads and wait for the first one to complete.
@@ -114,103 +111,112 @@
     as' <- drain var
     let remaining = replicate (length as - 1 - length as') $ takeMVar var
     return (a :| as', remaining)
-      where
-        drain :: MVar a -> IO [a]
-        drain var = do
-          aMaybe <- tryTakeMVar var
-          case aMaybe of
-            Just a -> do
-              as' <- drain var
-              return $ a : as'
-            Nothing -> return []
+    where
+      drain :: MVar a -> IO [a]
+      drain var = do
+        aMaybe <- tryTakeMVar var
+        case aMaybe of
+          Just a -> do
+            as' <- drain var
+            return $ a : as'
+          Nothing -> return []
 
 -- TODO Needs dependency
 -- instance MonadSchedule STM where
 
 -- | Pass through the scheduling functionality of the underlying monad
 instance (Functor m, MonadSchedule m) => MonadSchedule (IdentityT m) where
-  schedule
-    =   fmap runIdentityT
-    >>> schedule
-    >>> fmap (fmap (fmap IdentityT))
-    >>> IdentityT
+  schedule =
+    fmap runIdentityT
+      >>> schedule
+      >>> fmap (fmap (fmap IdentityT))
+      >>> IdentityT
 
--- | Write in the order of scheduling:
---   The first actions to return write first.
+{- | Write in the order of scheduling:
+  The first actions to return write first.
+-}
 instance (Monoid w, Functor m, MonadSchedule m) => MonadSchedule (LazyWriter.WriterT w m) where
-  schedule = fmap LazyWriter.runWriterT
-    >>> schedule
-    >>> fmap (first (fmap fst &&& (fmap snd >>> fold)) >>> assoc >>> first (second $ fmap LazyWriter.WriterT))
-    >>> LazyWriter.WriterT
+  schedule =
+    fmap LazyWriter.runWriterT
+      >>> schedule
+      >>> fmap (first (fmap fst &&& (fmap snd >>> fold)) >>> assoc >>> first (second $ fmap LazyWriter.WriterT))
+      >>> LazyWriter.WriterT
     where
       assoc :: ((a, w), c) -> ((a, c), w)
       assoc ((a, w), c) = ((a, c), w)
 
--- | Write in the order of scheduling:
---   The first actions to return write first.
+{- | Write in the order of scheduling:
+  The first actions to return write first.
+-}
 instance (Monoid w, Functor m, MonadSchedule m) => MonadSchedule (StrictWriter.WriterT w m) where
-  schedule = fmap StrictWriter.runWriterT
-    >>> schedule
-    >>> fmap (first (fmap fst &&& (fmap snd >>> fold)) >>> assoc >>> first (second $ fmap StrictWriter.WriterT))
-    >>> StrictWriter.WriterT
+  schedule =
+    fmap StrictWriter.runWriterT
+      >>> schedule
+      >>> fmap (first (fmap fst &&& (fmap snd >>> fold)) >>> assoc >>> first (second $ fmap StrictWriter.WriterT))
+      >>> StrictWriter.WriterT
     where
       assoc :: ((a, w), c) -> ((a, c), w)
       assoc ((a, w), c) = ((a, c), w)
 
--- | Write in the order of scheduling:
---   The first actions to return write first.
+{- | Write in the order of scheduling:
+  The first actions to return write first.
+-}
 instance (Monoid w, Functor m, MonadSchedule m) => MonadSchedule (CPSWriter.WriterT w m) where
-  schedule = fmap CPSWriter.runWriterT
-    >>> schedule
-    >>> fmap (first (fmap fst &&& (fmap snd >>> fold)) >>> assoc >>> first (second $ fmap CPSWriter.writerT))
-    >>> CPSWriter.writerT
+  schedule =
+    fmap CPSWriter.runWriterT
+      >>> schedule
+      >>> fmap (first (fmap fst &&& (fmap snd >>> fold)) >>> assoc >>> first (second $ fmap CPSWriter.writerT))
+      >>> CPSWriter.writerT
     where
       assoc :: ((a, w), c) -> ((a, c), w)
       assoc ((a, w), c) = ((a, c), w)
 
--- | Broadcast the same environment to all actions.
---   The continuations keep this initial environment.
+{- | Broadcast the same environment to all actions.
+  The continuations keep this initial environment.
+-}
 instance (Monad m, MonadSchedule m) => MonadSchedule (ReaderT r m) where
-  schedule actions = ReaderT $ \r
-    -> fmap (`runReaderT` r) actions
-    & schedule
-    & fmap (second $ fmap lift)
+  schedule actions = ReaderT $ \r ->
+    fmap (`runReaderT` r) actions
+      & schedule
+      & fmap (second $ fmap lift)
 
--- | Combination of 'WriterT' and 'ReaderT'.
---   Pass the same initial environment to all actions
---   and write to the log in the order of scheduling in @m@.
+{- | Combination of 'WriterT' and 'ReaderT'.
+  Pass the same initial environment to all actions
+  and write to the log in the order of scheduling in @m@.
+-}
 instance (Monoid w, Monad m, MonadSchedule m) => MonadSchedule (AccumT w m) where
-  schedule actions = AccumT $ \w
-    -> fmap (`runAccumT` w) actions
-    & schedule
-    & fmap collectWritesAndWrap
+  schedule actions = AccumT $ \w ->
+    fmap (`runAccumT` w) actions
+      & schedule
+      & fmap collectWritesAndWrap
     where
       collectWritesAndWrap ::
-        Monoid w =>
+        (Monoid w) =>
         (NonEmpty (a, w), [m (a, w)]) ->
         ((NonEmpty a, [AccumT w m a]), w)
       collectWritesAndWrap (finished, running) =
         let (as, logs) = NonEmpty.unzip finished
-        in ((as, AccumT . const <$> running), fold logs)
+         in ((as, AccumT . const <$> running), fold logs)
 
--- | Schedule all actions according to @m@ and in case of exceptions
---   throw the first exception of the immediately returning actions.
+{- | Schedule all actions according to @m@ and in case of exceptions
+  throw the first exception of the immediately returning actions.
+-}
 instance (Monad m, MonadSchedule m) => MonadSchedule (ExceptT e m) where
-  schedule
-    =   fmap runExceptT
-    >>> schedule
-    >>> fmap ((sequenceA *** fmap ExceptT) >>> extrudeEither)
-    >>> ExceptT
+  schedule =
+    fmap runExceptT
+      >>> schedule
+      >>> fmap (sequenceA *** fmap ExceptT >>> extrudeEither)
+      >>> ExceptT
     where
       extrudeEither :: (Either e a, b) -> Either e (a, b)
-      extrudeEither (ea, b) = (, b) <$> ea
+      extrudeEither (ea, b) = (,b) <$> ea
 
 instance (Monad m, MonadSchedule m) => MonadSchedule (MaybeT m) where
-  schedule
-    =   fmap (maybeToExceptT ())
-    >>> schedule
-    >>> exceptToMaybeT
-    >>> fmap (second $ fmap exceptToMaybeT)
+  schedule =
+    fmap (maybeToExceptT ())
+      >>> schedule
+      >>> exceptToMaybeT
+      >>> fmap (second $ fmap exceptToMaybeT)
 
 -- instance (Monad m, MonadSchedule m) => MonadSchedule (ContT r m) where
 --   schedule actions = ContT $ \scheduler
@@ -218,16 +224,18 @@
 --     & schedule
 --     & _
 
--- | Runs two values in a 'MonadSchedule' concurrently
---   and returns the first one that yields a value
---   and a continuation for the other value.
-race
-  :: (Monad m, MonadSchedule m)
-  => m a -> m b
-  -> m (Either (a, m b) (m a, b))
+{- | Runs two values in a 'MonadSchedule' concurrently
+  and returns the first one that yields a value
+  and a continuation for the other value.
+-}
+race ::
+  (Monad m, MonadSchedule m) =>
+  m a ->
+  m b ->
+  m (Either (a, m b) (m a, b))
 race aM bM = recoverResult <$> schedule ((Left <$> aM) :| [Right <$> bM])
   where
-    recoverResult :: Monad m => (NonEmpty (Either a b), [m (Either a b)]) -> Either (a, m b) (m a, b)
+    recoverResult :: (Monad m) => (NonEmpty (Either a b), [m (Either a b)]) -> Either (a, m b) (m a, b)
     recoverResult (Left a :| [], [bM']) = Left (a, fromRight e <$> bM')
     recoverResult (Right b :| [], [aM']) = Right (fromLeft e <$> aM', b)
     recoverResult (Left a :| [Right b], []) = Left (a, return b)
@@ -236,15 +244,17 @@
     e = error "race: Internal error"
 
 -- FIXME I should only need Selective
+
 -- | Runs both schedules concurrently and returns their results at the end.
-async
-  :: (Monad m, MonadSchedule m)
-  => m  a -> m b
-  -> m (a,     b)
+async ::
+  (Monad m, MonadSchedule m) =>
+  m a ->
+  m b ->
+  m (a, b)
 async aSched bSched = do
   ab <- race aSched bSched
   case ab of
-    Left  (a, bCont) -> do
+    Left (a, bCont) -> do
       b <- bCont
       return (a, b)
     Right (aCont, b) -> do
diff --git a/src/Control/Monad/Schedule/OSThreadPool.hs b/src/Control/Monad/Schedule/OSThreadPool.hs
--- a/src/Control/Monad/Schedule/OSThreadPool.hs
+++ b/src/Control/Monad/Schedule/OSThreadPool.hs
@@ -1,29 +1,29 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE RecordWildCards #-}
+
 module Control.Monad.Schedule.OSThreadPool where
 
 -- base
 import Control.Concurrent
-import Control.Monad ( void, forM, replicateM )
+import Control.Monad (forM, replicateM, void)
 import Control.Monad.IO.Class
-import Data.List.NonEmpty hiding (zip, cycle)
+import Data.Either (partitionEithers)
+import Data.List.NonEmpty hiding (cycle, zip)
 import Data.Proxy
 import GHC.TypeLits
 import Prelude hiding (take)
 
 -- stm
+import Control.Concurrent.STM
 import Control.Concurrent.STM.TChan
 
 -- rhine
 import Control.Monad.Schedule.Class
-import Control.Concurrent.STM
-import Data.Either (partitionEithers)
 
-newtype OSThreadPool (n :: Nat) a = OSThreadPool { unOSThreadPool :: IO a }
+newtype OSThreadPool (n :: Nat) a = OSThreadPool {unOSThreadPool :: IO a}
   deriving (Functor, Applicative, Monad, MonadIO)
 
 data WorkerLink a = WorkerLink
@@ -32,10 +32,10 @@
   }
 
 putJob :: WorkerLink a -> OSThreadPool n a -> IO ()
-putJob WorkerLink { .. } OSThreadPool { .. }
-  = atomically
-  $ writeTChan jobTChan
-  $ Just unOSThreadPool
+putJob WorkerLink {..} OSThreadPool {..} =
+  atomically $
+    writeTChan jobTChan $
+      Just unOSThreadPool
 
 makeWorkerLink :: IO (WorkerLink a)
 makeWorkerLink = do
@@ -50,7 +50,7 @@
             atomically $ writeTChan resultTChan result
             worker
   void $ forkOS worker
-  return WorkerLink { .. }
+  return WorkerLink {..}
 
 proxyForActions :: NonEmpty (OSThreadPool n a) -> Proxy n
 proxyForActions _ = Proxy
@@ -59,8 +59,8 @@
   schedule actions = OSThreadPool $ do
     let n = natVal $ proxyForActions actions
     workerLinks <- replicateM (fromInteger n) makeWorkerLink
-    backgroundActions <- forM (zip (cycle workerLinks) (toList actions))
-      $ \(link, action) -> do
+    backgroundActions <- forM (zip (cycle workerLinks) (toList actions)) $
+      \(link, action) -> do
         putJob link action
         return $ resultTChan link
     pollPools backgroundActions
@@ -72,10 +72,11 @@
           (_, []) -> do
             threadDelay 1000
             pollPools chans
-          (remainingChans, a : as) -> return
-            ( a :| as
-            , OSThreadPool . atomically . readTChan <$> remainingChans
-            )
+          (remainingChans, a : as) ->
+            return
+              ( a :| as
+              , OSThreadPool . atomically . readTChan <$> remainingChans
+              )
 
       pollPool :: TChan a -> IO (Either (TChan a) a)
       pollPool chan = maybe (Left chan) Right <$> atomically (tryReadTChan chan)
diff --git a/src/Control/Monad/Schedule/RoundRobin.hs b/src/Control/Monad/Schedule/RoundRobin.hs
--- a/src/Control/Monad/Schedule/RoundRobin.hs
+++ b/src/Control/Monad/Schedule/RoundRobin.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TupleSections #-}
+
 module Control.Monad.Schedule.RoundRobin where
 
 -- base
@@ -13,16 +14,17 @@
 -- monad-schedule
 import Control.Monad.Schedule.Class
 
--- | Any monad can be trivially scheduled by executing all actions after each other,
---   step by step.
-newtype RoundRobinT m a = RoundRobinT { unRoundRobin :: m a }
+{- | Any monad can be trivially scheduled by executing all actions after each other,
+  step by step.
+-}
+newtype RoundRobinT m a = RoundRobinT {unRoundRobin :: m a}
   deriving (Functor, Applicative, Monad, MonadIO)
 
 instance MonadTrans RoundRobinT where
   lift = RoundRobinT
 
 -- | Execute only the first action, and leave the others for later, preserving the order.
-instance Monad m => MonadSchedule (RoundRobinT m) where
-  schedule actions = ( , NonEmpty.tail actions) <$> fmap pure (NonEmpty.head actions)
+instance (Monad m) => MonadSchedule (RoundRobinT m) where
+  schedule actions = (,NonEmpty.tail actions) <$> fmap pure (NonEmpty.head actions)
 
 type RoundRobin = RoundRobinT Identity
diff --git a/src/Control/Monad/Schedule/Sequence.hs b/src/Control/Monad/Schedule/Sequence.hs
--- a/src/Control/Monad/Schedule/Sequence.hs
+++ b/src/Control/Monad/Schedule/Sequence.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TupleSections #-}
+
 module Control.Monad.Schedule.Sequence where
 
 -- base
@@ -15,15 +16,16 @@
 import Control.Monad.Schedule.Class
 
 -- | Any monad can be trivially scheduled by executing all actions sequentially.
-newtype SequenceT m a = SequenceT { unSequence :: m a }
+newtype SequenceT m a = SequenceT {unSequence :: m a}
   deriving (Functor, Applicative, Monad, MonadIO)
 
 instance MonadTrans SequenceT where
   lift = SequenceT
 
--- | Execute all actions in sequence and return their result when all of them are done.
---   Essentially, this is 'sequenceA'.
-instance Monad m => MonadSchedule (SequenceT m) where
-  schedule = sequenceA >>> fmap (, [])
+{- | Execute all actions in sequence and return their result when all of them are done.
+  Essentially, this is 'sequenceA'.
+-}
+instance (Monad m) => MonadSchedule (SequenceT m) where
+  schedule = sequenceA >>> fmap (,[])
 
 type Sequence = SequenceT Identity
diff --git a/src/Control/Monad/Schedule/Trans.hs b/src/Control/Monad/Schedule/Trans.hs
--- a/src/Control/Monad/Schedule/Trans.hs
+++ b/src/Control/Monad/Schedule/Trans.hs
@@ -1,25 +1,24 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TupleSections #-}
+
 {- |
 This module supplies a general purpose monad transformer
 that adds a syntactical "delay", or "waiting" side effect.
 -}
-
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 module Control.Monad.Schedule.Trans where
 
 -- base
-import Data.Ord (comparing)
-import Control.Arrow (Arrow(second))
+import Control.Arrow (Arrow (second))
+import Control.Category ((>>>))
 import Control.Concurrent
 import qualified Control.Concurrent as C
-import Control.Category ((>>>))
 import Control.Monad (join)
 import Data.Functor.Classes
 import Data.Functor.Identity
-import Data.List.NonEmpty as N hiding (partition)
 import Data.List (partition)
+import Data.List.NonEmpty as N hiding (partition)
+import Data.Ord (comparing)
 
 -- transformers
 import Control.Monad.IO.Class
@@ -41,19 +40,20 @@
 -- | A functor implementing a syntactical "waiting" action.
 data Wait diff a = Wait
   { getDiff :: diff
-      -- ^ The duration to wait.
+  -- ^ The duration to wait.
   , awaited :: a
-      -- ^ The encapsulated value.
+  -- ^ The encapsulated value.
   }
   deriving (Functor, Eq, Show)
 
-instance Eq diff => Eq1 (Wait diff) where
+instance (Eq diff) => Eq1 (Wait diff) where
   liftEq eq (Wait diff1 a) (Wait diff2 b) = diff1 == diff2 && eq a b
 
--- | Compare by the time difference, regardless of the value.
---
---   Note that this would not give a lawful 'Ord' instance since we do not compare the @a@.
-compareWait :: Ord diff => Wait diff a -> Wait diff a -> Ordering
+{- | Compare by the time difference, regardless of the value.
+
+  Note that this would not give a lawful 'Ord' instance since we do not compare the @a@.
+-}
+compareWait :: (Ord diff) => Wait diff a -> Wait diff a -> Ordering
 compareWait = comparing getDiff
 
 -- * 'ScheduleT'
@@ -68,25 +68,29 @@
 type Schedule diff = ScheduleT diff Identity
 
 -- | The side effect that waits for a specified amount.
-wait :: Monad m => diff -> ScheduleT diff m ()
+wait :: (Monad m) => diff -> ScheduleT diff m ()
 wait diff = FreeT $ return $ Free $ Wait diff $ return ()
 
--- | Supply a semantic meaning to 'Wait'.
---   For every occurrence of @Wait diff@ in the @ScheduleT diff m a@ value,
---   a waiting action is executed, depending on 'diff'.
-runScheduleT :: Monad m => (diff -> m ()) -> ScheduleT diff m a -> m a
+{- | Supply a semantic meaning to 'Wait'.
+  For every occurrence of @Wait diff@ in the @ScheduleT diff m a@ value,
+  a waiting action is executed, depending on 'diff'.
+-}
+runScheduleT :: (Monad m) => (diff -> m ()) -> ScheduleT diff m a -> m a
 runScheduleT waitAction = iterT $ \(Wait n ma) -> waitAction n >> ma
 
--- | Run a 'ScheduleT' value in a 'MonadIO',
---   interpreting the times as milliseconds.
-runScheduleIO
-  :: (MonadIO m, Integral n)
-  => ScheduleT n m a -> m a
+{- | Run a 'ScheduleT' value in a 'MonadIO',
+  interpreting the times as milliseconds.
+-}
+runScheduleIO ::
+  (MonadIO m, Integral n) =>
+  ScheduleT n m a ->
+  m a
 runScheduleIO = runScheduleT $ liftIO . threadDelay . (* 1000) . fromIntegral
 
--- | Formally execute all waiting actions,
---   returning the final value and all moments when the schedule would have waited.
-execScheduleT :: Monad m => ScheduleT diff m a -> m (a, [diff])
+{- | Formally execute all waiting actions,
+  returning the final value and all moments when the schedule would have waited.
+-}
+execScheduleT :: (Monad m) => ScheduleT diff m a -> m (a, [diff])
 execScheduleT action = do
   free <- runFreeT action
   case free of
@@ -95,15 +99,16 @@
       (a, diffs) <- execScheduleT cont
       return (a, diff : diffs)
 
-instance Ord diff => MonadSchedule (Wait diff) where
-  schedule waits = let (smallestWait :| waits') = N.sortBy compareWait waits in ((, waits') . pure) <$> smallestWait
+instance (Ord diff) => MonadSchedule (Wait diff) where
+  schedule waits = let (smallestWait :| waits') = N.sortBy compareWait waits in (,waits') . pure <$> smallestWait
 
 isZero :: (Eq diff, TimeDifference diff) => diff -> Bool
 isZero diff = diff `difference` diff == diff
 
--- | Run each action one step until it is discovered which action(s) are pure, or yield next.
---   If there is a pure action, it is returned,
---   otherwise all actions are shifted to the time when the earliest action yields.
+{- | Run each action one step until it is discovered which action(s) are pure, or yield next.
+  If there is a pure action, it is returned,
+  otherwise all actions are shifted to the time when the earliest action yields.
+-}
 instance (Ord diff, TimeDifference diff, Monad m, MonadSchedule m) => MonadSchedule (ScheduleT diff m) where
   schedule actions = do
     (frees, delayed) <- lift $ schedule $ runFreeT <$> actions
@@ -111,30 +116,30 @@
     where
       -- We disregard the inner values @a@ and @b@,
       -- thus this is not an 'Ord' instance.
-      compareFreeFWait
-        :: Ord diff
-        => FreeF (Wait diff) a b
-        -> FreeF (Wait diff) a b
-        -> Ordering
+      compareFreeFWait ::
+        (Ord diff) =>
+        FreeF (Wait diff) a b ->
+        FreeF (Wait diff) a b ->
+        Ordering
       compareFreeFWait (Pure _) (Pure _) = EQ
       compareFreeFWait (Pure _) (Free _) = LT
       compareFreeFWait (Free _) (Pure _) = GT
       compareFreeFWait (Free wait1) (Free wait2) = compareWait wait1 wait2
 
       -- Separate pure from free values
-      partitionFreeF
-        :: [FreeF f a b]
-        -> ([a], [f b])
+      partitionFreeF ::
+        [FreeF f a b] ->
+        ([a], [f b])
       partitionFreeF [] = ([], [])
-      partitionFreeF (Pure a  : xs) = let (as, fbs) = partitionFreeF xs in (a : as, fbs)
+      partitionFreeF (Pure a : xs) = let (as, fbs) = partitionFreeF xs in (a : as, fbs)
       partitionFreeF (Free fb : xs) = let (as, fbs) = partitionFreeF xs in (as, fb : fbs)
 
       -- Shift a waiting action by some duration
-      shift
-        :: TimeDifference diff
-        => diff
-        -> Wait diff a
-        -> Wait diff a
+      shift ::
+        (TimeDifference diff) =>
+        diff ->
+        Wait diff a ->
+        Wait diff a
       shift diff1 (Wait diff2 a) = Wait (diff2 `difference` diff1) a
 
       -- Shift a list of free actions by the duration of the head
@@ -142,12 +147,12 @@
       -- If the head is pure, return it with the remaining actions,
       -- otherwise wait the minimum duration, give the continuation of the head,
       -- and shift the remaining actions by that minimum duration.
-      shiftListOnce
-        :: TimeDifference diff
-        => NonEmpty (FreeF (Wait diff) a b)
-        -> Either
-             (NonEmpty a, [Wait diff b]) -- Pure value has completed
-             (Wait diff (b, [Wait diff b])) -- All values wait
+      shiftListOnce ::
+        (TimeDifference diff) =>
+        NonEmpty (FreeF (Wait diff) a b) ->
+        Either
+          (NonEmpty a, [Wait diff b]) -- Pure value has completed
+          (Wait diff (b, [Wait diff b])) -- All values wait
       shiftListOnce actions = case partitionFreeF $ toList actions of
         (a : as, waits) -> Left (a :| as, waits)
         ([], Wait diff cont : waits) -> Right $ Wait diff (cont, shift diff <$> waits)
@@ -155,17 +160,17 @@
       -- Repeatedly shift the list by the smallest available waiting duration
       -- until one action returns as pure.
       -- Return its result, together with the remaining free actions.
-      shiftList
-        :: (TimeDifference diff, Ord diff, Monad m, MonadSchedule m)
-        => NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a))
-        -- ^ Actionable
-        -> [ScheduleT diff m a]
-        -- ^ Delayed
-        -> ScheduleT diff m (NonEmpty a, [ScheduleT diff m a])
+      shiftList ::
+        (TimeDifference diff, Ord diff, Monad m, MonadSchedule m) =>
+        NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a)) ->
+        -- \^ Actionable
+        [ScheduleT diff m a] ->
+        -- \^ Delayed
+        ScheduleT diff m (NonEmpty a, [ScheduleT diff m a])
       -- FIXME Don't I need to shift delayed as well?
       shiftList actions delayed = case shiftListOnce actions of
         -- Some actions returned. Wrap up the remaining ones.
-        Left (as, waits) -> return (as, delayed ++ ((FreeT . return . Free) <$> waits))
+        Left (as, waits) -> return (as, delayed ++ (FreeT . return . Free <$> waits))
         -- No action has returned.
         -- Wait the remaining time and start scheduling again.
         Right (Wait diff (cont, waits)) -> do
diff --git a/src/Control/Monad/Schedule/Yield.hs b/src/Control/Monad/Schedule/Yield.hs
--- a/src/Control/Monad/Schedule/Yield.hs
+++ b/src/Control/Monad/Schedule/Yield.hs
@@ -17,18 +17,20 @@
 type Yield = YieldT Identity
 
 -- | Let another thread wake up.
-yield :: Monad m => YieldT m ()
+yield :: (Monad m) => YieldT m ()
 yield = wait ()
 
-runYieldT :: Monad m => YieldT m a -> m a
+runYieldT :: (Monad m) => YieldT m a -> m a
 runYieldT = runScheduleT $ const $ return ()
 
 runYield :: Yield a -> a
 runYield = runIdentity . runYieldT
 
--- | Run a 'YieldT' value in a 'MonadIO',
---   interpreting 'yield's as GHC concurrency yields.
-runYieldIO
-  :: MonadIO m
-  => YieldT m a -> m a
+{- | Run a 'YieldT' value in a 'MonadIO',
+  interpreting 'yield's as GHC concurrency yields.
+-}
+runYieldIO ::
+  (MonadIO m) =>
+  YieldT m a ->
+  m a
 runYieldIO = runScheduleT $ const $ liftIO Concurrent.yield
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,7 +1,5 @@
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE RecordWildCards #-}
+
 -- base
 import Control.Arrow
 import Control.Monad
diff --git a/test/Trans.hs b/test/Trans.hs
--- a/test/Trans.hs
+++ b/test/Trans.hs
@@ -1,21 +1,24 @@
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Trans where
 
 -- base
--- base
+import Control.Arrow
 import Control.Monad (forever, void)
+import Data.List (sort)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as NonEmpty
 
 -- transformers
 import Control.Monad.Trans.Class
-import Control.Monad.Trans.Writer (Writer, tell, runWriter, execWriter)
+import Control.Monad.Trans.Writer (Writer, execWriter, runWriter, tell)
 
+-- free
+import Control.Monad.Free (_Free)
+
 -- QuickCheck
 import Test.QuickCheck
 import qualified Test.QuickCheck as QuickCheck
@@ -26,62 +29,87 @@
 -- test-framework-hunit
 import Test.Framework.Providers.HUnit
 
+-- test-framework-quickcheck2
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+
 -- HUnit
 import Test.HUnit hiding (Test)
 
 -- monad-schedule
-import Control.Monad.Schedule.Trans
 import Control.Monad.Schedule.Class (scheduleAndFinish)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Control.Arrow
-import Control.Monad.Free (_Free)
+import Control.Monad.Schedule.Trans
 
 sampleActions :: NonEmpty (MySchedule ())
 sampleActions = [wait 23, wait 42]
 
-tests = testGroup "Trans"
-  [ testCase "Only leftover time is waited"
-    $ assertRunsLike sampleActions [Waited 23, Waited (42 - 23)]
-  , testCase "Scheduling two waits"
-    $ assertRunsEqual sampleActions (NonEmpty.reverse sampleActions)
-  , testCase "Different number of waits"
-    $ assertRunsLike
-      [ myLog "Thread 1 starts" >> wait 5 >> myLog "Thread 1 action" >> wait 5 >> myLog "Thread 1 done"
-      , myLog "Thread 2 starts" >> wait 7 >> myLog "Thread 2 done"
-      ]
-      [ Log "Thread 1 starts"
-      , Log "Thread 2 starts"
-      , Waited 5
-      , Log "Thread 1 action"
-      , Waited 2
-      , Log "Thread 2 done"
-      , Waited 3
-      , Log "Thread 1 done"
-      ]
-  , testCase "Blocking thread doesn't starve other thread (positive wait times)"
-    $ assertRunContains
-      [ forever $ myLog "Busy loop starts" >> wait 1 >> myLog "Busy loop ends"
-      , myLog "One off thread starts" >> wait 2 >> myLog "One off thread does a thing" >> wait 1 >> myLog "One off thread done"
-      ]
-      $ Log "One off thread done"
-  , testCase "Blocking thread doesn't starve other thread (0 waits)"
-    $ assertRunContains
-      [ forever $ myLog "Busy loop starts" >> wait 0 >> myLog "Busy loop ends"
-      , myLog "One off thread starts" >> wait 0 >> myLog "One off thread does a thing" >> wait 0 >> myLog "One off thread done"
-      ]
-      $ Log "One off thread done"
-  , testProperty "Every thread is eventually woken up"
-    $ withMaxSuccess 1000
-    $ \(scripts :: Scripts) (skip :: Positive Int) ->
-    let steps
-          -- In principle, every iteration of the whole script, every thread should be woken up, but allow for some extra overhead
-          = take (3 * sizeScripts scripts + 3)
-          -- Randomly skip some steps ahead
-          $ drop (getPositive skip)
-          $ runMySchedule $ interpretScripts scripts
-    in counterexample ("steps: " ++ show steps)
-    $ conjoin $ map (Log >>> (`elem` steps)) $ NonEmpty.toList $ threadNames scripts
-  ]
+tests =
+  testGroup
+    "Trans"
+    [ testCase "Only leftover time is waited" $
+        assertRunsLike sampleActions [Waited 23, Waited (42 - 23)]
+    , testCase "Scheduling two waits" $
+        assertRunsEqual sampleActions (NonEmpty.reverse sampleActions)
+    , testCase "Different number of waits" $
+        assertRunsLike
+          [ myLog "Thread 1 starts" >> wait 5 >> myLog "Thread 1 action" >> wait 5 >> myLog "Thread 1 done"
+          , myLog "Thread 2 starts" >> wait 7 >> myLog "Thread 2 done"
+          ]
+          [ Log "Thread 1 starts"
+          , Log "Thread 2 starts"
+          , Waited 5
+          , Log "Thread 1 action"
+          , Waited 2
+          , Log "Thread 2 done"
+          , Waited 3
+          , Log "Thread 1 done"
+          ]
+    , testCase "Blocking thread doesn't starve other thread (positive wait times)"
+        $ assertRunContains
+          [ forever $ myLog "Busy loop starts" >> wait 1 >> myLog "Busy loop ends"
+          , myLog "One off thread starts" >> wait 2 >> myLog "One off thread does a thing" >> wait 1 >> myLog "One off thread done"
+          ]
+        $ Log "One off thread done"
+    , testCase "Blocking thread doesn't starve other thread (0 waits)"
+        $ assertRunContains
+          [ forever $ myLog "Busy loop starts" >> wait 0 >> myLog "Busy loop ends"
+          , myLog "One off thread starts" >> wait 0 >> myLog "One off thread does a thing" >> wait 0 >> myLog "One off thread done"
+          ]
+        $ Log "One off thread done"
+    , testProperty "Every thread is eventually woken up" $
+        withMaxSuccess 1000 $
+          \(scripts :: Scripts) (skip :: Positive Int) ->
+            let steps =
+                  -- In principle, every iteration of the whole script, every thread should be woken up, but allow for some extra overhead
+                  take (3 * sizeScripts scripts + 3)
+                  -- Randomly skip some steps ahead
+                  $
+                    drop (getPositive skip) $
+                      runMySchedule $
+                        interpretScripts scripts
+             in counterexample ("steps: " ++ show steps) $
+                  conjoin $
+                    map (Log >>> (`elem` steps)) $
+                      NonEmpty.toList $
+                        threadNames scripts
+    , testCase "Regression example from rhine"
+        $ assertRunsLike
+          (mapM_ wait <$> [[5, 5] :: [Integer], [3, 3, 3]])
+        $ Waited
+          <$> differences
+            [ 3
+            , 5
+            , 6
+            , 9
+            , 10
+            ]
+    , testProperty "Always schedules chronologically" $
+        \(waits :: NonEmpty [Positive Integer]) ->
+          let individualWaits = fmap getPositive <$> waits
+              individualTimes = scanl1 (+) <$> individualWaits
+              allWaits = map Waited $ filter (> 0) $ differences $ sort $ concat individualTimes
+              program = mapM wait <$> individualWaits
+           in runMySchedule program === allWaits
+    ]
 
 assertRunsEqual :: NonEmpty (MySchedule a1) -> NonEmpty (MySchedule a2) -> Assertion
 assertRunsEqual actions1 actions2 = assertEqual "Should run the same under scheduling" (runMySchedule actions1) (runMySchedule actions2)
@@ -108,37 +136,39 @@
 runMySchedule :: NonEmpty (MySchedule a) -> [Event]
 runMySchedule = execWriter . runScheduleT (tell . pure . Waited) . scheduleAndFinish
 
+differences :: [Integer] -> [Integer]
+differences times = uncurry (-) <$> zip times (0 : times)
+
 data Script = Script
   { prefix :: [Positive Integer]
   , loop :: NonEmpty (Positive Integer)
   , threadName :: String
   }
-  deriving Show
+  deriving (Show)
 
 -- FIXME Why is this not in QuickCheck?
-instance Arbitrary a => Arbitrary (NonEmpty a) where
+instance (Arbitrary a) => Arbitrary (NonEmpty a) where
   arbitrary = (NonEmpty.:|) <$> arbitrary <*> arbitrary
 
-
 genScript :: ThreadName -> Gen Script
 genScript threadName = do
   prefix <- arbitrary
   loop <- arbitrary
-  return Script { .. }
+  return Script {..}
 
 instance Arbitrary Scripts where
   arbitrary = do
     nScripts <- getPositive <$> (arbitrary :: Gen (Positive Integer))
-    getScripts <- mapM genScript $ show <$> NonEmpty.fromList [1..nScripts]
-    return Scripts { .. }
+    getScripts <- mapM genScript $ show <$> NonEmpty.fromList [1 .. nScripts]
+    return Scripts {..}
 
-newtype Scripts = Scripts { getScripts :: NonEmpty Script }
-  deriving Show
+newtype Scripts = Scripts {getScripts :: NonEmpty Script}
+  deriving (Show)
 
 type ThreadName = String
 
 interpretScript :: Script -> MySchedule ()
-interpretScript Script { .. } = do
+interpretScript Script {..} = do
   let perform interval = myLog threadName >> wait (getPositive interval)
   mapM_ perform prefix
   forever $ mapM_ perform loop
@@ -147,7 +177,7 @@
 interpretScripts = NonEmpty.map interpretScript . getScripts
 
 sizeScript :: Script -> Int
-sizeScript Script { .. } = fromInteger $ sum (getPositive <$> prefix) + sum (getPositive <$> loop)
+sizeScript Script {..} = fromInteger $ sum (getPositive <$> prefix) + sum (getPositive <$> loop)
 
 sizeScripts :: Scripts -> Int
 sizeScripts = sum . fmap sizeScript . getScripts
diff --git a/test/Yield.hs b/test/Yield.hs
--- a/test/Yield.hs
+++ b/test/Yield.hs
@@ -6,76 +6,83 @@
 
 -- base
 import Control.Monad (forever)
+import Data.Foldable (forM_)
 import Data.List.NonEmpty (NonEmpty, reverse)
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Maybe (fromJust, isJust, maybeToList)
 
 -- transformers
 import Control.Monad.Trans.Class
-import Control.Monad.Trans.Writer (Writer, tell, runWriter, execWriter)
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Writer (Writer, execWriter, runWriter, tell)
 
+-- QuickCheck
+import Test.QuickCheck (NonEmptyList (NonEmpty), counterexample, (===), (==>))
+
 -- test-framework
 import Test.Framework
 
 -- test-framework-hunit
 import Test.Framework.Providers.HUnit
 
+-- test-framework-quickcheck2
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+
 -- HUnit
 import Test.HUnit hiding (Test)
 
 -- monad-schedule
-import Control.Monad.Schedule.Class (scheduleAndFinish, schedule)
+import Control.Monad.Schedule.Class (schedule, scheduleAndFinish)
+import Control.Monad.Schedule.Trans (runScheduleIO, runScheduleT)
 import Control.Monad.Schedule.Yield
-import Control.Monad.Schedule.Trans (runScheduleT, runScheduleIO)
-import Control.Monad.Trans.Reader
-import Data.Foldable (forM_)
-import Test.QuickCheck (NonEmptyList(NonEmpty), (===), (==>), counterexample)
-import qualified Data.List.NonEmpty as NonEmpty
-import Data.Maybe (fromJust, isJust, maybeToList)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
 
 sampleActions :: NonEmpty (MySchedule ())
 sampleActions = [yield, yield]
 
-tests = testGroup "Trans"
-  [ testCase "Only leftover time is waited"
-    $ assertRunsLike sampleActions [Yielded]
-  , testCase "Scheduling two waits"
-    $ assertRunsEqual sampleActions (Data.List.NonEmpty.reverse sampleActions)
-  , testCase "Different number of waits"
-    $ assertRunsLike
-      [ myLog "Thread 1 starts" >> yield >> myLog "Thread 1 action" >> yield >> myLog "Thread 1 done"
-      , myLog "Thread 2 starts" >> yield >> myLog "Thread 2 done"
-      ]
-      [ Log "Thread 1 starts"
-      , Log "Thread 2 starts"
-      , Yielded
-      , Log "Thread 1 action"
-      , Log "Thread 2 done"
-      , Yielded
-      , Log "Thread 1 done"
-      ]
-  , testCase "Blocking thread doesn't starve other thread"
-    $ assertRunContains
-      [ forever $ myLog "Busy loop starts" >> yield >> myLog "Busy loop ends"
-      , myLog "One off thread starts" >> yield >> myLog "One off thread does a thing" >> yield >> myLog "One off thread done"
-      ]
-      $ Log "One off thread done"
-  , testCase "Programs with continuations can be scheduled"
-    $ assertProgramsInitiallyRunsLike
-      [[Log "Thread 1 active",Log "Thread 2 active",Yielded],[Log "Thread 1 active",Log "Thread 2 active",Yielded],[Log "Thread 1 active",Log "Thread 2 active",Yielded],[Log "Thread 1 active",Log "Thread 2 active",Yielded],[Log "Thread 1 active",Log "Thread 2 active",Yielded]]
-      [foreverP (const ["Thread 1 active"]), foreverP (const ["Thread 2 active"])]
-      $ repeat True
-  , testCase "Two programs that tick alternately can be scheduled"
-    $ assertProgramsInitiallyRunsLike
-      [[Log "1 Nope",Log "2 Yes",Yielded,Log "1 Nope"],[Log "2 Nope",Yielded,Log "2 Nope",Log "1 Yes",Yielded,Log "2 Nope"],[Log "1 Yes",Yielded,Log "2 Nope"],[Log "1 Nope",Yielded,Log "1 Nope",Log "2 Yes",Yielded,Log "1 Nope"],[Log "2 Yes",Yielded,Log "1 Nope"],[Log "2 Yes",Yielded,Log "1 Nope"],[Log "2 Yes",Yielded,Log "1 Nope"],[Log "2 Nope",Yielded,Log "2 Nope",Log "1 Yes",Yielded,Log "2 Nope"]]
-      twoPrograms
-      [True, False, False, True, True, True, True, False, False]
-  , testProperty "Two programs that tick alternately can be scheduled with arbitrary input"
-    $ \(inputs :: [Bool]) skip ->
-    let log = take (20 * length inputs) $ drop skip $ concat $ runProgramWith inputs $ schedulePrograms twoPrograms
-        isContained expectedEntry = expectedEntry `elem` log
-    in counterexample (show log)
-    $ all (`elem` drop skip inputs) ([True, False] :: [Bool]) ==> all isContained ([Log "1 Yes", Log "2 Yes"] :: [Event])
-  ]
+tests =
+  testGroup
+    "Trans"
+    [ testCase "Only leftover time is waited" $
+        assertRunsLike sampleActions [Yielded]
+    , testCase "Scheduling two waits" $
+        assertRunsEqual sampleActions (Data.List.NonEmpty.reverse sampleActions)
+    , testCase "Different number of waits" $
+        assertRunsLike
+          [ myLog "Thread 1 starts" >> yield >> myLog "Thread 1 action" >> yield >> myLog "Thread 1 done"
+          , myLog "Thread 2 starts" >> yield >> myLog "Thread 2 done"
+          ]
+          [ Log "Thread 1 starts"
+          , Log "Thread 2 starts"
+          , Yielded
+          , Log "Thread 1 action"
+          , Log "Thread 2 done"
+          , Yielded
+          , Log "Thread 1 done"
+          ]
+    , testCase "Blocking thread doesn't starve other thread"
+        $ assertRunContains
+          [ forever $ myLog "Busy loop starts" >> yield >> myLog "Busy loop ends"
+          , myLog "One off thread starts" >> yield >> myLog "One off thread does a thing" >> yield >> myLog "One off thread done"
+          ]
+        $ Log "One off thread done"
+    , testCase "Programs with continuations can be scheduled"
+        $ assertProgramsInitiallyRunsLike
+          [[Log "Thread 1 active", Log "Thread 2 active", Yielded], [Log "Thread 1 active", Log "Thread 2 active", Yielded], [Log "Thread 1 active", Log "Thread 2 active", Yielded], [Log "Thread 1 active", Log "Thread 2 active", Yielded], [Log "Thread 1 active", Log "Thread 2 active", Yielded]]
+          [foreverP (const ["Thread 1 active"]), foreverP (const ["Thread 2 active"])]
+        $ repeat True
+    , testCase "Two programs that tick alternately can be scheduled" $
+        assertProgramsInitiallyRunsLike
+          [[Log "1 Nope", Log "2 Yes", Yielded, Log "1 Nope"], [Log "2 Nope", Yielded, Log "2 Nope", Log "1 Yes", Yielded, Log "2 Nope"], [Log "1 Yes", Yielded, Log "2 Nope"], [Log "1 Nope", Yielded, Log "1 Nope", Log "2 Yes", Yielded, Log "1 Nope"], [Log "2 Yes", Yielded, Log "1 Nope"], [Log "2 Yes", Yielded, Log "1 Nope"], [Log "2 Yes", Yielded, Log "1 Nope"], [Log "2 Nope", Yielded, Log "2 Nope", Log "1 Yes", Yielded, Log "2 Nope"]]
+          twoPrograms
+          [True, False, False, True, True, True, True, False, False]
+    , testProperty "Two programs that tick alternately can be scheduled with arbitrary input" $
+        \(inputs :: [Bool]) skip ->
+          let log = take (20 * length inputs) $ drop skip $ concat $ runProgramWith inputs $ schedulePrograms twoPrograms
+              isContained expectedEntry = expectedEntry `elem` log
+           in counterexample (show log) $
+                all (`elem` drop skip inputs) ([True, False] :: [Bool]) ==>
+                  all isContained ([Log "1 Yes", Log "2 Yes"] :: [Event])
+    ]
 
 assertRunsEqual :: NonEmpty (MySchedule a1) -> NonEmpty (MySchedule a2) -> Assertion
 assertRunsEqual actions1 actions2 = assertEqual "Should run the same under scheduling" (runMySchedule actions1) (runMySchedule actions2)
@@ -89,7 +96,6 @@
 assertInitiallyRunsLike :: NonEmpty (MySchedule a) -> [Event] -> Assertion
 assertInitiallyRunsLike actions events = assertEqual "Should, at the beginning, run like the following under scheduling" events $ take (length events) $ runMySchedule actions
 
-
 data Event
   = Log String
   | Yielded
@@ -106,7 +112,7 @@
 type MyReaderSchedule a = YieldT (ReaderT Bool (Writer [Event])) a
 
 -- Ok this is basically ListT
-newtype Program = Program { unProgram :: MyReaderSchedule (Maybe Program) }
+newtype Program = Program {unProgram :: MyReaderSchedule (Maybe Program)}
 
 foreverP :: (Bool -> [String]) -> Program
 foreverP action = go
@@ -140,7 +146,7 @@
   ]
 
 runProgram :: Program -> MyReaderSchedule ()
-runProgram Program { .. } = do
+runProgram Program {..} = do
   tick <- unProgram
   forM_ tick runProgram
 
@@ -155,10 +161,13 @@
 -- Should be possible with some recursion scheme
 runProgramWith :: [Bool] -> Program -> [[Event]]
 runProgramWith [] _ = []
-runProgramWith (input : inputs) Program { .. }
-  = let (cont, events) = runWriter $ flip runReaderT input $ runScheduleT (const $ lift $ tell [Yielded]) unProgram
-  in events : (runProgramWith inputs =<< maybeToList cont)
+runProgramWith (input : inputs) Program {..} =
+  let (cont, events) = runWriter $ flip runReaderT input $ runScheduleT (const $ lift $ tell [Yielded]) unProgram
+   in events : (runProgramWith inputs =<< maybeToList cont)
 
 assertProgramsInitiallyRunsLike :: [[Event]] -> NonEmpty Program -> [Bool] -> Assertion
-assertProgramsInitiallyRunsLike events programs inputs = assertEqual "The programs, when scheduled, should run like" events
-  $ take (length events) $ runProgramWith inputs $ schedulePrograms programs
+assertProgramsInitiallyRunsLike events programs inputs =
+  assertEqual "The programs, when scheduled, should run like" events $
+    take (length events) $
+      runProgramWith inputs $
+        schedulePrograms programs