From 4e06727bb0306ea7f4df72faf1e08a4b427ff7f5 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Mon, 10 Dec 2018 23:05:17 +0400
Subject: [PATCH 01/39] add seq/par

---
 bower.json                     |  1 +
 src/Test/Spec.purs             | 30 ++++++++++++----
 src/Test/Spec/Runner.purs      | 62 +++++++++++++++++++++++++---------
 test/Main.purs                 |  6 ++--
 test/Test/Spec/RunnerSpec.purs | 36 +++++++++++++++-----
 5 files changed, 103 insertions(+), 32 deletions(-)

diff --git a/bower.json b/bower.json
index acac102..db72750 100644
--- a/bower.json
+++ b/bower.json
@@ -15,6 +15,7 @@
     "url": "git://github.com/purescript-spec/purescript-spec.git"
   },
   "dependencies": {
+    "purescript-avar": "^3.0.0",
     "purescript-console": "^4.1.0",
     "purescript-aff": "^5.0.0",
     "purescript-exceptions": "^4.0.0",
diff --git a/src/Test/Spec.purs b/src/Test/Spec.purs
index 0e366cc..bf0457f 100644
--- a/src/Test/Spec.purs
+++ b/src/Test/Spec.purs
@@ -6,6 +6,8 @@ module Test.Spec (
   Spec(..),
   describe,
   describeOnly,
+  parallel,
+  sequential,
   pending,
   pending',
   it,
@@ -18,7 +20,7 @@ import Prelude
 import Control.Monad.State as State
 import Effect.Aff (Aff)
 import Effect.Exception (Error)
-import Control.Monad.State (State, modify, execState, runState)
+import Control.Monad.State (State, execState, runState)
 import Data.Traversable (for, for_)
 import Data.Tuple (snd)
 
@@ -27,6 +29,8 @@ type Only = Boolean
 
 data Group t
   = Describe Only Name (Array (Group t))
+  | Parallel (Array (Group t))
+  | Sequential (Array (Group t))
   | It Only Name t
   | Pending Name
 
@@ -44,11 +48,15 @@ instance eqResult :: Eq Result where
   eq _ _ = false
 
 instance showGroup :: Show t => Show (Group t) where
+  show (Parallel groups) = "Parallel " <> show groups
+  show (Sequential groups) = "Sequential " <> show groups
   show (Describe only name groups) = "Describe " <> show only <> " " <> show name <> " " <> show groups
   show (It only name test) = "It " <> show only <> " " <> show name <> " " <> show test
   show (Pending name) = "Describe " <> show name
 
 instance eqGroup :: Eq t => Eq (Group t) where
+  eq (Parallel g1)       (Parallel g2)       = g1 == g2
+  eq (Sequential g1)     (Sequential g2)     = g1 == g2
   eq (Describe o1 n1 g1) (Describe o2 n2 g2) = o1 == o2 && n1 == n2 && g1 == g2
   eq (It o1 n1 t1)       (It o2 n2 t2)       = o1 == o2 && n1 == n2 && t1 == t2
   eq (Pending n1)        (Pending n2)        = n1 == n2
@@ -74,12 +82,12 @@ countTests spec = execState (for (collect spec) go) 0
 
 -- | Combine a group of specs into a described hierarchy that either has the
 -- |"only" modifier applied or not.
-_describe :: Boolean
+_describe :: Only
          -> String
          -> Spec Unit
          -> Spec Unit
-_describe only name its =
-  modify (_ <> [Describe only name (collect its)]) $> unit
+_describe opts name its =
+  State.modify_ (_ <> [Describe opts name (collect its)])
 
 -- | Combine a group of specs into a described hierarchy.
 describe :: String
@@ -95,10 +103,20 @@ describeOnly :: String
          -> Spec Unit
 describeOnly = _describe true
 
+-- | marks all spec items of the given spec to be safe for parallel evaluation.
+parallel :: Spec Unit
+         -> Spec Unit
+parallel its = State.modify_ (_ <> [Parallel (collect its)])
+
+-- | marks all spec items of the given spec to be evaluated sequentially.
+sequential :: Spec Unit
+           -> Spec Unit
+sequential its = State.modify_ (_ <> [Sequential (collect its)])
+
 -- | Create a pending spec.
 pending :: String
         -> Spec Unit
-pending name = void $ modify $ \p -> p <> [Pending name]
+pending name = State.modify_ (_ <> [Pending name])
 
 -- | Create a pending spec with a body that is ignored by
 -- | the runner. It can be useful for documenting what the
@@ -114,7 +132,7 @@ _it :: Boolean
    -> String
    -> Aff Unit
    -> Spec Unit
-_it only description tests = modify (_ <> [It only description tests]) $> unit
+_it only description tests = State.modify_ (_ <> [It only description tests])
 
 -- | Create a spec with a description.
 it :: String
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index 9936b9f..8b28815 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -13,21 +13,22 @@ module Test.Spec.Runner
 import Prelude
 
 import Control.Alternative ((<|>))
-import Effect (Effect)
-import Effect.Aff (Aff, attempt, delay, makeAff, throwError, try)
-import Effect.Class (liftEffect)
-import Effect.Console (logShow)
-import Effect.Exception (Error, error)
-import Effect.Exception as Error
 import Control.Monad.Trans.Class (lift)
-import Control.Parallel (sequential, parallel)
+import Control.Parallel (parTraverse, parallel, sequential)
 import Data.Array (singleton)
 import Data.Either (Either(..), either)
 import Data.Foldable (foldl)
 import Data.Int (toNumber)
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Time.Duration (Milliseconds(..))
-import Data.Traversable (for)
+import Data.Traversable (class Traversable, for)
+import Effect (Effect)
+import Effect.Aff (Aff, attempt, delay, forkAff, joinFiber, makeAff, throwError, try)
+import Effect.Aff.AVar as AV
+import Effect.Class (liftEffect)
+import Effect.Console (logShow)
+import Effect.Exception (Error, error)
+import Effect.Exception as Error
 import Pipes ((>->), yield)
 import Pipes.Core (Pipe, Producer, (//>))
 import Pipes.Core (runEffectRec) as P
@@ -61,7 +62,7 @@ trim xs = fromMaybe xs (singleton <$> findJust findOnly xs)
   where
   findOnly :: Group r -> Maybe (Group r)
   findOnly g@(It true _ _) = pure g
-  findOnly g@(Describe o _ gs) = findJust findOnly gs <|> if o then pure g else Nothing
+  findOnly g@(Describe {only} _ gs) = findJust findOnly gs <|> if only then pure g else Nothing
   findOnly _ = Nothing
 
   findJust :: forall a. (a -> Maybe a) -> Array a -> Maybe a
@@ -99,12 +100,32 @@ _run
   -> Producer Event Aff (Array (Group Result))
 _run config spec = do
   yield (Event.Start (Spec.countTests spec))
-  r <- for (trim $ collect spec) runGroup
+  r <- for (trim $ collect spec) (runGroup false)
   yield (Event.End r)
   pure r
-
   where
-  runGroup (It only name test) = do
+  -- https://github.com/felixSchl/purescript-pipes/issues/16
+  mergeProducers :: forall t o a. Traversable t => t (Producer o Aff a) -> Producer o Aff (t a)
+  mergeProducers ps = do
+    var <- lift AV.empty
+
+    fib <- lift $ forkAff do
+      let consumer i = lift (AV.put i var) *> pure unit
+      x <- parTraverse (\p -> P.runEffectRec $ p //> consumer) ps
+      AV.kill (error "finished") var
+      pure x
+
+    let
+      loop = do
+        res <- lift $ try (AV.take var)
+        case res of
+          Left err -> lift $ joinFiber fib
+          Right e -> do
+            yield e
+            loop
+    loop
+  runGroup :: Boolean -> Group (Aff Unit) -> Producer Event Aff (Group Result)
+  runGroup isPar (It only name test) = do
     yield Event.Test
     start    <- lift $ liftEffect dateNow
     e        <- lift $ attempt case config.timeout of
@@ -121,14 +142,23 @@ _run config spec = do
     yield Event.TestEnd
     pure $ It only name $ either Failure (const Success) e
 
-  runGroup (Pending name) = do
+  runGroup isPar (Pending name) = do
     yield $ Event.Pending name
     pure $ Pending name
 
-  runGroup (Describe only name xs) = do
+  runGroup _ (Parallel xs) = do
+    Parallel <$> mergeProducers (runGroup true <$> xs)
+
+  runGroup _ (Sequential xs) = do
+    Sequential <$> for xs (runGroup false)
+
+  runGroup isPar (Describe only name xs) = do
     yield $ Event.Suite name
-    Describe only name <$> (for xs runGroup)
-    <* yield Event.SuiteEnd
+    x <- Describe only name <$> if isPar
+      then mergeProducers (runGroup isPar <$> xs)
+      else for xs (runGroup isPar)
+    yield Event.SuiteEnd
+    pure x
 
 -- | Run a spec, returning the results, without any reporting
 runSpec'
diff --git a/test/Main.purs b/test/Main.purs
index 5b84c8e..9be0c71 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -1,14 +1,16 @@
 module Test.Main where
 
 import Prelude
+
+import Data.Maybe (Maybe(..))
 import Effect (Effect)
 import Effect.Aff (launchAff_)
 import Test.Spec.AssertionSpec (assertionSpec)
 import Test.Spec.Reporter (consoleReporter)
-import Test.Spec.Runner (run)
+import Test.Spec.Runner (defaultConfig, run')
 import Test.Spec.RunnerSpec (runnerSpec)
 
 main :: Effect Unit
-main = launchAff_ $ run [ consoleReporter ] do
+main = launchAff_ $ run' (defaultConfig{timeout = Nothing}) [ consoleReporter ] do
   runnerSpec
   assertionSpec
diff --git a/test/Test/Spec/RunnerSpec.purs b/test/Test/Spec/RunnerSpec.purs
index f873923..4b34426 100644
--- a/test/Test/Spec/RunnerSpec.purs
+++ b/test/Test/Spec/RunnerSpec.purs
@@ -1,9 +1,11 @@
 module Test.Spec.RunnerSpec where
 
 import Prelude
+
 import Data.Time.Duration (Milliseconds(..))
 import Effect.Aff (delay)
-import Test.Spec (Group(..), Result(..), Spec, describe, it)
+import Effect.Class.Console (log)
+import Test.Spec (Group(..), Result(..), Spec, describe, describePar, it)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Spec.Fixtures (itOnlyTest, describeOnlyNestedTest, describeOnlyTest, sharedDescribeTest, successTest)
 import Test.Spec.Runner (runSpec)
@@ -12,24 +14,42 @@ runnerSpec :: Spec Unit
 runnerSpec =
   describe "Test" $
     describe "Spec" $
-      describe "Runner" do
+      describePar "Runner" do
         it "collects \"it\" and \"pending\" in Describe groups" do
+          log "start 1"
+          delay $ Milliseconds $ 1000.0 + 300.0 * 1.0
+          log "done 1"
           results <- runSpec successTest
-          results `shouldEqual` [Describe false "a" [Describe false "b" [It false "works" Success]]]
+          results `shouldEqual` [Describe {only: false, parallel: false} "a" [Describe {only: false, parallel: false} "b" [It false "works" Success]]]
         it "collects \"it\" and \"pending\" with shared Describes" do
+          log "start 2"
+          delay $ Milliseconds $ 1000.0 + 300.0 * 2.0
+          log "done 2"
           results <- runSpec sharedDescribeTest
-          results `shouldEqual` [Describe false "a" [Describe false "b" [It false "works" Success],
-                                                     Describe false "c" [It false "also works" Success]]]
+          results `shouldEqual` [Describe {only: false, parallel: false} "a" [Describe {only: false, parallel: false} "b" [It false "works" Success],
+                                                     Describe {only: false, parallel: false} "c" [It false "also works" Success]]]
         it "filters using \"only\" modifier on \"describe\" block" do
+          log "start 3"
+          delay $ Milliseconds $ 1000.0 + 300.0 * 3.0
+          log "done 3"
           results <- runSpec describeOnlyTest
-          results `shouldEqual` [Describe true "a" [Describe false "b" [It false "works" Success],
-                                                    Describe false "c" [It false "also works" Success]]]
+          results `shouldEqual` [Describe {only: true, parallel: false} "a" [Describe {only: false, parallel: false} "b" [It false "works" Success],
+                                                    Describe {only: false, parallel: false} "c" [It false "also works" Success]]]
         it "filters using \"only\" modifier on nested \"describe\" block" do
+          log "start 4"
+          delay $ Milliseconds $ 1000.0 + 300.0 * 4.0
+          log "done 4"
           results <- runSpec describeOnlyNestedTest
-          results `shouldEqual` [Describe true "b" [It false "works" Success]]
+          results `shouldEqual` [Describe {only: true, parallel: false} "b" [It false "works" Success]]
         it "filters using \"only\" modifier on \"it\" block" do
+          log "start 5"
+          delay $ Milliseconds $ 1000.0 + 300.0 * 5.0
+          log "done 5"
           results <- runSpec itOnlyTest
           results `shouldEqual` [It true "works" Success]
         it "supports async" do
+          log "start 6"
+          delay $ Milliseconds $ 1000.0 + 300.0 * 6.0
+          log "done 6"
           res <- delay (Milliseconds 10.0) *> pure 1
           res `shouldEqual` 1

From daf6b3345a82727c1cf6e48ad8f0aed21e98ee40 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 11 Dec 2018 14:27:19 +0400
Subject: [PATCH 02/39] add hoist and example/tests

---
 src/Test/Spec.purs             | 169 ++++++++++++++++++---------------
 src/Test/Spec/Runner.purs      |  76 ++++++++-------
 src/Test/Spec/Summary.purs     |   1 +
 test/Main.purs                 |   2 +
 test/Test/Spec/HoistSpec.purs  |  76 +++++++++++++++
 test/Test/Spec/RunnerSpec.purs |  35 ++-----
 6 files changed, 221 insertions(+), 138 deletions(-)
 create mode 100644 test/Test/Spec/HoistSpec.purs

diff --git a/src/Test/Spec.purs b/src/Test/Spec.purs
index bf0457f..6336917 100644
--- a/src/Test/Spec.purs
+++ b/src/Test/Spec.purs
@@ -2,8 +2,13 @@ module Test.Spec (
   Name(..),
   Only(..),
   Result(..),
+  Execution(..),
   Group(..),
   Spec(..),
+  Spec'(..),
+  TestEnv,
+  hoistSpec,
+  hoistSpec',
   describe,
   describeOnly,
   parallel,
@@ -12,137 +17,151 @@ module Test.Spec (
   pending',
   it,
   itOnly,
-  collect,
   countTests
   ) where
 
 import Prelude
+
+import Control.Monad.State (execState)
 import Control.Monad.State as State
+import Control.Monad.Writer (Writer, execWriter, mapWriter, tell)
+import Data.Array (snoc)
+import Data.Array.NonEmpty (NonEmptyArray)
+import Data.Array.NonEmpty as NEA
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Eq (genericEq)
+import Data.Generic.Rep.Show (genericShow)
+import Data.Traversable (for, for_)
+import Data.Tuple (Tuple(..))
 import Effect.Aff (Aff)
 import Effect.Exception (Error)
-import Control.Monad.State (State, execState, runState)
-import Data.Traversable (for, for_)
-import Data.Tuple (snd)
 
 type Name = String
 type Only = Boolean
 
 data Group t
   = Describe Only Name (Array (Group t))
-  | Parallel (Array (Group t))
-  | Sequential (Array (Group t))
+  | SetExecution Execution (Array (Group t))
   | It Only Name t
   | Pending Name
 
+derive instance genericGroup :: Generic (Group t) _
+instance showGroup :: Show t => Show (Group t) where show = genericShow
+instance eqGroup :: Eq t => Eq (Group t) where eq = genericEq
+
 data Result
   = Success
   | Failure Error
 
 instance showResult :: Show Result where
   show Success = "Success"
-  show (Failure err) = "Failure (Error ...)"
+  show (Failure err) = "(Failure " <> show err <> ")"
 
 instance eqResult :: Eq Result where
   eq Success Success = true
-  eq (Failure _) (Failure _) = true
+  eq (Failure err1) (Failure err2) = show err1 == show err2
   eq _ _ = false
 
-instance showGroup :: Show t => Show (Group t) where
-  show (Parallel groups) = "Parallel " <> show groups
-  show (Sequential groups) = "Sequential " <> show groups
-  show (Describe only name groups) = "Describe " <> show only <> " " <> show name <> " " <> show groups
-  show (It only name test) = "It " <> show only <> " " <> show name <> " " <> show test
-  show (Pending name) = "Describe " <> show name
-
-instance eqGroup :: Eq t => Eq (Group t) where
-  eq (Parallel g1)       (Parallel g2)       = g1 == g2
-  eq (Sequential g1)     (Sequential g2)     = g1 == g2
-  eq (Describe o1 n1 g1) (Describe o2 n2 g2) = o1 == o2 && n1 == n2 && g1 == g2
-  eq (It o1 n1 t1)       (It o2 n2 t2)       = o1 == o2 && n1 == n2 && t1 == t2
-  eq (Pending n1)        (Pending n2)        = n1 == n2
-  eq _                   _                   = false
+data Execution = Parallel | Sequential
+derive instance genericExecution :: Generic Execution _
+instance showExecution :: Show Execution where show = genericShow
+instance eqExecution :: Eq Execution where eq = genericEq
 
--- Specifications with unevaluated tests.
-type Spec t = State (Array (Group (Aff Unit))) t
 
-collect :: Spec Unit
-        -> Array (Group (Aff Unit))
-collect r = snd $ runState r []
+-- Specifications with unevaluated tests.
+type Spec t = Spec' Aff t
+type Spec' m t = Writer (Array (Group (m Unit))) t
 
 -- | Count the total number of tests in a spec
-countTests :: Spec Unit -> Int
-countTests spec = execState (for (collect spec) go) 0
+countTests :: forall m. Spec' m Unit -> Int
+countTests spec = execState (for (execWriter spec) go) 0
   where
+  go (SetExecution _ xs) = for_ xs go
   go (Describe _ _ xs) = for_ xs go
-  go _ = void $ State.modify (_ + 1)
+  go (It _ _ _) = State.modify_ (_ + 1)
+  go (Pending _) = State.modify_ (_ + 1)
 
+
+type TestEnv = { name :: NonEmptyArray Name, execution :: Execution }
+
+hoistSpec :: forall m g. (m ~> g) -> Spec' m ~> Spec' g
+hoistSpec f = hoistSpec' \_ -> f
+
+hoistSpec' :: forall m g. (TestEnv -> m ~> g) -> Spec' m ~> Spec' g
+hoistSpec' f = mapWriter \(Tuple a s) -> Tuple a $ map (go Sequential []) s
+  where
+    go :: Execution -> Array Name -> Group (m Unit) -> Group (g Unit)
+    go execution ns = case _ of
+      Describe o n rest -> Describe o n $ go execution (ns `snoc` n) <$> rest
+      SetExecution execution' rest -> SetExecution execution' $ go execution' ns <$> rest
+      It o n t -> It o n $ f { execution, name: ns `NEA.snoc'` n } t
+      Pending n -> Pending n
 ---------------------
 --       DSL       --
 ---------------------
 
--- | Combine a group of specs into a described hierarchy that either has the
--- |"only" modifier applied or not.
-_describe :: Only
-         -> String
-         -> Spec Unit
-         -> Spec Unit
-_describe opts name its =
-  State.modify_ (_ <> [Describe opts name (collect its)])
-
 -- | Combine a group of specs into a described hierarchy.
-describe :: String
-         -> Spec Unit
-         -> Spec Unit
-describe = _describe false
+describe
+  :: forall m
+   . String
+  -> Spec' m Unit
+  -> Spec' m Unit
+describe name its = tell [Describe false name (execWriter its)]
 
 -- | Combine a group of specs into a described hierarchy and mark it as the
 -- | only group to actually be evaluated. (useful for quickly narrowing down
 -- | on a set)
-describeOnly :: String
-         -> Spec Unit
-         -> Spec Unit
-describeOnly = _describe true
+describeOnly
+  :: forall m
+   . String
+  -> Spec' m Unit
+  -> Spec' m Unit
+describeOnly name its = tell [Describe true name (execWriter its)]
 
 -- | marks all spec items of the given spec to be safe for parallel evaluation.
-parallel :: Spec Unit
-         -> Spec Unit
-parallel its = State.modify_ (_ <> [Parallel (collect its)])
+parallel
+  :: forall m
+   . Spec' m Unit
+  -> Spec' m Unit
+parallel its = tell [SetExecution Parallel (execWriter its)]
 
 -- | marks all spec items of the given spec to be evaluated sequentially.
-sequential :: Spec Unit
-           -> Spec Unit
-sequential its = State.modify_ (_ <> [Sequential (collect its)])
+sequential
+  :: forall m
+   . Spec' m Unit
+  -> Spec' m Unit
+sequential its = tell [SetExecution Sequential (execWriter its)]
 
 -- | Create a pending spec.
-pending :: String
-        -> Spec Unit
-pending name = State.modify_ (_ <> [Pending name])
+pending
+  :: forall m
+   . String
+  -> Spec' m Unit
+pending name = tell [Pending name]
 
 -- | Create a pending spec with a body that is ignored by
 -- | the runner. It can be useful for documenting what the
 -- | spec should test when non-pending.
-pending' :: String
-        -> Aff Unit
-        -> Spec Unit
+pending'
+  :: forall m
+   . String
+  -> m Unit
+  -> Spec' m Unit
 pending' name _ = pending name
 
--- | Create a spec with a description that either has the "only" modifier
--- | applied or not
-_it :: Boolean
-   -> String
-   -> Aff Unit
-   -> Spec Unit
-_it only description tests = State.modify_ (_ <> [It only description tests])
-
 -- | Create a spec with a description.
-it :: String
-   -> Aff Unit
-   -> Spec Unit
-it = _it false
+it
+  :: forall m
+   . String
+  -> m Unit
+  -> Spec' m Unit
+it description tests = tell [It false description tests]
 
 -- | Create a spec with a description and mark it as the only one to
 -- | be run. (useful for quickly narrowing down on a single test)
-itOnly :: String
-   -> Aff Unit
-   -> Spec Unit
-itOnly = _it true
+itOnly
+  :: forall m
+   . String
+  -> m Unit
+  -> Spec' m Unit
+itOnly description tests = tell [It true description tests]
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index 8b28815..57cb95a 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -14,6 +14,8 @@ import Prelude
 
 import Control.Alternative ((<|>))
 import Control.Monad.Trans.Class (lift)
+import Control.Monad.Writer (execWriter)
+import Control.MonadZero (guard)
 import Control.Parallel (parTraverse, parallel, sequential)
 import Data.Array (singleton)
 import Data.Either (Either(..), either)
@@ -32,7 +34,7 @@ import Effect.Exception as Error
 import Pipes ((>->), yield)
 import Pipes.Core (Pipe, Producer, (//>))
 import Pipes.Core (runEffectRec) as P
-import Test.Spec (Spec, Group(..), Result(..), collect)
+import Test.Spec (Execution(..), Group(..), Result(..), Spec)
 import Test.Spec as Spec
 import Test.Spec.Console (withAttrs)
 import Test.Spec.Runner.Event (Event)
@@ -56,14 +58,15 @@ defaultConfig = {
 , timeout: Just 2000
 , exit: true
 }
-
 trim :: ∀ r. Array (Group r) -> Array (Group r)
+
 trim xs = fromMaybe xs (singleton <$> findJust findOnly xs)
   where
   findOnly :: Group r -> Maybe (Group r)
-  findOnly g@(It true _ _) = pure g
-  findOnly g@(Describe {only} _ gs) = findJust findOnly gs <|> if only then pure g else Nothing
-  findOnly _ = Nothing
+  findOnly g@(It only _ _) = guard only *> pure g
+  findOnly g@(Describe only _ gs) = findJust findOnly gs <|> if only then pure g else Nothing
+  findOnly (SetExecution _ gs) = findJust findOnly gs
+  findOnly (Pending _) = Nothing
 
   findJust :: forall a. (a -> Maybe a) -> Array a -> Maybe a
   findJust f = foldl go Nothing
@@ -100,31 +103,11 @@ _run
   -> Producer Event Aff (Array (Group Result))
 _run config spec = do
   yield (Event.Start (Spec.countTests spec))
-  r <- for (trim $ collect spec) (runGroup false)
+  r <- for (trim $ execWriter spec) (runGroup Sequential)
   yield (Event.End r)
   pure r
   where
-  -- https://github.com/felixSchl/purescript-pipes/issues/16
-  mergeProducers :: forall t o a. Traversable t => t (Producer o Aff a) -> Producer o Aff (t a)
-  mergeProducers ps = do
-    var <- lift AV.empty
-
-    fib <- lift $ forkAff do
-      let consumer i = lift (AV.put i var) *> pure unit
-      x <- parTraverse (\p -> P.runEffectRec $ p //> consumer) ps
-      AV.kill (error "finished") var
-      pure x
-
-    let
-      loop = do
-        res <- lift $ try (AV.take var)
-        case res of
-          Left err -> lift $ joinFiber fib
-          Right e -> do
-            yield e
-            loop
-    loop
-  runGroup :: Boolean -> Group (Aff Unit) -> Producer Event Aff (Group Result)
+  runGroup :: Execution -> Group (Aff Unit) -> Producer Event Aff (Group Result)
   runGroup isPar (It only name test) = do
     yield Event.Test
     start    <- lift $ liftEffect dateNow
@@ -146,20 +129,41 @@ _run config spec = do
     yield $ Event.Pending name
     pure $ Pending name
 
-  runGroup _ (Parallel xs) = do
-    Parallel <$> mergeProducers (runGroup true <$> xs)
-
-  runGroup _ (Sequential xs) = do
-    Sequential <$> for xs (runGroup false)
+  runGroup _ (SetExecution isPar xs) = do
+    SetExecution isPar <$> loop xs isPar
 
   runGroup isPar (Describe only name xs) = do
     yield $ Event.Suite name
-    x <- Describe only name <$> if isPar
-      then mergeProducers (runGroup isPar <$> xs)
-      else for xs (runGroup isPar)
-    yield Event.SuiteEnd
+    Describe only name <$> loop xs isPar
+      <* yield Event.SuiteEnd
+  
+  loop xs = case _ of
+    Parallel -> mergeProducers (runGroup Parallel <$> xs)
+    Sequential -> for xs (runGroup Sequential)
+
+
+-- https://github.com/felixSchl/purescript-pipes/issues/16
+mergeProducers :: forall t o a. Traversable t => t (Producer o Aff a) -> Producer o Aff (t a)
+mergeProducers ps = do
+  var <- lift AV.empty
+
+  fib <- lift $ forkAff do
+    let consumer i = lift (AV.put i var) *> pure unit
+    x <- parTraverse (\p -> P.runEffectRec $ p //> consumer) ps
+    AV.kill (error "finished") var
     pure x
 
+  let
+    loop = do
+      res <- lift $ try (AV.take var)
+      case res of
+        Left err -> lift $ joinFiber fib
+        Right e -> do
+          yield e
+          loop
+  loop
+
+
 -- | Run a spec, returning the results, without any reporting
 runSpec'
   :: Config
diff --git a/src/Test/Spec/Summary.purs b/src/Test/Spec/Summary.purs
index cee578f..79982f7 100644
--- a/src/Test/Spec/Summary.purs
+++ b/src/Test/Spec/Summary.purs
@@ -24,6 +24,7 @@ summarize = foldMap \g -> case g of
     (It _ _ (Failure _)) -> Count 0 1 0
     (Pending _)          -> Count 0 0 1
     (Describe _ _ dgs)   -> summarize dgs
+    (SetExecution _ dgs) -> summarize dgs
 
 successful :: Array (Group Result) -> Boolean
 successful groups =
diff --git a/test/Main.purs b/test/Main.purs
index 9be0c71..aac6c38 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -6,6 +6,7 @@ import Data.Maybe (Maybe(..))
 import Effect (Effect)
 import Effect.Aff (launchAff_)
 import Test.Spec.AssertionSpec (assertionSpec)
+import Test.Spec.HoistSpec (hoistSpecSpec)
 import Test.Spec.Reporter (consoleReporter)
 import Test.Spec.Runner (defaultConfig, run')
 import Test.Spec.RunnerSpec (runnerSpec)
@@ -14,3 +15,4 @@ main :: Effect Unit
 main = launchAff_ $ run' (defaultConfig{timeout = Nothing}) [ consoleReporter ] do
   runnerSpec
   assertionSpec
+  hoistSpecSpec
diff --git a/test/Test/Spec/HoistSpec.purs b/test/Test/Spec/HoistSpec.purs
new file mode 100644
index 0000000..ee10ee3
--- /dev/null
+++ b/test/Test/Spec/HoistSpec.purs
@@ -0,0 +1,76 @@
+module Test.Spec.HoistSpec where
+
+import Prelude
+
+import Control.Monad.Reader (ReaderT, ask, runReaderT)
+import Control.Monad.Writer (WriterT, runWriterT, tell)
+import Data.Semigroup.Foldable (intercalate)
+import Data.Time.Duration (Milliseconds(..))
+import Data.Traversable (for_)
+import Data.Tuple (Tuple(..))
+import Effect.Aff (Aff, delay)
+import Effect.Aff.Class (liftAff)
+import Effect.Class.Console (log)
+import Test.Spec (Spec, Spec', describe, hoistSpec, hoistSpec', it, parallel)
+
+hoistSpecSpec :: Spec Unit
+hoistSpecSpec = describe "hoist" do
+  describe "normal" $ delaySpecExample {log, delay}
+  describe "writer" $ hoistSpecSpecWriterT
+  describe "reader" $ hoistSpecSpecReaderT
+
+hoistSpecSpecWriterT :: Spec Unit
+hoistSpecSpecWriterT = go $ parallel do
+  delaySpecExample
+    { log: \s -> tell [s]
+    , delay: \ms -> liftAff $ delay ms
+    }
+  where
+    go :: Spec' (WriterT (Array String) Aff) ~> Spec
+    go = hoistSpec \m -> do
+     Tuple res logMsgs <- runWriterT m
+     for_ logMsgs log
+     pure res
+
+hoistSpecSpecReaderT :: Spec Unit
+hoistSpecSpecReaderT = go $ parallel do
+  delaySpecExample
+    { log: \s -> ask >>= \logger -> liftAff $ logger s
+    , delay: \ms -> liftAff $ delay ms
+    }
+  where
+    go :: Spec' (ReaderT (String -> Aff Unit) Aff) ~> Spec
+    go = hoistSpec' \{name} m -> runReaderT m \logMsg -> log $ intercalate " > " name <> "| " <>logMsg
+
+delaySpecExample
+  :: forall m
+  . Monad m
+  =>  { log :: String -> m Unit
+      , delay :: Milliseconds -> m Unit
+      }
+  -> Spec' m Unit
+delaySpecExample opts = describe "delay" do
+  it "proc 1" do
+    opts.log "start 1"
+    opts.delay $ Milliseconds $ 500.0 + 300.0 * 1.0
+    opts.log "done 1"
+  it "proc 2" do
+    opts.log "start 2"
+    opts.delay $ Milliseconds $ 500.0 + 300.0 * 2.0
+    opts.log "done 2"
+  it "proc 3" do
+    opts.log "start 3"
+    opts.delay $ Milliseconds $ 500.0 + 300.0 * 3.0
+    opts.log "done 3"
+  it "proc 4" do
+    opts.log "start 4"
+    opts.delay $ Milliseconds $ 500.0 + 300.0 * 4.0
+    opts.log "done 4"
+  it "proc 5" do
+    opts.log "start 5"
+    opts.delay $ Milliseconds $ 500.0 + 300.0 * 5.0
+    opts.log "done 5"
+  it "proc 6" do
+    opts.log "start 6"
+    opts.delay $ Milliseconds $ 500.0 + 300.0 * 6.0
+    opts.log "done 6"
\ No newline at end of file
diff --git a/test/Test/Spec/RunnerSpec.purs b/test/Test/Spec/RunnerSpec.purs
index 4b34426..3853a2b 100644
--- a/test/Test/Spec/RunnerSpec.purs
+++ b/test/Test/Spec/RunnerSpec.purs
@@ -4,8 +4,7 @@ import Prelude
 
 import Data.Time.Duration (Milliseconds(..))
 import Effect.Aff (delay)
-import Effect.Class.Console (log)
-import Test.Spec (Group(..), Result(..), Spec, describe, describePar, it)
+import Test.Spec (Group(..), Result(..), Spec, describe, it)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Spec.Fixtures (itOnlyTest, describeOnlyNestedTest, describeOnlyTest, sharedDescribeTest, successTest)
 import Test.Spec.Runner (runSpec)
@@ -14,42 +13,24 @@ runnerSpec :: Spec Unit
 runnerSpec =
   describe "Test" $
     describe "Spec" $
-      describePar "Runner" do
+      describe "Runner" do
         it "collects \"it\" and \"pending\" in Describe groups" do
-          log "start 1"
-          delay $ Milliseconds $ 1000.0 + 300.0 * 1.0
-          log "done 1"
           results <- runSpec successTest
-          results `shouldEqual` [Describe {only: false, parallel: false} "a" [Describe {only: false, parallel: false} "b" [It false "works" Success]]]
+          results `shouldEqual` [Describe false "a" [Describe false "b" [It false "works" Success]]]
         it "collects \"it\" and \"pending\" with shared Describes" do
-          log "start 2"
-          delay $ Milliseconds $ 1000.0 + 300.0 * 2.0
-          log "done 2"
           results <- runSpec sharedDescribeTest
-          results `shouldEqual` [Describe {only: false, parallel: false} "a" [Describe {only: false, parallel: false} "b" [It false "works" Success],
-                                                     Describe {only: false, parallel: false} "c" [It false "also works" Success]]]
+          results `shouldEqual` [Describe false "a" [Describe false "b" [It false "works" Success],
+                                                     Describe false "c" [It false "also works" Success]]]
         it "filters using \"only\" modifier on \"describe\" block" do
-          log "start 3"
-          delay $ Milliseconds $ 1000.0 + 300.0 * 3.0
-          log "done 3"
           results <- runSpec describeOnlyTest
-          results `shouldEqual` [Describe {only: true, parallel: false} "a" [Describe {only: false, parallel: false} "b" [It false "works" Success],
-                                                    Describe {only: false, parallel: false} "c" [It false "also works" Success]]]
+          results `shouldEqual` [Describe true "a" [Describe false "b" [It false "works" Success],
+                                                    Describe false "c" [It false "also works" Success]]]
         it "filters using \"only\" modifier on nested \"describe\" block" do
-          log "start 4"
-          delay $ Milliseconds $ 1000.0 + 300.0 * 4.0
-          log "done 4"
           results <- runSpec describeOnlyNestedTest
-          results `shouldEqual` [Describe {only: true, parallel: false} "b" [It false "works" Success]]
+          results `shouldEqual` [Describe true "b" [It false "works" Success]]
         it "filters using \"only\" modifier on \"it\" block" do
-          log "start 5"
-          delay $ Milliseconds $ 1000.0 + 300.0 * 5.0
-          log "done 5"
           results <- runSpec itOnlyTest
           results `shouldEqual` [It true "works" Success]
         it "supports async" do
-          log "start 6"
-          delay $ Milliseconds $ 1000.0 + 300.0 * 6.0
-          log "done 6"
           res <- delay (Milliseconds 10.0) *> pure 1
           res `shouldEqual` 1

From ed1e0bf49533ae05dd1d89ac97a014ce85b8e2ec Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 11 Dec 2018 14:30:17 +0400
Subject: [PATCH 03/39] restore handwritten show/eq instances

the reason is that using generic instance results in:

```
/dev/purescript-spec/output/Data.Generic.Rep.Show/index.js:13
var GenericShowArgs = function (genericShowArgs) {
                               ^

RangeError: Maximum call stack size exceeded
    at new GenericShowArgs (/dev/purescript-spec/output/Data.Generic.Rep.Show/index.js:13:32)
    at Object.genericShowArgsArgument (/dev/purescript-spec/output/Data.Generic.Rep.Show/index.js:20:12)
    at showGroup (/dev/purescript-spec/output/Test.Spec/index.js:241:228)
    at showGroup (/dev/purescript-spec/output/Test.Spec/index.js:241:456)
```
---
 src/Test/Spec.purs | 35 +++++++++++++++++++++++------------
 1 file changed, 23 insertions(+), 12 deletions(-)

diff --git a/src/Test/Spec.purs b/src/Test/Spec.purs
index 6336917..e79d203 100644
--- a/src/Test/Spec.purs
+++ b/src/Test/Spec.purs
@@ -28,9 +28,6 @@ import Control.Monad.Writer (Writer, execWriter, mapWriter, tell)
 import Data.Array (snoc)
 import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Array.NonEmpty as NEA
-import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Eq (genericEq)
-import Data.Generic.Rep.Show (genericShow)
 import Data.Traversable (for, for_)
 import Data.Tuple (Tuple(..))
 import Effect.Aff (Aff)
@@ -45,27 +42,41 @@ data Group t
   | It Only Name t
   | Pending Name
 
-derive instance genericGroup :: Generic (Group t) _
-instance showGroup :: Show t => Show (Group t) where show = genericShow
-instance eqGroup :: Eq t => Eq (Group t) where eq = genericEq
-
 data Result
   = Success
   | Failure Error
 
 instance showResult :: Show Result where
   show Success = "Success"
-  show (Failure err) = "(Failure " <> show err <> ")"
+  show (Failure err) = "Failure (Error ...)"
 
 instance eqResult :: Eq Result where
   eq Success Success = true
-  eq (Failure err1) (Failure err2) = show err1 == show err2
+  eq (Failure _) (Failure _) = true
   eq _ _ = false
 
+instance showGroup :: Show t => Show (Group t) where
+  show (SetExecution execution groups) = "SetExecution " <> show execution <> " " <> show groups
+  show (Describe only name groups) = "Describe " <> show only <> " " <> show name <> " " <> show groups
+  show (It only name test) = "It " <> show only <> " " <> show name <> " " <> show test
+  show (Pending name) = "Describe " <> show name
+
+instance eqGroup :: Eq t => Eq (Group t) where
+  eq (SetExecution e1 g1) (SetExecution e2 g2) = e1 == e2 && g1 == g2
+  eq (Describe o1 n1 g1)  (Describe o2 n2 g2)  = o1 == o2 && n1 == n2 && g1 == g2
+  eq (It o1 n1 t1)        (It o2 n2 t2)        = o1 == o2 && n1 == n2 && t1 == t2
+  eq (Pending n1)         (Pending n2)         = n1 == n2
+  eq _                    _                    = false
+
 data Execution = Parallel | Sequential
-derive instance genericExecution :: Generic Execution _
-instance showExecution :: Show Execution where show = genericShow
-instance eqExecution :: Eq Execution where eq = genericEq
+instance showExecution :: Show Execution where
+  show Parallel = "Parallel"
+  show Sequential = "Sequential"
+
+instance eqExecution :: Eq Execution where
+  eq Parallel Parallel = true
+  eq Sequential Sequential = true
+  eq _ _ = false
 
 
 -- Specifications with unevaluated tests.

From 47605c5fd01de3550216c36785791f2ec07b43c7 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 11 Dec 2018 14:34:15 +0400
Subject: [PATCH 04/39] revert whitespace

---
 test/Test/Spec/RunnerSpec.purs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/test/Test/Spec/RunnerSpec.purs b/test/Test/Spec/RunnerSpec.purs
index 3853a2b..f873923 100644
--- a/test/Test/Spec/RunnerSpec.purs
+++ b/test/Test/Spec/RunnerSpec.purs
@@ -1,7 +1,6 @@
 module Test.Spec.RunnerSpec where
 
 import Prelude
-
 import Data.Time.Duration (Milliseconds(..))
 import Effect.Aff (delay)
 import Test.Spec (Group(..), Result(..), Spec, describe, it)

From 37e278b5def88443240857666db9a152618d0f7a Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 8 Jan 2019 10:28:03 +0400
Subject: [PATCH 05/39] add docs for parallel

---
 docs/writing-specs.md | 73 +++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 71 insertions(+), 2 deletions(-)

diff --git a/docs/writing-specs.md b/docs/writing-specs.md
index 0fc1b54..4a9c284 100644
--- a/docs/writing-specs.md
+++ b/docs/writing-specs.md
@@ -121,7 +121,7 @@ baseSpecs = do
 ```
 
 This is often used to combine all specs into a single spec that can be passed
-to the test runner, if not using [purescript-spec-discovery](https://github.com/owickstrom/purescript-spec-discovery).
+to the test runner, if not using [purescript-spec-discovery](https://github.com/purescript-spec/purescript-spec-discovery).
 
 ## Running A Subset of the Specs
 
@@ -150,5 +150,74 @@ describe "Module" do
 ## QuickCheck
 
 You can use [QuickCheck](https://github.com/purescript/purescript-quickcheck)
-together with the [purescript-spec-quickcheck](https://github.com/owickstrom/purescript-spec-quickcheck)
+together with the [purescript-spec-quickcheck](https://github.com/purescript-spec/purescript-spec-quickcheck)
 adapter to get nice output formatting for QuickCheck tests.
+
+
+## Parallel spec execution
+
+You can use `parallel` to mark specs for parallel execution. This is useful
+if you want to speed up your tests by not waiting for some async action
+to resolve. so if you have:
+
+```purescript
+describe "delay" do
+  it "proc 1" do
+    delay $ Milliseconds 500.0
+  it "proc 2" do
+    delay $ Milliseconds 500.0
+  it "proc 3" do
+    delay $ Milliseconds 1000.0
+```
+
+It would take `2000 ms` to finish. But, by sticking in `parallel`, it would take `1000 ms`:
+
+```diff
+- describe "delay" do
++ describe "delay" $ parallel do
+```
+
+**NOTE** that if you are logging things to console, by using `parallel`
+order of log messages will be mixed. For example if you had:
+
+```purescript
+describe "delay" do
+  it "proc 1" do
+    log $ "start 1"
+    delay $ Milliseconds 500.0
+    log $ "end 1"
+  it "proc 2" do
+    log $ "start 2"
+    delay $ Milliseconds 500.0
+    log $ "end 2"
+  it "proc 3" do
+    log $ "start 3"
+    delay $ Milliseconds 1000.0
+    log $ "end 3"
+```
+
+you would see messages in this order:
+
+```
+start 1
+end 1
+start 2
+end 2
+start 3
+end 3
+```
+
+but if you have used `parallel` then messages will come in this order:
+
+```
+start 1
+start 2
+start 3
+end 1
+end 2
+end 3
+```
+
+`purescript-spec` itself is not providing any specific solution for this
+issue but you can take a look at [/test/Test/Spec/HoistSpec.purs](https://github.com/purescript-spec/purescript-spec/blob/master/test/Test/Spec/HoistSpec.purs) 
+for some inspiration.
\ No newline at end of file

From 0681a83505cd6728b85b671c30f055231dd3fcf5 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Thu, 10 Jan 2019 14:28:15 +0400
Subject: [PATCH 06/39] src compiles

---
 bower.json                           |   3 +-
 src/Test/Spec.purs                   | 419 +++++++++++++++++++--------
 src/Test/Spec/Assertions.purs        | 102 ++++++-
 src/Test/Spec/Assertions/Aff.purs    |  29 --
 src/Test/Spec/Assertions/String.purs |  22 +-
 src/Test/Spec/Reporter/Base.purs     |  23 +-
 src/Test/Spec/Reporter/Console.purs  |   2 +-
 src/Test/Spec/Reporter/Tap.purs      |   2 +-
 src/Test/Spec/Runner.purs            | 228 +++++++++------
 src/Test/Spec/Runner/Event.purs      |   9 +-
 src/Test/Spec/Summary.purs           |  32 +-
 test/Test/Spec/AssertionSpec.purs    |  33 +--
 12 files changed, 601 insertions(+), 303 deletions(-)
 delete mode 100644 src/Test/Spec/Assertions/Aff.purs

diff --git a/bower.json b/bower.json
index db72750..01cb433 100644
--- a/bower.json
+++ b/bower.json
@@ -25,6 +25,7 @@
     "purescript-foldable-traversable": "^4.0.0",
     "purescript-pipes": "^6.0.0",
     "purescript-ansi": "^5.0.0",
-    "purescript-generics-rep": "^6.0.0"
+    "purescript-generics-rep": "^6.0.0",
+    "purescript-fork": "^4.0.0"
   }
 }
diff --git a/src/Test/Spec.purs b/src/Test/Spec.purs
index e79d203..f0e79d3 100644
--- a/src/Test/Spec.purs
+++ b/src/Test/Spec.purs
@@ -1,46 +1,159 @@
-module Test.Spec (
-  Name(..),
-  Only(..),
-  Result(..),
-  Execution(..),
-  Group(..),
-  Spec(..),
-  Spec'(..),
-  TestEnv,
-  hoistSpec,
-  hoistSpec',
-  describe,
-  describeOnly,
-  parallel,
-  sequential,
-  pending,
-  pending',
-  it,
-  itOnly,
-  countTests
+module Test.Spec
+  ( Spec
+  , SpecM
+  , Tree(..)
+  , Item(..)
+  , SpecTree
+  , ActionWith
+  , class Example
+  , evaluateExample
+  , describe
+  , describeOnly
+  , parallel
+  , sequential
+
+  , pending
+  , pending'
+  , it
+  , itOnly
+  , countTests
+  , Result(..)
   ) where
 
 import Prelude
 
+import Control.Alt ((<|>))
+import Control.Monad.Error.Class (class MonadError)
+import Control.Monad.Fork.Class (class MonadBracket, bracket)
 import Control.Monad.State (execState)
 import Control.Monad.State as State
-import Control.Monad.Writer (Writer, execWriter, mapWriter, tell)
-import Data.Array (snoc)
-import Data.Array.NonEmpty (NonEmptyArray)
-import Data.Array.NonEmpty as NEA
+import Control.Monad.Writer (WriterT(..), mapWriterT, runWriterT, tell)
+import Data.Array (any)
+import Data.Either (Either(..), either)
+import Data.Foldable (class Foldable, foldMapDefaultL, foldl, foldr)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Eq (genericEq)
+import Data.Generic.Rep.Show (genericShow)
+import Data.Identity (Identity)
+import Data.Maybe (Maybe(..), maybe)
+import Data.Newtype (class Newtype, over, un)
 import Data.Traversable (for, for_)
 import Data.Tuple (Tuple(..))
-import Effect.Aff (Aff)
+import Effect.AVar (AVar)
+import Effect.AVar as AVarEff
+import Effect.Aff (Aff, error, throwError, try)
+import Effect.Aff.AVar as AVar
+import Effect.Aff.Class (class MonadAff, liftAff)
+import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Exception (Error)
 
-type Name = String
-type Only = Boolean
+-- TODO remove this
+anExample :: Spec Unit
+anExample = do
+  describe "foo" do
+    it "asd" do
+      pure unit
+    it "asd" do
+      pure unit
+    before (pure 1) $ after (\a -> let x = a + 1 in pure unit) do
+      it "asd" \num -> do
+        x <- pure $ num + 1
+        pure unit
+      it "asdasdasd" \num -> do
+        x <- pure $ num + 1
+        pure unit
+      beforeWith (const $ pure "asd") do
+        it "asd" \str -> do
+          z <- pure $ str <> "as"
+          pure unit
+        aroundWith (\e str -> let z = str <> "" in pure 1 >>= e <* pure unit) do
+          it "asd" \num -> do
+            z <- pure $ num + 1
+            pure unit
+      beforeWith (\num -> pure $ "asd" <> show (num + 1)) do
+        it "asd" \str -> do
+          z <- pure $ str <> "as"
+          pure unit
+    pure unit
+
+data Tree c a
+  = Node (Either String c) (Array (Tree c a))
+  | Leaf String (Maybe a)
+
+derive instance treeGeneric :: Generic (Tree c a) _
+instance treeEq :: (Eq c, Eq a) => Eq (Tree c a) where eq = genericEq
+instance treeShow :: (Show c, Show a) => Show (Tree c a) where show = genericShow
+
+
+-- instance showGroup :: Show t => Show (Group t) where
+--   show (SetExecution execution groups) = "SetExecution " <> show execution <> " " <> show groups
+--   show (Describe only name groups) = "Describe " <> show only <> " " <> show name <> " " <> show groups
+--   show (It only name test) = "It " <> show only <> " " <> show name <> " " <> show test
+--   show (Pending name) = "Describe " <> show name
+
+-- instance eqGroup :: Eq t => Eq (Group t) where
+--   eq (SetExecution e1 g1) (SetExecution e2 g2) = e1 == e2 && g1 == g2
+--   eq (Describe o1 n1 g1)  (Describe o2 n2 g2)  = o1 == o2 && n1 == n2 && g1 == g2
+--   eq (It o1 n1 t1)        (It o2 n2 t2)        = o1 == o2 && n1 == n2 && t1 == t2
+--   eq (Pending n1)         (Pending n2)         = n1 == n2
+--   eq _                    _                    = false
+
+
+instance treeFoldable :: Foldable (Tree c) where
+  foldr f i (Leaf _ a) = maybe i (\a' -> f a' i) a
+  foldr f i (Node _ as) = foldr (\a i' -> foldr f i' a) i as
+  foldl f i (Leaf _ a) = maybe i (\a' -> f i a') a
+  foldl f i (Node _ as) = foldl (\i' a -> foldl f i' a) i as
+  foldMap f = foldMapDefaultL f
+
+type ActionWith m a = a -> m Unit
+type SpecTree m a = Tree (ActionWith m a) (Item m a)
+newtype Item m a = Item
+  { isFocused :: Boolean
+  , isParallelizable :: Maybe Boolean
+  , example :: (ActionWith m a -> m Unit) -> m Unit
+  }
+
+derive instance itemNewtype :: Newtype (Item m a) _
+
+class Example t arg m | t -> arg, t -> m where
+  evaluateExample :: t -> (ActionWith m arg -> m Unit) -> m Unit
 
-data Group t
-  = Describe Only Name (Array (Group t))
-  | SetExecution Execution (Array (Group t))
-  | It Only Name t
-  | Pending Name
+instance exampleFunc :: Example (arg -> m Unit) arg m where
+  evaluateExample :: (arg -> m Unit) -> (ActionWith m arg -> m Unit) -> m Unit
+  evaluateExample t around' = around' t
+
+else instance exampleMUnit :: Example (m Unit) Unit m where
+  evaluateExample :: (m Unit) -> (ActionWith m Unit -> m Unit) -> m Unit
+  evaluateExample t around' = around' $ \_ -> t
+
+
+type Spec a = SpecM Identity Aff Unit a
+type SpecM m g i a = WriterT (Array (SpecTree g i)) m a
+
+bimapTree :: forall a b c d. (a -> b) -> (c -> d) -> Tree a c -> Tree b d
+bimapTree g f = go
+  where
+    go spec = case spec of
+      Node d xs -> Node (map g d) (map go xs)
+      Leaf n item -> Leaf n (map f item)
+
+mapSpecTree
+  :: forall m g g' i a i'
+   . Monad m
+   => (SpecTree g i -> SpecTree g' i') 
+   -> SpecM m g i a
+   -> SpecM m g' i' a
+mapSpecTree f (specs) = mapWriterT (map ((<$>) (map f))) specs
+
+mapSpecItem
+  :: forall m g g' a b r
+   . Monad m
+  => (ActionWith g a -> ActionWith g' b)
+  -> (Item g a -> Item g' b)
+  -> SpecM m g a r
+  -> SpecM m g' b r
+mapSpecItem g f = mapSpecTree (bimapTree g f)
 
 data Result
   = Success
@@ -55,124 +168,198 @@ instance eqResult :: Eq Result where
   eq (Failure _) (Failure _) = true
   eq _ _ = false
 
-instance showGroup :: Show t => Show (Group t) where
-  show (SetExecution execution groups) = "SetExecution " <> show execution <> " " <> show groups
-  show (Describe only name groups) = "Describe " <> show only <> " " <> show name <> " " <> show groups
-  show (It only name test) = "It " <> show only <> " " <> show name <> " " <> show test
-  show (Pending name) = "Describe " <> show name
-
-instance eqGroup :: Eq t => Eq (Group t) where
-  eq (SetExecution e1 g1) (SetExecution e2 g2) = e1 == e2 && g1 == g2
-  eq (Describe o1 n1 g1)  (Describe o2 n2 g2)  = o1 == o2 && n1 == n2 && g1 == g2
-  eq (It o1 n1 t1)        (It o2 n2 t2)        = o1 == o2 && n1 == n2 && t1 == t2
-  eq (Pending n1)         (Pending n2)         = n1 == n2
-  eq _                    _                    = false
-
-data Execution = Parallel | Sequential
-instance showExecution :: Show Execution where
-  show Parallel = "Parallel"
-  show Sequential = "Sequential"
-
-instance eqExecution :: Eq Execution where
-  eq Parallel Parallel = true
-  eq Sequential Sequential = true
-  eq _ _ = false
-
-
--- Specifications with unevaluated tests.
-type Spec t = Spec' Aff t
-type Spec' m t = Writer (Array (Group (m Unit))) t
 
 -- | Count the total number of tests in a spec
-countTests :: forall m. Spec' m Unit -> Int
-countTests spec = execState (for (execWriter spec) go) 0
+countTests :: forall g i. Array (SpecTree g i) -> Int
+countTests g = execState (for g go) 0
   where
-  go (SetExecution _ xs) = for_ xs go
-  go (Describe _ _ xs) = for_ xs go
-  go (It _ _ _) = State.modify_ (_ + 1)
-  go (Pending _) = State.modify_ (_ + 1)
+  go (Node _ xs) = for_ xs go
+  go (Leaf _ _) = State.modify_ (_ + 1)
 
 
-type TestEnv = { name :: NonEmptyArray Name, execution :: Execution }
+-- ---------------------
+-- --       DSL       --
+-- ---------------------
 
-hoistSpec :: forall m g. (m ~> g) -> Spec' m ~> Spec' g
-hoistSpec f = hoistSpec' \_ -> f
 
-hoistSpec' :: forall m g. (TestEnv -> m ~> g) -> Spec' m ~> Spec' g
-hoistSpec' f = mapWriter \(Tuple a s) -> Tuple a $ map (go Sequential []) s
-  where
-    go :: Execution -> Array Name -> Group (m Unit) -> Group (g Unit)
-    go execution ns = case _ of
-      Describe o n rest -> Describe o n $ go execution (ns `snoc` n) <$> rest
-      SetExecution execution' rest -> SetExecution execution' $ go execution' ns <$> rest
-      It o n t -> It o n $ f { execution, name: ns `NEA.snoc'` n } t
-      Pending n -> Pending n
----------------------
---       DSL       --
----------------------
+-- | `focus` focuses all spec items of the given spec.
+-- |
+-- | Applying `focus` to a spec with focused spec items has no effect.
+focus :: forall m g i a. Monad m => SpecM m g i a -> SpecM m g i a
+focus test = WriterT do
+  Tuple res xs <- runWriterT test
+  pure $ Tuple res $ if any (any $ un Item >>> _.isFocused) xs
+    then xs
+    else map (bimapTree identity (\(Item r) -> Item r {isFocused = true})) xs
+
 
 -- | Combine a group of specs into a described hierarchy.
 describe
-  :: forall m
-   . String
-  -> Spec' m Unit
-  -> Spec' m Unit
-describe name its = tell [Describe false name (execWriter its)]
+  :: forall m g i a
+   . Monad m
+  => String
+  -> SpecM m g i a
+  -> SpecM m g i a
+describe name test = WriterT do
+  Tuple res group <- runWriterT test
+  pure $ Tuple res [Node (Left name) group]
+
 
 -- | Combine a group of specs into a described hierarchy and mark it as the
 -- | only group to actually be evaluated. (useful for quickly narrowing down
 -- | on a set)
 describeOnly
-  :: forall m
-   . String
-  -> Spec' m Unit
-  -> Spec' m Unit
-describeOnly name its = tell [Describe true name (execWriter its)]
+  :: forall m g i a
+   . Monad m
+  => String
+  -> SpecM m g i a
+  -> SpecM m g i a
+describeOnly = map focus <<< describe
 
 -- | marks all spec items of the given spec to be safe for parallel evaluation.
 parallel
-  :: forall m
-   . Spec' m Unit
-  -> Spec' m Unit
-parallel its = tell [SetExecution Parallel (execWriter its)]
+  :: forall m g i a
+   . Monad m
+  => SpecM m g i a
+  -> SpecM m g i a
+parallel = mapSpecItem identity (setParallelizable true)
 
 -- | marks all spec items of the given spec to be evaluated sequentially.
 sequential
-  :: forall m
-   . Spec' m Unit
-  -> Spec' m Unit
-sequential its = tell [SetExecution Sequential (execWriter its)]
+  :: forall m g i a
+   . Monad m
+  => SpecM m g i a
+  -> SpecM m g i a
+sequential = mapSpecItem identity (setParallelizable false)
+
+setParallelizable :: forall g a. Boolean -> Item g a -> Item g a
+setParallelizable value = over Item \i -> i{isParallelizable = i.isParallelizable <|> Just value}
 
 -- | Create a pending spec.
 pending
-  :: forall m
-   . String
-  -> Spec' m Unit
-pending name = tell [Pending name]
+  :: forall m g i
+   . Monad m
+  => String
+  -> SpecM m g i Unit
+pending name = tell [Leaf name Nothing]
 
 -- | Create a pending spec with a body that is ignored by
 -- | the runner. It can be useful for documenting what the
 -- | spec should test when non-pending.
 pending'
-  :: forall m
-   . String
-  -> m Unit
-  -> Spec' m Unit
+  :: forall m g i
+   . Monad m
+  => String
+  -> g Unit
+  -> SpecM m g i Unit
 pending' name _ = pending name
 
 -- | Create a spec with a description.
 it
-  :: forall m
-   . String
-  -> m Unit
-  -> Spec' m Unit
-it description tests = tell [It false description tests]
+  :: forall m t arg g
+   . Monad m
+  => Example t arg g
+  => String
+  -> t
+  -> SpecM m g arg Unit
+it name test = tell
+  [ Leaf name $ Just $ Item
+      { isParallelizable: Nothing
+      , isFocused: false
+      , example: evaluateExample test
+      }
+  ]
 
 -- | Create a spec with a description and mark it as the only one to
 -- | be run. (useful for quickly narrowing down on a single test)
 itOnly
-  :: forall m
-   . String
-  -> m Unit
-  -> Spec' m Unit
-itOnly description tests = tell [It true description tests]
+  :: forall m t arg g
+   . Monad m
+  => Example t arg g
+  => String
+  -> t
+  -> SpecM m g arg Unit
+itOnly = map focus <<< it
+
+-- | Run a custom action before and/or after every spec item.
+aroundWith
+  :: forall m g i i' a
+   . Monad m
+  => (ActionWith g i -> ActionWith g i')
+  -> SpecM m g i a
+  -> SpecM m g i' a
+aroundWith action = mapSpecItem action (modifyAroundAction action)
+
+
+modifyAroundAction :: forall g a b. (ActionWith g a -> ActionWith g b) -> Item g a -> Item g b
+modifyAroundAction action (Item item) = Item $ item
+  { example = \aroundAction -> item.example (aroundAction <<< action)
+  }
+
+-- | Run a custom action before and/or after every spec item.
+around_ :: forall m g i a. Monad m => (g Unit -> g Unit) -> SpecM m g i a -> SpecM m g i a
+around_ action = aroundWith $ \e a -> action (e a)
+
+-- | Run a custom action after every spec item.
+after :: forall m g e f i a. Monad m => MonadBracket e f g => ActionWith g i -> SpecM m g i a -> SpecM m g i a
+after action = aroundWith $ \e x -> e x `finally` action x
+  where 
+  finally :: forall x. g x -> g Unit -> g x
+  finally act fin = bracket (pure unit) (\_ _ -> fin) (const act)
+
+-- | Run a custom action after every spec item.
+after_ :: forall m g e f i a. Monad m => MonadBracket e f g => g Unit -> SpecM m g i a -> SpecM m g i a
+after_ action = after $ \_ -> action
+
+-- | Run a custom action before and/or after every spec item.
+around :: forall m g i a. Monad m => (ActionWith g i -> g Unit) -> SpecM m g i a -> SpecM m g Unit a
+around action = aroundWith $ \e _ -> action e
+
+-- | Run a custom action before every spec item.
+before :: forall m g i a. Monad m => Monad g => g i -> SpecM m g i a -> SpecM m g Unit a
+before action = around (action >>= _)
+
+-- | Run a custom action before every spec item.
+before_ :: forall m g i a. Monad m => Monad g => g Unit -> SpecM m g i a -> SpecM m g i a
+before_ action = around_ (action *> _)
+
+-- | Run a custom action before every spec item.
+beforeWith :: forall m g i i' a. Monad m => Monad g => (i' -> g i) -> SpecM m g i a -> SpecM m g i' a
+beforeWith action = aroundWith $ \e x -> action x >>= e
+
+-- | Run a custom action before the first spec item.
+beforeAll :: forall m g i a. MonadEffect m => MonadAff g => MonadError Error g => g i -> SpecM m g i a -> SpecM m g Unit a
+beforeAll action spec = do
+  var <- liftEffect $ AVarEff.new MEmpty
+  before (memoize var action) spec
+
+-- | Run a custom action before the first spec item.
+beforeAll_ :: forall m g i a. MonadEffect m => MonadAff g => MonadError Error g => g Unit -> SpecM m g i a -> SpecM m g i a
+beforeAll_ action spec = do
+  var <- liftEffect $ AVarEff.new MEmpty
+  before_ (memoize var action) spec
+
+data Memoized a
+  = MEmpty
+  | MMemoized a
+  | MFailed Error
+
+memoize :: forall a m. MonadAff m => MonadError Error m => AVar (Memoized a) -> m a -> m a
+memoize var action = do
+  liftAff (AVar.take var) >>= case _ of
+    MFailed x -> throwError $ error "exception in beforeAll-hook (see previous failure)"
+    MMemoized x -> pure x <* (liftAff $ AVar.put (MMemoized x) var)
+    MEmpty -> do
+      res <- try action
+      liftAff $ AVar.put (either MFailed MMemoized res) var
+      either throwError pure res
+
+-- | Run a custom action after the last spec item.
+afterAll :: forall m g i a. Monad m => ActionWith g i -> SpecM m g i a -> SpecM m g i a
+afterAll action spec = WriterT do
+  Tuple res group <- runWriterT spec
+  pure $ Tuple res [Node (Right action) group]
+
+-- | Run a custom action after the last spec item.
+afterAll_ :: forall m g i a. Monad m => g Unit -> SpecM m g i a -> SpecM m g i a
+afterAll_ action = afterAll $ const action
\ No newline at end of file
diff --git a/src/Test/Spec/Assertions.purs b/src/Test/Spec/Assertions.purs
index fbc20df..84c7d25 100644
--- a/src/Test/Spec/Assertions.purs
+++ b/src/Test/Spec/Assertions.purs
@@ -6,44 +6,124 @@ module Test.Spec.Assertions
   , shouldNotContain
   , shouldNotSatisfy
   , shouldSatisfy
+  , expectError
+  , shouldReturn
+  , shouldNotReturn
   ) where
 
 import Prelude
 
-import Effect.Aff                  (Aff())
-import Effect.Exception            (error)
-import Control.Monad.Error.Class   (throwError)
-import Data.Foldable               (class Foldable, notElem, elem)
+import Control.Monad.Error.Class (class MonadError, class MonadThrow, throwError, try)
+import Data.Either (Either(..))
+import Data.Foldable (class Foldable, notElem, elem)
+import Effect.Exception (Error, error)
 
-fail :: String -> Aff Unit
+fail :: forall m. MonadThrow Error m => String -> m Unit
 fail = throwError <<< error
 
-shouldEqual :: forall t. Show t => Eq t => t -> t -> Aff Unit
+shouldEqual
+  :: forall m t
+   . MonadThrow Error m
+  => Show t
+  => Eq t
+  => t
+  -> t
+  -> m Unit
 shouldEqual v1 v2 =
   when (v1 /= v2) $
     fail $ show v1 <> " ≠ " <> show v2
 
-shouldNotEqual :: forall t. Show t => Eq t => t -> t -> Aff Unit
+shouldNotEqual
+  :: forall m t
+   . MonadThrow Error m
+  => Show t
+  => Eq t
+  => t
+  -> t
+  -> m Unit
 shouldNotEqual v1 v2 =
   when (v1 == v2) $
     fail $ show v1 <> " = " <> show v2
 
-shouldSatisfy :: forall t. Show t => t -> (t -> Boolean) -> Aff Unit
+shouldSatisfy
+  :: forall m t
+   . MonadThrow Error m
+  => Show t
+  => t
+  -> (t -> Boolean)
+  -> m Unit
 shouldSatisfy v pred =
   unless (pred v) $
     fail $ show v <> " doesn't satisfy predicate"
 
-shouldNotSatisfy :: forall t. Show t => t -> (t -> Boolean) -> Aff Unit
+shouldNotSatisfy
+  :: forall m t
+   . MonadThrow Error m
+  => Show t
+  => t
+  -> (t -> Boolean)
+  -> m Unit
 shouldNotSatisfy v pred =
   when (pred v) $
     fail $ show v <> " satisfies predicate, but should not"
 
-shouldContain :: forall f a. Show a => Eq a => Show (f a) => Foldable f => f a -> a -> Aff Unit
+shouldContain
+  :: forall m f a
+   . MonadThrow Error m
+  => Show a
+  => Eq a
+  => Show (f a)
+  => Foldable f
+  => f a
+  -> a
+  -> m Unit
 shouldContain c e =
   when (e `notElem` c) $
     fail $ (show e) <> " ∉ " <> (show c)
 
-shouldNotContain :: forall f a. Show a => Eq a => Show (f a) => Foldable f => f a -> a -> Aff Unit
+shouldNotContain
+  :: forall m f a
+   . MonadThrow Error m
+  => Show a
+  => Eq a
+  => Show (f a)
+  => Foldable f
+  => f a
+  -> a
+  -> m Unit
 shouldNotContain c e =
   when (e `elem` c) $
     fail $ (show e) <> " ∈ " <> (show c)
+
+expectError
+  :: forall m t
+   . MonadError Error m
+  => m t
+  -> m Unit
+expectError a = do
+  e <- try a
+  case e of
+    Left _ -> pure unit
+    Right _ -> throwError $ error "Expected error"
+
+-- | Asserts that `m t` returns `t`
+shouldReturn
+  :: forall m t
+   . MonadThrow Error m
+  => Eq t
+  => Show t
+  => m t
+  -> t
+  -> m Unit
+shouldReturn ft t = ft >>= (_ `shouldEqual` t)
+
+-- | Asserts that `m t` does not return `t`
+shouldNotReturn
+  :: forall m t
+   . MonadThrow Error m
+  => Eq t
+  => Show t
+  => m t
+  -> t
+  -> m Unit
+shouldNotReturn ft t = ft >>= (_ `shouldNotEqual` t)
diff --git a/src/Test/Spec/Assertions/Aff.purs b/src/Test/Spec/Assertions/Aff.purs
deleted file mode 100644
index 9b7283f..0000000
--- a/src/Test/Spec/Assertions/Aff.purs
+++ /dev/null
@@ -1,29 +0,0 @@
-module Test.Spec.Assertions.Aff
-  ( expectError
-  , shouldReturn
-  , shouldNotReturn
-  ) where
-
-import Prelude
-
-import Data.Either                 (Either(..))
-import Effect.Aff                  (Aff, attempt)
-import Effect.Exception            (error)
-import Control.Monad.Error.Class   (throwError)
-import Test.Spec.Assertions        (shouldEqual, shouldNotEqual)
-
--- | Assert `Aff t` throws an error
-expectError :: forall t. Aff t -> Aff Unit
-expectError a = do
-  e <- attempt a
-  case e of
-    Left _ -> pure unit
-    Right _ -> throwError $ error "Expected error"
-
--- | Asserts that `Aff t` returns `t`
-shouldReturn :: forall t. Eq t => Show t => Aff t -> t -> Aff Unit
-shouldReturn ft t = ft >>= (_ `shouldEqual` t)
-
--- | Asserts that `Aff t` does not return `t`
-shouldNotReturn :: forall t. Eq t => Show t => Aff t -> t -> Aff Unit
-shouldNotReturn ft t = ft >>= (_ `shouldNotEqual` t)
diff --git a/src/Test/Spec/Assertions/String.purs b/src/Test/Spec/Assertions/String.purs
index fd46450..ee5f090 100644
--- a/src/Test/Spec/Assertions/String.purs
+++ b/src/Test/Spec/Assertions/String.purs
@@ -7,10 +7,10 @@ module Test.Spec.Assertions.String
 
 import Prelude
 
-import Control.Monad.Error.Class (throwError)
+import Control.Monad.Error.Class (class MonadThrow)
 import Data.String (Pattern(..), contains)
-import Effect.Aff (Aff)
-import Effect.Exception (error)
+import Effect.Exception (Error)
+import Test.Spec.Assertions (fail)
 
 foreign import _startsWith :: String -> String -> Boolean
 foreign import _endsWith :: String -> String -> Boolean
@@ -20,37 +20,37 @@ foreign import _endsWith :: String -> String -> Boolean
 -- | ```purescript
 -- | string `shouldStartWith` prefix
 -- | ```
-shouldStartWith :: String -> String -> Aff Unit
+shouldStartWith :: forall m. MonadThrow Error m => String -> String -> m Unit
 shouldStartWith s prefix =
   when (not $ _startsWith prefix s) $
-     throwError $ error $ show s <> " does not start with " <> show prefix
+     fail $ show s <> " does not start with " <> show prefix
 
 -- | Asserts `string` ends with `suffix`
 -- |
 -- | ```purescript
 -- | string `shouldEndWith` suffix
 -- | ```
-shouldEndWith :: String -> String -> Aff Unit
+shouldEndWith :: forall m. MonadThrow Error m => String -> String -> m Unit
 shouldEndWith s suffix =
   when (not $ _endsWith suffix s) $
-     throwError $ error $ show s <> " does not end with " <> show suffix
+     fail $ show s <> " does not end with " <> show suffix
 
 -- | Asserts `string` contains `subs`
 -- |
 -- | ```purescript
 -- | string `shouldContain` subs
 -- | ```
-shouldContain :: String -> String -> Aff Unit
+shouldContain :: forall m. MonadThrow Error m => String -> String -> m Unit
 shouldContain s subs =
   when (not $ contains (Pattern subs) s) $
-    throwError $ error $ show subs <> " ∉ " <> show s
+    fail $ show subs <> " ∉ " <> show s
 
 -- | Asserts `string` does not contain `subs`
 -- |
 -- | ```purescript
 -- | string `shouldContain` subs
 -- | ```
-shouldNotContain :: String -> String -> Aff Unit
+shouldNotContain :: forall m. MonadThrow Error m => String -> String -> m Unit
 shouldNotContain s subs =
   when (contains (Pattern subs) s) $
-    throwError $ error $ show subs <> " ∈ " <> show s
+    fail $ show subs <> " ∈ " <> show s
diff --git a/src/Test/Spec/Reporter/Base.purs b/src/Test/Spec/Reporter/Base.purs
index e72a819..b091959 100644
--- a/src/Test/Spec/Reporter/Base.purs
+++ b/src/Test/Spec/Reporter/Base.purs
@@ -11,7 +11,9 @@ import Control.Monad.State as State
 import Control.Monad.Trans.Class (lift)
 import Data.Array ((:), reverse)
 import Data.Array as Array
+import Data.Either (Either(..))
 import Data.Foldable (intercalate)
+import Data.Maybe (Maybe(..))
 import Data.String.CodeUnits as CodeUnits
 import Data.Traversable (for_)
 import Effect (Effect)
@@ -20,7 +22,7 @@ import Effect.Console (log)
 import Effect.Exception as Error
 import Pipes (await, yield)
 import Pipes.Core (Pipe)
-import Test.Spec (Group, Result(..))
+import Test.Spec (Result, Tree)
 import Test.Spec as S
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
@@ -36,10 +38,10 @@ indent i = CodeUnits.fromCharArray $ Array.replicate i ' '
 defaultUpdate :: forall s. s -> Event -> Effect s
 defaultUpdate s _ = pure s
 
-defaultSummary :: Array (Group Result) -> Effect Unit
+defaultSummary :: Array (Tree Void Result) -> Effect Unit
 defaultSummary xs = do
   case Summary.summarize xs of
-    (Count passed failed pending) -> do
+    (Count {passed, failed, pending}) -> do
       when (passed  > 0) $ log $ colored Color.Green   $ show passed  <> " passing"
       when (pending > 0) $ log $ colored Color.Pending $ show pending <> " pending"
       when (failed  > 0) $ log $ colored Color.Fail    $ show failed  <> " failed"
@@ -48,25 +50,26 @@ defaultSummary xs = do
 
 
 printFailures
-  :: Array (Group Result)
+  :: Array (Tree Void Result)
   -> Effect Unit
 printFailures xs = void $ evalStateT (go [] xs) 0
   where
     go
       :: Array String
-      -> Array (Group Result)
+      -> Array (Tree Void Result)
       -> StateT Int Effect Unit
     go crumbs groups =
       for_ groups case _ of
-        S.Describe _ n xs' -> go (n:crumbs) xs'
-        S.It _ n (Failure err) ->
+        S.Node (Left n) xs' -> go (n:crumbs) xs'
+        S.Node (Right _) xs' -> go crumbs xs'
+        S.Leaf n (Just (S.Failure err)) ->
           let label = intercalate " " (reverse $ n:crumbs)
             in do
                 _ <- State.modify (_ + 1)
                 i <- State.get
                 lift $ log $ show i <> ") " <> label
                 lift $ log $ colored Color.ErrorMessage $ indent 2 <> Error.message err
-        _ -> pure unit
+        S.Leaf _ _ -> pure unit
 
 -- | Monadic left scan with state.
 -- | TODO: Is this already included in purescript-pipes somehow, or should be?
@@ -87,8 +90,8 @@ scanWithStateM step begin = do
 -- | A default reporter implementation that can be used as a base to build
 -- | other reporters on top of.
 defaultReporter
-  :: ∀ s.
-     s
+  :: forall s
+   . s
   -> (s -> Event -> Effect s)
   -> Reporter
 defaultReporter initialState onEvent = do
diff --git a/src/Test/Spec/Reporter/Console.purs b/src/Test/Spec/Reporter/Console.purs
index 2552dc1..90ee266 100644
--- a/src/Test/Spec/Reporter/Console.purs
+++ b/src/Test/Spec/Reporter/Console.purs
@@ -65,7 +65,7 @@ consoleReporter = defaultReporter initialState update
             withAttrs [1, 35] $ log $ intercalate " » " s.crumbs
             action
 
-      printSummary = Summary.summarize >>> \(Count passed failed pending) -> do
+      printSummary = Summary.summarize >>> \(Count {passed, failed, pending}) -> do
         log ""
         withAttrs [1] $ log "Summary"
         printPassedFailed passed failed
diff --git a/src/Test/Spec/Reporter/Tap.purs b/src/Test/Spec/Reporter/Tap.purs
index 864623d..d195e8b 100644
--- a/src/Test/Spec/Reporter/Tap.purs
+++ b/src/Test/Spec/Reporter/Tap.purs
@@ -35,7 +35,7 @@ tapReporter =
         Just s  -> log $ joinWith "\n" (append "    " <$> split (Pattern "\n") s)
     Event.End results -> do
       case Summary.summarize results of
-        (Count passed failed pending) -> do
+        (Count {passed, failed, pending}) -> do
           log $ "# tests " <> show (failed + passed + pending)
           log $ "# pass "  <> show (passed + pending)
           log $ "# fail "  <> show failed
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index 57cb95a..cc42760 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -14,16 +14,20 @@ import Prelude
 
 import Control.Alternative ((<|>))
 import Control.Monad.Trans.Class (lift)
-import Control.Monad.Writer (execWriter)
-import Control.MonadZero (guard)
+import Control.Monad.Writer (execWriterT)
 import Control.Parallel (parTraverse, parallel, sequential)
-import Data.Array (singleton)
+import Data.Array (all, groupBy, mapMaybe)
+import Data.Array.NonEmpty (NonEmptyArray)
+import Data.Array.NonEmpty as NEA
 import Data.Either (Either(..), either)
 import Data.Foldable (foldl)
+import Data.Identity (Identity(..))
 import Data.Int (toNumber)
-import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Maybe (Maybe(..))
+import Data.Newtype (un)
 import Data.Time.Duration (Milliseconds(..))
 import Data.Traversable (class Traversable, for)
+import Data.Tuple (Tuple(..), fst, snd)
 import Effect (Effect)
 import Effect.Aff (Aff, attempt, delay, forkAff, joinFiber, makeAff, throwError, try)
 import Effect.Aff.AVar as AV
@@ -34,7 +38,7 @@ import Effect.Exception as Error
 import Pipes ((>->), yield)
 import Pipes.Core (Pipe, Producer, (//>))
 import Pipes.Core (runEffectRec) as P
-import Test.Spec (Execution(..), Group(..), Result(..), Spec)
+import Test.Spec (Item(..), Result(..), Spec, SpecM, SpecTree, Tree(..))
 import Test.Spec as Spec
 import Test.Spec.Console (withAttrs)
 import Test.Spec.Runner.Event (Event)
@@ -46,33 +50,30 @@ foreign import exit :: Int -> Effect Unit
 
 foreign import dateNow :: Effect Int
 
-type Config = {
-  slow :: Int
-, timeout :: Maybe Int
-, exit :: Boolean
-}
+type Config =
+  { slow :: Int
+  , timeout :: Maybe Int
+  , exit :: Boolean
+  }
 
 defaultConfig :: Config
-defaultConfig = {
-  slow: 75
-, timeout: Just 2000
-, exit: true
-}
-trim :: ∀ r. Array (Group r) -> Array (Group r)
-
-trim xs = fromMaybe xs (singleton <$> findJust findOnly xs)
+defaultConfig =
+  { slow: 75
+  , timeout: Just 2000
+  , exit: true
+  }
+
+filterFocusedIfAny :: forall c m a. Array (Tree c (Item m a)) -> Array (Tree c (Item m a))
+filterFocusedIfAny ts = case mapMaybe findFocus ts of
+  [] -> ts
+  r -> r
   where
-  findOnly :: Group r -> Maybe (Group r)
-  findOnly g@(It only _ _) = guard only *> pure g
-  findOnly g@(Describe only _ gs) = findJust findOnly gs <|> if only then pure g else Nothing
-  findOnly (SetExecution _ gs) = findJust findOnly gs
-  findOnly (Pending _) = Nothing
-
-  findJust :: forall a. (a -> Maybe a) -> Array a -> Maybe a
-  findJust f = foldl go Nothing
-    where
-    go Nothing x = f x
-    go acc _ = acc
+  findFocus :: Tree c (Item m a) -> Maybe (Tree c (Item m a))
+  findFocus (Node n ts') = case mapMaybe findFocus ts' of
+    [] -> Nothing
+    r -> Just $ Node n r
+  findFocus t@(Leaf n (Just (Item { isFocused }))) = if isFocused then Nothing else Just t
+  findFocus (Leaf n Nothing) = Nothing
 
 makeTimeout
   :: Int
@@ -90,6 +91,11 @@ timeout time t = do
   sequential (parallel (try (makeTimeout time)) <|> parallel (try t))
     >>= either throwError pure
 
+allParallelizable :: forall c m a. Tree c (Item m a) -> Boolean
+allParallelizable = case _ of
+  Node _ xs -> all allParallelizable xs
+  Leaf _ x -> let p = x >>= un Item >>> _.isParallelizable in p == Just true || p == Nothing
+
 -- Run the given spec as `Producer` in the underlying `Aff` monad.
 -- This producer has two responsibilities:
 --      1) emit events for key moments in the runner's lifecycle
@@ -98,48 +104,96 @@ timeout time t = do
 -- prodocer has completed and still benefit from the array of results the way
 -- the runner sees it.
 _run
-  :: Config
-  -> Spec Unit
-  -> Producer Event Aff (Array (Group Result))
-_run config spec = do
-  yield (Event.Start (Spec.countTests spec))
-  r <- for (trim $ execWriter spec) (runGroup Sequential)
+  :: forall m
+   . Functor m
+  => Config
+  -> SpecM m Aff Unit Unit
+  -> m (Producer Event Aff (Array (Tree Void Result)))
+_run config specs = execWriterT specs <#> filterFocusedIfAny >>> \tests -> do
+  yield (Event.Start (Spec.countTests tests))
+  r <- loop tests
   yield (Event.End r)
   pure r
   where
-  runGroup :: Execution -> Group (Aff Unit) -> Producer Event Aff (Group Result)
-  runGroup isPar (It only name test) = do
-    yield Event.Test
-    start    <- lift $ liftEffect dateNow
-    e        <- lift $ attempt case config.timeout of
-                                      Just t -> timeout t test
-                                      _      -> test
-    duration <- lift $ (_ - start) <$> liftEffect dateNow
-    yield $ either
-      (\err ->
-        let msg = Error.message err
-            stack = Error.stack err
-         in Event.Fail name msg stack)
-      (const $ Event.Pass name (speedOf config.slow duration) duration)
-      e
-    yield Event.TestEnd
-    pure $ It only name $ either Failure (const Success) e
-
-  runGroup isPar (Pending name) = do
-    yield $ Event.Pending name
-    pure $ Pending name
-
-  runGroup _ (SetExecution isPar xs) = do
-    SetExecution isPar <$> loop xs isPar
-
-  runGroup isPar (Describe only name xs) = do
-    yield $ Event.Suite name
-    Describe only name <$> loop xs isPar
-      <* yield Event.SuiteEnd
+    loop :: Array (SpecTree Aff Unit) -> Producer Event Aff (Array (Tree Void Result))
+    loop tests = 
+      let
+        marked :: Array (Tuple Boolean (SpecTree Aff Unit))
+        marked = tests <#> \t -> Tuple (allParallelizable t) t
+        grouped' :: Array (NonEmptyArray (Tuple Boolean (SpecTree Aff Unit)))
+        grouped' = groupBy (\a b -> fst a && fst b) marked
+        grouped :: Array (Tuple Boolean (Array (SpecTree Aff Unit)))
+        grouped = grouped' <#> \g -> Tuple (fst $ NEA.head g) $ snd <$> NEA.toArray g
+      in join <$> for grouped \(Tuple isParallelizable xs) -> join <$> if isParallelizable
+        then mergeProducers (runGroup <$> xs)
+        else for xs runGroup
+
+    runGroup :: SpecTree Aff Unit -> Producer Event Aff (Array (Tree Void Result))
+    runGroup (Leaf name (Just (Item item))) = do
+      yield Event.Test
+      let test = item.example \a -> a unit
+      start <- lift $ liftEffect dateNow
+      e <- lift $ attempt case config.timeout of
+        Just t -> timeout t test
+        _      -> test
+      duration <- lift $ (_ - start) <$> liftEffect dateNow
+      yield $ either
+        (\err ->
+          let msg = Error.message err
+              stack = Error.stack err
+          in Event.Fail name msg stack)
+        (const $ Event.Pass name (speedOf config.slow duration) duration)
+        e
+      yield Event.TestEnd
+      pure [ Leaf name $ Just $ either Failure (const Success) e ]
+
+    runGroup (Leaf name Nothing) = do
+      yield $ Event.Pending name
+      pure [ Leaf name Nothing ]
+
+    runGroup (Node (Right cleanup) xs) = do
+      loop xs <* lift (cleanup unit)
+    runGroup (Node (Left name) xs) = do
+      yield $ Event.Suite name
+      res <- loop xs
+      yield Event.SuiteEnd
+      pure [ Node (Left name) res ]
   
-  loop xs = case _ of
-    Parallel -> mergeProducers (runGroup Parallel <$> xs)
-    Sequential -> for xs (runGroup Sequential)
+    -- Parallel -> mergeProducers (runGroup Parallel <$> xs)
+    -- Sequential -> for xs (runGroup Sequential)
+  -- runGroup :: Execution -> Group (Aff Unit) -> Producer Event Aff (Tree Void Result)
+  -- runGroup isPar (It only name test) = do
+  --   yield Event.Test
+  --   start    <- lift $ liftEffect dateNow
+  --   e        <- lift $ attempt case config.timeout of
+  --                                     Just t -> timeout t test
+  --                                     _      -> test
+  --   duration <- lift $ (_ - start) <$> liftEffect dateNow
+  --   yield $ either
+  --     (\err ->
+  --       let msg = Error.message err
+  --           stack = Error.stack err
+  --        in Event.Fail name msg stack)
+  --     (const $ Event.Pass name (speedOf config.slow duration) duration)
+  --     e
+  --   yield Event.TestEnd
+  --   pure $ It only name $ either Failure (const Success) e
+
+  -- runGroup isPar (Pending name) = do
+  --   yield $ Event.Pending name
+  --   pure $ Pending name
+
+  -- runGroup _ (SetExecution isPar xs) = do
+  --   SetExecution isPar <$> loop xs isPar
+
+  -- runGroup isPar (Describe only name xs) = do
+  --   yield $ Event.Suite name
+  --   Describe only name <$> loop xs isPar
+  --     <* yield Event.SuiteEnd
+  
+  -- loop xs = case _ of
+  --   Parallel -> mergeProducers (runGroup Parallel <$> xs)
+  --   Sequential -> for xs (runGroup Sequential)
 
 
 -- https://github.com/felixSchl/purescript-pipes/issues/16
@@ -166,42 +220,46 @@ mergeProducers ps = do
 
 -- | Run a spec, returning the results, without any reporting
 runSpec'
-  :: Config
-  -> Spec Unit
-  -> Aff (Array (Group Result))
-runSpec' config spec = P.runEffectRec $ _run config spec //> const (pure unit)
+  :: forall m
+   . Functor m
+  => Config
+  -> SpecM m Aff Unit Unit
+  -> m (Aff (Array (Tree Void Result)))
+runSpec' config spec = _run config spec <#> \runner -> P.runEffectRec $ runner //> const (pure unit)
 
 -- | Run a spec with the default config, returning the results, without any
 -- | reporting
 runSpec
   :: Spec Unit
-  -> Aff (Array (Group Result))
-runSpec spec = P.runEffectRec $ _run defaultConfig spec //> const (pure unit)
+  -> Aff (Array (Tree Void Result))
+runSpec = un Identity <<< runSpec' defaultConfig
 
-type TestEvents = Producer Event Aff (Array (Group Result))
+type TestEvents = Producer Event Aff (Array (Tree Void Result))
 
-type Reporter = Pipe Event Event Aff (Array (Group Result))
+type Reporter = Pipe Event Event Aff (Array (Tree Void Result))
 
 -- | Run the spec with `config`, report results and (if configured as such)
 -- | exit the program upon completion
 run'
-  :: Config
+  :: forall m
+   . Functor m
+  => Config
   -> Array Reporter
-  -> Spec Unit
-  -> Aff Unit
-run' config reporters spec = do
-  let reportedEvents = P.runEffectRec $ events //> drain
+  -> SpecM m Aff Unit Unit
+  -> m (Aff Unit)
+run' config reporters spec = _run config spec <#> \runner -> do
+  let
+    drain = const (pure unit)
+    events = foldl (>->) runner reporters
+    reportedEvents = P.runEffectRec $ events //> drain
   either onError onSuccess =<< try reportedEvents
   where
-    drain = const (pure unit)
-    events = foldl (>->) (_run config spec) reporters
-
     onError :: Error -> Aff Unit
     onError err = liftEffect do
        withAttrs [31] $ logShow err
        when config.exit (exit 1)
 
-    onSuccess :: Array (Group Result) -> Aff Unit
+    onSuccess :: Array (Tree Void Result) -> Aff Unit
     onSuccess results = liftEffect $
       when config.exit do
         let code = if successful results then 0 else 1
@@ -212,4 +270,4 @@ run
   :: Array Reporter
   -> Spec Unit
   -> Aff Unit
-run = run' defaultConfig
+run reporters spec = un Identity $ run' defaultConfig reporters spec
diff --git a/src/Test/Spec/Runner/Event.purs b/src/Test/Spec/Runner/Event.purs
index 0adda13..4b6575e 100644
--- a/src/Test/Spec/Runner/Event.purs
+++ b/src/Test/Spec/Runner/Event.purs
@@ -1,8 +1,9 @@
 module Test.Spec.Runner.Event where
 
 import Prelude
+
 import Data.Maybe (Maybe)
-import Test.Spec (Group, Result)
+import Test.Spec (Result, Tree)
 import Test.Spec.Speed (Speed)
 
 type Message = String
@@ -13,14 +14,14 @@ type Stack = String
 
 data Event
   = Start NumberOfTests
-  | Suite String
+  | Suite Name
   | Test
   | TestEnd
   | SuiteEnd
   | Fail Name Message (Maybe Stack)
   | Pass Name Speed Duration
-  | Pending String
-  | End (Array (Group Result))
+  | Pending Name
+  | End (Array (Tree Void Result))
 
 instance showEvent :: Show Event where
   show =
diff --git a/src/Test/Spec/Summary.purs b/src/Test/Spec/Summary.purs
index 79982f7..9b7f7ce 100644
--- a/src/Test/Spec/Summary.purs
+++ b/src/Test/Spec/Summary.purs
@@ -7,27 +7,25 @@ module Test.Spec.Summary (
 import Prelude
 
 import Data.Foldable (foldMap)
+import Data.Maybe (Maybe(..))
+import Data.Newtype (class Newtype, un)
+import Test.Spec (Result(..), Tree(..))
 
-import Test.Spec (Group(..), Result(..))
-
-data Summary = Count Int Int Int
+newtype Summary = Count { passed :: Int, failed :: Int, pending :: Int }
+derive instance newtypeSummary :: Newtype Summary _
 
 instance semigroupCount :: Semigroup Summary where
-  append (Count p1 f1 s1) (Count p2 f2 s2) = Count (p1 + p2) (f1 + f2) (s1 + s2)
+  append (Count c1) (Count c2) = Count $ c1 + c2
 
 instance monoidCount :: Monoid Summary where
-  mempty = Count 0 0 0
+  mempty = Count zero
 
-summarize :: Array (Group Result) -> Summary
-summarize = foldMap \g -> case g of
-    (It _ _ Success)     -> Count 1 0 0
-    (It _ _ (Failure _)) -> Count 0 1 0
-    (Pending _)          -> Count 0 0 1
-    (Describe _ _ dgs)   -> summarize dgs
-    (SetExecution _ dgs) -> summarize dgs
+summarize :: forall a. Array (Tree a Result) -> Summary
+summarize = foldMap case _ of
+  (Leaf _ (Just Success))     -> Count { passed: 1, failed: 0, pending: 0 }
+  (Leaf _ (Just (Failure _))) -> Count { passed: 0, failed: 1, pending: 0 }
+  (Leaf _ Nothing)            -> Count { passed: 0, failed: 0, pending: 1 }
+  (Node _ dgs)                -> summarize dgs
 
-successful :: Array (Group Result) -> Boolean
-successful groups =
-  case summarize groups of
-    (Count _ 0 _) -> true
-    _             -> false
+successful :: forall a. Array (Tree a Result) -> Boolean
+successful groups = (un Count $ summarize groups).failed == 0
\ No newline at end of file
diff --git a/test/Test/Spec/AssertionSpec.purs b/test/Test/Spec/AssertionSpec.purs
index b8e0356..f5dad18 100644
--- a/test/Test/Spec/AssertionSpec.purs
+++ b/test/Test/Spec/AssertionSpec.purs
@@ -4,9 +4,8 @@ import Prelude
 import Effect.Exception (error)
 import Control.Monad.Error.Class (throwError)
 import Test.Spec (Spec, describe, it)
-import Test.Spec.Assertions (shouldContain, shouldNotContain, shouldNotSatisfy, shouldSatisfy) as A
-import Test.Spec.Assertions.Aff (expectError, shouldReturn, shouldNotReturn) as AF
-import Test.Spec.Assertions.String (shouldContain, shouldNotContain, shouldStartWith, shouldEndWith) as AS
+import Test.Spec.Assertions as A
+import Test.Spec.Assertions.String as AS
 
 assertionSpec :: Spec Unit
 assertionSpec =
@@ -19,38 +18,38 @@ assertionSpec =
             it "accepts strings that contains substrings" $
               "foobar" `AS.shouldContain` "foo"
             it "rejects strings that does not contain substrings" $
-              AF.expectError $ "baz" `AS.shouldContain` "foo"
+              A.expectError $ "baz" `AS.shouldContain` "foo"
 
           describe "shouldNotContain" do
             it "accepts strings that does not contain substrings" $
               "foobar" `AS.shouldNotContain` "baz"
             it "rejects strings that contains substrings" $
-              AF.expectError $ "bazbar" `AS.shouldNotContain` "baz"
+              A.expectError $ "bazbar" `AS.shouldNotContain` "baz"
 
           describe "shouldStartWith" do
             it "accepts strings that start with prefix" $
               "hello, world" `AS.shouldStartWith` "hello"
             it "rejects strings that do not start with prefix" $
-              AF.expectError $ "hello" `AS.shouldStartWith` "hello, world"
+              A.expectError $ "hello" `AS.shouldStartWith` "hello, world"
 
           describe "shouldEndWith" do
             it "accepts strings that end with suffix" $
               "hello, world" `AS.shouldEndWith` "world"
             it "rejects strings that do not end with suffix" $
-              AF.expectError $ "world" `AS.shouldEndWith` "hello, world"
+              A.expectError $ "world" `AS.shouldEndWith` "hello, world"
 
         describe "Predicates" do
           describe "shouldSatisfy" do
             it "accepts values where predicate returns true" $
               3 `A.shouldSatisfy` (_ > 2)
             it "rejects values where predicate returns false" $
-              AF.expectError $ 3 `A.shouldSatisfy` (_ < 2)
+              A.expectError $ 3 `A.shouldSatisfy` (_ < 2)
 
           describe "shouldNotSatisfy" do
             it "accepts values where predicate returns false" $
               3 `A.shouldNotSatisfy` (_ < 2)
             it "rejects values where predicate returns true" $
-              AF.expectError $ 3 `A.shouldNotSatisfy` (_ > 2)
+              A.expectError $ 3 `A.shouldNotSatisfy` (_ > 2)
 
         describe "Foldable" do
           describe "for some foldable" do
@@ -62,13 +61,13 @@ assertionSpec =
               it "accepts f that contains a" $
                 f `A.shouldContain` contained
               it "rejects f that does not contain a" $
-                AF.expectError $ f `A.shouldContain` notcontained
+                A.expectError $ f `A.shouldContain` notcontained
 
             describe "shouldNotContain" do
               it "accepts f that does not contain a" $
                 f `A.shouldNotContain` notcontained
               it "rejects f that contains a" $
-                AF.expectError $ f `A.shouldNotContain` contained
+                A.expectError $ f `A.shouldNotContain` contained
 
 
         describe "Aff" do
@@ -78,18 +77,18 @@ assertionSpec =
 
           describe "expectError" do
             it "returns unit when given an error" $
-              AF.expectError $ throwError $ error "omg"
+              A.expectError $ throwError $ error "omg"
             it "returns an error when given a non-error" $
-              AF.expectError $ AF.expectError $ pure "ok"
+              A.expectError $ A.expectError $ pure "ok"
 
           describe "shouldReturn" do
             it "accepts that `Aff String` contains \"nono\"" $
-              f `AF.shouldReturn` contained
+              f `A.shouldReturn` contained
             it "rejects that `Aff String` contains \"zzz\"" $
-              AF.expectError $ f `AF.shouldReturn` notcontained
+              A.expectError $ f `A.shouldReturn` notcontained
 
           describe "shouldNotReturn" do
             it "accepts f does not contain \"zzz\"" $
-              f `AF.shouldNotReturn` notcontained
+              f `A.shouldNotReturn` notcontained
             it "rejects that `Aff String` does not contain \"zzz\"" $
-              AF.expectError $ f `AF.shouldNotReturn` contained
+              A.expectError $ f `A.shouldNotReturn` contained

From 114f8bb718a95ff73c6598322c4197648fdcd212 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Thu, 10 Jan 2019 17:51:48 +0400
Subject: [PATCH 07/39] add hoist and some cleanup

---
 src/Test/Spec.purs                  | 229 +++++++++++-----------------
 src/Test/Spec/Reporter/Console.purs |  11 +-
 src/Test/Spec/Runner.purs           |  65 +-------
 src/Test/Spec/Tree.purs             | 111 ++++++++++++++
 test/Main.purs                      |   6 +-
 test/Test/Spec/Fixtures.purs        |  55 +++----
 test/Test/Spec/HoistSpec.purs       |  60 +++++---
 test/Test/Spec/HookSpec.purs        |  26 ++++
 test/Test/Spec/RunnerSpec.purs      |  51 +++++--
 9 files changed, 332 insertions(+), 282 deletions(-)
 create mode 100644 src/Test/Spec/Tree.purs
 create mode 100644 test/Test/Spec/HookSpec.purs

diff --git a/src/Test/Spec.purs b/src/Test/Spec.purs
index f0e79d3..6383dac 100644
--- a/src/Test/Spec.purs
+++ b/src/Test/Spec.purs
@@ -1,23 +1,45 @@
 module Test.Spec
   ( Spec
   , SpecM
-  , Tree(..)
-  , Item(..)
+  , module Reexport
   , SpecTree
-  , ActionWith
+  , mapSpecTree
+
+  , ComputationType(..)
+  , hoistSpec
+
+  , Result(..)
+  
   , class Example
   , evaluateExample
-  , describe
-  , describeOnly
+  
   , parallel
   , sequential
 
+  , class FocusWarning
+  , focus
+  , describeOnly
+  , itOnly
+  
+  , describe
+  , it
   , pending
   , pending'
-  , it
-  , itOnly
-  , countTests
-  , Result(..)
+  
+  , aroundWith
+  , around
+  , around_
+
+  , before
+  , before_
+  , beforeWith
+  , beforeAll
+  , beforeAll_
+  
+  , after
+  , after_
+  , afterAll
+  , afterAll_
   ) where
 
 import Prelude
@@ -25,20 +47,15 @@ import Prelude
 import Control.Alt ((<|>))
 import Control.Monad.Error.Class (class MonadError)
 import Control.Monad.Fork.Class (class MonadBracket, bracket)
-import Control.Monad.State (execState)
-import Control.Monad.State as State
-import Control.Monad.Writer (WriterT(..), mapWriterT, runWriterT, tell)
+import Control.Monad.Writer (WriterT, mapWriterT, tell)
 import Data.Array (any)
+import Data.Array.NonEmpty (NonEmptyArray)
+import Data.Bifunctor (bimap)
 import Data.Either (Either(..), either)
-import Data.Foldable (class Foldable, foldMapDefaultL, foldl, foldr)
-import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Eq (genericEq)
-import Data.Generic.Rep.Show (genericShow)
+import Data.Function (applyFlipped)
 import Data.Identity (Identity)
-import Data.Maybe (Maybe(..), maybe)
-import Data.Newtype (class Newtype, over, un)
-import Data.Traversable (for, for_)
-import Data.Tuple (Tuple(..))
+import Data.Maybe (Maybe(..))
+import Data.Newtype (over, un)
 import Effect.AVar (AVar)
 import Effect.AVar as AVarEff
 import Effect.Aff (Aff, error, throwError, try)
@@ -46,75 +63,38 @@ import Effect.Aff.AVar as AVar
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Exception (Error)
+import Prim.TypeError (class Warn, Text)
+import Test.Spec.Tree (ActionWith, Item(..), Tree(..)) as Reexport
+import Test.Spec.Tree (ActionWith, Item(..), Tree(..), bimapTree, modifyAroundAction)
+
+
+type Spec a = SpecM Identity Aff Unit a
+type SpecM m g i a = WriterT (Array (SpecTree g i)) m a
 
--- TODO remove this
-anExample :: Spec Unit
-anExample = do
-  describe "foo" do
-    it "asd" do
-      pure unit
-    it "asd" do
-      pure unit
-    before (pure 1) $ after (\a -> let x = a + 1 in pure unit) do
-      it "asd" \num -> do
-        x <- pure $ num + 1
-        pure unit
-      it "asdasdasd" \num -> do
-        x <- pure $ num + 1
-        pure unit
-      beforeWith (const $ pure "asd") do
-        it "asd" \str -> do
-          z <- pure $ str <> "as"
-          pure unit
-        aroundWith (\e str -> let z = str <> "" in pure 1 >>= e <* pure unit) do
-          it "asd" \num -> do
-            z <- pure $ num + 1
-            pure unit
-      beforeWith (\num -> pure $ "asd" <> show (num + 1)) do
-        it "asd" \str -> do
-          z <- pure $ str <> "as"
-          pure unit
-    pure unit
-
-data Tree c a
-  = Node (Either String c) (Array (Tree c a))
-  | Leaf String (Maybe a)
-
-derive instance treeGeneric :: Generic (Tree c a) _
-instance treeEq :: (Eq c, Eq a) => Eq (Tree c a) where eq = genericEq
-instance treeShow :: (Show c, Show a) => Show (Tree c a) where show = genericShow
-
-
--- instance showGroup :: Show t => Show (Group t) where
---   show (SetExecution execution groups) = "SetExecution " <> show execution <> " " <> show groups
---   show (Describe only name groups) = "Describe " <> show only <> " " <> show name <> " " <> show groups
---   show (It only name test) = "It " <> show only <> " " <> show name <> " " <> show test
---   show (Pending name) = "Describe " <> show name
-
--- instance eqGroup :: Eq t => Eq (Group t) where
---   eq (SetExecution e1 g1) (SetExecution e2 g2) = e1 == e2 && g1 == g2
---   eq (Describe o1 n1 g1)  (Describe o2 n2 g2)  = o1 == o2 && n1 == n2 && g1 == g2
---   eq (It o1 n1 t1)        (It o2 n2 t2)        = o1 == o2 && n1 == n2 && t1 == t2
---   eq (Pending n1)         (Pending n2)         = n1 == n2
---   eq _                    _                    = false
-
-
-instance treeFoldable :: Foldable (Tree c) where
-  foldr f i (Leaf _ a) = maybe i (\a' -> f a' i) a
-  foldr f i (Node _ as) = foldr (\a i' -> foldr f i' a) i as
-  foldl f i (Leaf _ a) = maybe i (\a' -> f i a') a
-  foldl f i (Node _ as) = foldl (\i' a -> foldl f i' a) i as
-  foldMap f = foldMapDefaultL f
-
-type ActionWith m a = a -> m Unit
 type SpecTree m a = Tree (ActionWith m a) (Item m a)
-newtype Item m a = Item
-  { isFocused :: Boolean
-  , isParallelizable :: Maybe Boolean
-  , example :: (ActionWith m a -> m Unit) -> m Unit
-  }
 
-derive instance itemNewtype :: Newtype (Item m a) _
+mapSpecTree
+  :: forall m g g' i a i'
+   . Monad m
+   => (SpecTree g i -> SpecTree g' i') 
+   -> SpecM m g i a
+   -> SpecM m g' i' a
+mapSpecTree f = mapWriterT $ map $ map $ map f
+
+data ComputationType = CleanUpWithContext (Array String) | TestWithName (NonEmptyArray String)
+
+hoistSpec :: forall m i a b. Monad m => (ComputationType -> a ~> b) -> SpecM m a i ~> SpecM m b i
+hoistSpec f = mapSpecTree $ bimapTree onCleanUp onTest
+  where
+    onCleanUp :: Array String -> (ActionWith a i) -> ActionWith b i
+    onCleanUp name around' = \i -> f (CleanUpWithContext name) (around' i)
+    onTest :: NonEmptyArray String -> Item a i -> Item b i
+    onTest name = over Item \item ->
+      let
+        e :: ((i -> b Unit) -> b Unit) -> b Unit
+        e g = g (f (TestWithName name) <<< item.example <<< applyFlipped)
+      in item { example = e }
+
 
 class Example t arg m | t -> arg, t -> m where
   evaluateExample :: t -> (ActionWith m arg -> m Unit) -> m Unit
@@ -128,33 +108,6 @@ else instance exampleMUnit :: Example (m Unit) Unit m where
   evaluateExample t around' = around' $ \_ -> t
 
 
-type Spec a = SpecM Identity Aff Unit a
-type SpecM m g i a = WriterT (Array (SpecTree g i)) m a
-
-bimapTree :: forall a b c d. (a -> b) -> (c -> d) -> Tree a c -> Tree b d
-bimapTree g f = go
-  where
-    go spec = case spec of
-      Node d xs -> Node (map g d) (map go xs)
-      Leaf n item -> Leaf n (map f item)
-
-mapSpecTree
-  :: forall m g g' i a i'
-   . Monad m
-   => (SpecTree g i -> SpecTree g' i') 
-   -> SpecM m g i a
-   -> SpecM m g' i' a
-mapSpecTree f (specs) = mapWriterT (map ((<$>) (map f))) specs
-
-mapSpecItem
-  :: forall m g g' a b r
-   . Monad m
-  => (ActionWith g a -> ActionWith g' b)
-  -> (Item g a -> Item g' b)
-  -> SpecM m g a r
-  -> SpecM m g' b r
-mapSpecItem g f = mapSpecTree (bimapTree g f)
-
 data Result
   = Success
   | Failure Error
@@ -169,28 +122,23 @@ instance eqResult :: Eq Result where
   eq _ _ = false
 
 
--- | Count the total number of tests in a spec
-countTests :: forall g i. Array (SpecTree g i) -> Int
-countTests g = execState (for g go) 0
-  where
-  go (Node _ xs) = for_ xs go
-  go (Leaf _ _) = State.modify_ (_ + 1)
+-- | Nullary class used to raise a custom warning for the focusing functions.
+class FocusWarning
 
+instance warn :: Warn (Text "Test.Spec.focus usage") => FocusWarning
 
 -- ---------------------
 -- --       DSL       --
 -- ---------------------
 
-
 -- | `focus` focuses all spec items of the given spec.
 -- |
 -- | Applying `focus` to a spec with focused spec items has no effect.
-focus :: forall m g i a. Monad m => SpecM m g i a -> SpecM m g i a
-focus test = WriterT do
-  Tuple res xs <- runWriterT test
-  pure $ Tuple res $ if any (any $ un Item >>> _.isFocused) xs
+focus :: forall m g i a. FocusWarning => Monad m => SpecM m g i a -> SpecM m g i a
+focus = mapWriterT $ map $ map \xs ->
+  if any (any $ un Item >>> _.isFocused) xs
     then xs
-    else map (bimapTree identity (\(Item r) -> Item r {isFocused = true})) xs
+    else map (bimap identity (\(Item r) -> Item r {isFocused = true})) xs
 
 
 -- | Combine a group of specs into a described hierarchy.
@@ -200,9 +148,7 @@ describe
   => String
   -> SpecM m g i a
   -> SpecM m g i a
-describe name test = WriterT do
-  Tuple res group <- runWriterT test
-  pure $ Tuple res [Node (Left name) group]
+describe name = mapWriterT $ map $ map \group -> [Node (Left name) group]
 
 
 -- | Combine a group of specs into a described hierarchy and mark it as the
@@ -210,7 +156,8 @@ describe name test = WriterT do
 -- | on a set)
 describeOnly
   :: forall m g i a
-   . Monad m
+   . FocusWarning
+  => Monad m
   => String
   -> SpecM m g i a
   -> SpecM m g i a
@@ -222,7 +169,7 @@ parallel
    . Monad m
   => SpecM m g i a
   -> SpecM m g i a
-parallel = mapSpecItem identity (setParallelizable true)
+parallel = mapSpecTree $ bimap identity (setParallelizable true)
 
 -- | marks all spec items of the given spec to be evaluated sequentially.
 sequential
@@ -230,7 +177,7 @@ sequential
    . Monad m
   => SpecM m g i a
   -> SpecM m g i a
-sequential = mapSpecItem identity (setParallelizable false)
+sequential = mapSpecTree $ bimap identity (setParallelizable false)
 
 setParallelizable :: forall g a. Boolean -> Item g a -> Item g a
 setParallelizable value = over Item \i -> i{isParallelizable = i.isParallelizable <|> Just value}
@@ -274,13 +221,19 @@ it name test = tell
 -- | be run. (useful for quickly narrowing down on a single test)
 itOnly
   :: forall m t arg g
-   . Monad m
+   . FocusWarning
+  => Monad m
   => Example t arg g
   => String
   -> t
   -> SpecM m g arg Unit
 itOnly = map focus <<< it
 
+
+-- ---------------------
+-- --      HOOKS      --
+-- ---------------------
+
 -- | Run a custom action before and/or after every spec item.
 aroundWith
   :: forall m g i i' a
@@ -288,13 +241,7 @@ aroundWith
   => (ActionWith g i -> ActionWith g i')
   -> SpecM m g i a
   -> SpecM m g i' a
-aroundWith action = mapSpecItem action (modifyAroundAction action)
-
-
-modifyAroundAction :: forall g a b. (ActionWith g a -> ActionWith g b) -> Item g a -> Item g b
-modifyAroundAction action (Item item) = Item $ item
-  { example = \aroundAction -> item.example (aroundAction <<< action)
-  }
+aroundWith action = mapSpecTree $ bimap action (modifyAroundAction action)
 
 -- | Run a custom action before and/or after every spec item.
 around_ :: forall m g i a. Monad m => (g Unit -> g Unit) -> SpecM m g i a -> SpecM m g i a
@@ -356,9 +303,7 @@ memoize var action = do
 
 -- | Run a custom action after the last spec item.
 afterAll :: forall m g i a. Monad m => ActionWith g i -> SpecM m g i a -> SpecM m g i a
-afterAll action spec = WriterT do
-  Tuple res group <- runWriterT spec
-  pure $ Tuple res [Node (Right action) group]
+afterAll action = mapWriterT $ map $ map \group -> [Node (Right action) group]
 
 -- | Run a custom action after the last spec item.
 afterAll_ :: forall m g i a. Monad m => g Unit -> SpecM m g i a -> SpecM m g i a
diff --git a/src/Test/Spec/Reporter/Console.purs b/src/Test/Spec/Reporter/Console.purs
index 90ee266..3359e26 100644
--- a/src/Test/Spec/Reporter/Console.purs
+++ b/src/Test/Spec/Reporter/Console.purs
@@ -1,19 +1,20 @@
 module Test.Spec.Reporter.Console (consoleReporter) where
 
 import Prelude
-import Test.Spec.Color as Color
-import Test.Spec.Runner.Event as Event
-import Test.Spec.Summary as Summary
-import Effect (Effect)
-import Effect.Console (log)
+
 import Data.Array (init)
 import Data.Foldable (intercalate)
 import Data.Maybe (fromMaybe)
+import Effect (Effect)
+import Effect.Console (log)
 import Test.Spec.Color (colored)
+import Test.Spec.Color as Color
 import Test.Spec.Console (withAttrs)
 import Test.Spec.Reporter.Base (defaultReporter)
 import Test.Spec.Runner (Reporter)
+import Test.Spec.Runner.Event as Event
 import Test.Spec.Summary (Summary(..))
+import Test.Spec.Summary as Summary
 
 type ConsoleReporterStateObj = {
   crumbs :: Array String
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index cc42760..c5dcf4d 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -16,7 +16,7 @@ import Control.Alternative ((<|>))
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Writer (execWriterT)
 import Control.Parallel (parTraverse, parallel, sequential)
-import Data.Array (all, groupBy, mapMaybe)
+import Data.Array (groupBy)
 import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Array.NonEmpty as NEA
 import Data.Either (Either(..), either)
@@ -39,12 +39,12 @@ import Pipes ((>->), yield)
 import Pipes.Core (Pipe, Producer, (//>))
 import Pipes.Core (runEffectRec) as P
 import Test.Spec (Item(..), Result(..), Spec, SpecM, SpecTree, Tree(..))
-import Test.Spec as Spec
 import Test.Spec.Console (withAttrs)
 import Test.Spec.Runner.Event (Event)
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Speed (speedOf)
 import Test.Spec.Summary (successful)
+import Test.Spec.Tree (countTests, discardUnfocused, isAllParallelizable)
 
 foreign import exit :: Int -> Effect Unit
 
@@ -63,18 +63,6 @@ defaultConfig =
   , exit: true
   }
 
-filterFocusedIfAny :: forall c m a. Array (Tree c (Item m a)) -> Array (Tree c (Item m a))
-filterFocusedIfAny ts = case mapMaybe findFocus ts of
-  [] -> ts
-  r -> r
-  where
-  findFocus :: Tree c (Item m a) -> Maybe (Tree c (Item m a))
-  findFocus (Node n ts') = case mapMaybe findFocus ts' of
-    [] -> Nothing
-    r -> Just $ Node n r
-  findFocus t@(Leaf n (Just (Item { isFocused }))) = if isFocused then Nothing else Just t
-  findFocus (Leaf n Nothing) = Nothing
-
 makeTimeout
   :: Int
   -> Aff Unit
@@ -91,10 +79,6 @@ timeout time t = do
   sequential (parallel (try (makeTimeout time)) <|> parallel (try t))
     >>= either throwError pure
 
-allParallelizable :: forall c m a. Tree c (Item m a) -> Boolean
-allParallelizable = case _ of
-  Node _ xs -> all allParallelizable xs
-  Leaf _ x -> let p = x >>= un Item >>> _.isParallelizable in p == Just true || p == Nothing
 
 -- Run the given spec as `Producer` in the underlying `Aff` monad.
 -- This producer has two responsibilities:
@@ -109,17 +93,17 @@ _run
   => Config
   -> SpecM m Aff Unit Unit
   -> m (Producer Event Aff (Array (Tree Void Result)))
-_run config specs = execWriterT specs <#> filterFocusedIfAny >>> \tests -> do
-  yield (Event.Start (Spec.countTests tests))
+_run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
+  yield (Event.Start (countTests tests))
   r <- loop tests
   yield (Event.End r)
   pure r
   where
     loop :: Array (SpecTree Aff Unit) -> Producer Event Aff (Array (Tree Void Result))
-    loop tests = 
+    loop tests =
       let
         marked :: Array (Tuple Boolean (SpecTree Aff Unit))
-        marked = tests <#> \t -> Tuple (allParallelizable t) t
+        marked = tests <#> \t -> Tuple (isAllParallelizable t) t
         grouped' :: Array (NonEmptyArray (Tuple Boolean (SpecTree Aff Unit)))
         grouped' = groupBy (\a b -> fst a && fst b) marked
         grouped :: Array (Tuple Boolean (Array (SpecTree Aff Unit)))
@@ -158,43 +142,6 @@ _run config specs = execWriterT specs <#> filterFocusedIfAny >>> \tests -> do
       res <- loop xs
       yield Event.SuiteEnd
       pure [ Node (Left name) res ]
-  
-    -- Parallel -> mergeProducers (runGroup Parallel <$> xs)
-    -- Sequential -> for xs (runGroup Sequential)
-  -- runGroup :: Execution -> Group (Aff Unit) -> Producer Event Aff (Tree Void Result)
-  -- runGroup isPar (It only name test) = do
-  --   yield Event.Test
-  --   start    <- lift $ liftEffect dateNow
-  --   e        <- lift $ attempt case config.timeout of
-  --                                     Just t -> timeout t test
-  --                                     _      -> test
-  --   duration <- lift $ (_ - start) <$> liftEffect dateNow
-  --   yield $ either
-  --     (\err ->
-  --       let msg = Error.message err
-  --           stack = Error.stack err
-  --        in Event.Fail name msg stack)
-  --     (const $ Event.Pass name (speedOf config.slow duration) duration)
-  --     e
-  --   yield Event.TestEnd
-  --   pure $ It only name $ either Failure (const Success) e
-
-  -- runGroup isPar (Pending name) = do
-  --   yield $ Event.Pending name
-  --   pure $ Pending name
-
-  -- runGroup _ (SetExecution isPar xs) = do
-  --   SetExecution isPar <$> loop xs isPar
-
-  -- runGroup isPar (Describe only name xs) = do
-  --   yield $ Event.Suite name
-  --   Describe only name <$> loop xs isPar
-  --     <* yield Event.SuiteEnd
-  
-  -- loop xs = case _ of
-  --   Parallel -> mergeProducers (runGroup Parallel <$> xs)
-  --   Sequential -> for xs (runGroup Sequential)
-
 
 -- https://github.com/felixSchl/purescript-pipes/issues/16
 mergeProducers :: forall t o a. Traversable t => t (Producer o Aff a) -> Producer o Aff (t a)
diff --git a/src/Test/Spec/Tree.purs b/src/Test/Spec/Tree.purs
new file mode 100644
index 0000000..25d6132
--- /dev/null
+++ b/src/Test/Spec/Tree.purs
@@ -0,0 +1,111 @@
+module Test.Spec.Tree
+  ( Tree(..)
+  , Item(..)
+  , ActionWith
+  , bimapTree
+  , countTests
+  , isAllParallelizable
+  , discardUnfocused
+  , modifyAroundAction
+  ) where
+
+import Prelude
+
+import Control.Monad.State (execState)
+import Control.Monad.State as State
+import Data.Array (mapMaybe)
+import Data.Array.NonEmpty (NonEmptyArray)
+import Data.Array.NonEmpty as NEA
+import Data.Bifunctor (class Bifunctor)
+import Data.Either (Either)
+import Data.Foldable (class Foldable, all, foldMapDefaultL, foldl, foldr)
+import Data.Maybe (Maybe(..), maybe)
+import Data.Newtype (class Newtype, un)
+import Data.Traversable (for, for_)
+
+
+data Tree c a
+  = Node (Either String c) (Array (Tree c a))
+  | Leaf String (Maybe a)
+
+instance showGroup :: (Show c, Show a) => Show (Tree c a) where
+  show (Node nc xs) = "(Node " <> show nc <> " " <> show xs <> ")"
+  show (Leaf name t) = "(Leaf " <> show name <> " " <> show t <> ")"
+
+instance eqGroup :: (Eq c, Eq a) => Eq (Tree c a) where
+  eq (Node nc1 xs1) (Node nc2 xs2) = nc1 == nc2 && xs1 == xs2
+  eq (Leaf n1 t1) (Leaf n2 t2) = n1 == n2 && t1 == t2
+  eq _                    _                    = false
+
+bimapTree :: forall a b c d. (Array String -> a -> b) -> (NonEmptyArray String ->c -> d) -> Tree a c -> Tree b d
+bimapTree g f = go []
+  where
+    go :: Array String -> Tree a c -> Tree b d
+    go namePath spec = case spec of
+      Node d xs -> Node (map (g namePath) d) (map (go namePath) xs)
+      Leaf n item -> Leaf n (map (f $ NEA.snoc' namePath n) item)
+
+instance treeBifunctor :: Bifunctor Tree where
+  bimap g f = bimapTree (const g) (const f)
+
+instance treeFoldable :: Foldable (Tree c) where
+  foldr f i (Leaf _ a) = maybe i (\a' -> f a' i) a
+  foldr f i (Node _ as) = foldr (\a i' -> foldr f i' a) i as
+  foldl f i (Leaf _ a) = maybe i (\a' -> f i a') a
+  foldl f i (Node _ as) = foldl (\i' a -> foldl f i' a) i as
+  foldMap f = foldMapDefaultL f
+
+type ActionWith m a = a -> m Unit
+
+newtype Item m a = Item
+  { isFocused :: Boolean
+  , isParallelizable :: Maybe Boolean
+  , example :: (ActionWith m a -> m Unit) -> m Unit
+  }
+
+derive instance itemNewtype :: Newtype (Item m a) _
+
+instance itemShow :: Show (Item m a) where
+  show (Item {isFocused, isParallelizable}) =
+    "Item (" <> show {isFocused, isParallelizable, example: "Function"} <> ")"
+
+instance itemEq :: Eq (Item m a) where
+  eq (Item a) (Item b) =
+    a.isFocused == b.isFocused && a.isParallelizable == b.isParallelizable
+
+-- | Count the total number of tests in a spec
+countTests :: forall c t. Array (Tree c t) -> Int
+countTests g = execState (for g go) 0
+  where
+  go (Node _ xs) = for_ xs go
+  go (Leaf _ _) = State.modify_ (_ + 1)
+
+
+-- | Return true if all items in the tree are parallelizable
+isAllParallelizable :: forall c m a. Tree c (Item m a) -> Boolean
+isAllParallelizable = case _ of
+  Node _ xs -> all isAllParallelizable xs
+  Leaf _ x -> (x >>= un Item >>> _.isParallelizable) == Just true
+
+
+-- | If there is at least one focused element, all paths which don't
+-- | lead to a focused element will be remove. otherwise input will
+-- | be returned as unchanged.
+discardUnfocused :: forall c m a. Array (Tree c (Item m a)) -> Array (Tree c (Item m a))
+discardUnfocused ts = case mapMaybe findFocus ts of
+  [] -> ts
+  r -> r
+  where
+  findFocus :: Tree c (Item m a) -> Maybe (Tree c (Item m a))
+  findFocus (Node n ts') = case mapMaybe findFocus ts' of
+    [] -> Nothing
+    r -> Just $ Node n r
+  findFocus t@(Leaf n (Just (Item { isFocused }))) = if isFocused then Just t else Nothing
+  findFocus (Leaf n Nothing) = Nothing
+
+-- | Modify around action of an Item
+modifyAroundAction :: forall g a b. (ActionWith g a -> ActionWith g b) -> Item g a -> Item g b
+modifyAroundAction action (Item item) = Item $ item
+  { example = \aroundAction -> item.example (aroundAction <<< action)
+  }
+
diff --git a/test/Main.purs b/test/Main.purs
index aac6c38..0cb6cd5 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -2,17 +2,21 @@ module Test.Main where
 
 import Prelude
 
+import Data.Identity (Identity(..))
 import Data.Maybe (Maybe(..))
+import Data.Newtype (un)
 import Effect (Effect)
 import Effect.Aff (launchAff_)
 import Test.Spec.AssertionSpec (assertionSpec)
 import Test.Spec.HoistSpec (hoistSpecSpec)
+import Test.Spec.HookSpec (hookSpec)
 import Test.Spec.Reporter (consoleReporter)
 import Test.Spec.Runner (defaultConfig, run')
 import Test.Spec.RunnerSpec (runnerSpec)
 
 main :: Effect Unit
-main = launchAff_ $ run' (defaultConfig{timeout = Nothing}) [ consoleReporter ] do
+main = launchAff_ $ un Identity $ run' (defaultConfig{timeout = Nothing}) [ consoleReporter ] do
   runnerSpec
   assertionSpec
+  hookSpec
   hoistSpecSpec
diff --git a/test/Test/Spec/Fixtures.purs b/test/Test/Spec/Fixtures.purs
index 7dd89ef..c68be93 100644
--- a/test/Test/Spec/Fixtures.purs
+++ b/test/Test/Spec/Fixtures.purs
@@ -2,70 +2,53 @@ module Test.Spec.Fixtures where
 
 import Prelude
 
-import Test.Spec            (Spec, describe, describeOnly, it, itOnly, pending)
-import Test.Spec.Assertions (shouldEqual)
+import Data.Identity (Identity)
+import Test.Spec (SpecM, describe, describeOnly, it, itOnly)
 
-successTest :: Spec Unit
+successTest :: SpecM Identity Identity Unit Unit
 successTest =
   describe "a" do
     describe "b" do
-      it "works" do
-        1 `shouldEqual` 1
+      it "works" $ pure unit
 
-sharedDescribeTest :: Spec Unit
+sharedDescribeTest :: SpecM Identity Identity Unit Unit
 sharedDescribeTest =
   describe "a" do
     describe "b" do
-      it "works" do
-        1 `shouldEqual` 1
+      it "works" $ pure unit
     describe "c" do
-      it "also works" do
-        1 `shouldEqual` 1
+      it "also works" $ pure unit
 
-duplicatedDescribeTest :: Spec Unit
+duplicatedDescribeTest :: SpecM Identity Identity Unit Unit
 duplicatedDescribeTest =
   describe "a" do
     describe "b" do
       describe "c" do
-        it "first" do
-          1 `shouldEqual` 1
+        it "first" $ pure unit
     describe "b" do
       describe "c" do
-        it "second" do
-          1 `shouldEqual` 1
+        it "second" $ pure unit
 
-describeOnlyTest :: Spec Unit
+describeOnlyTest :: SpecM Identity Identity Unit Unit
 describeOnlyTest =
   describeOnly "a" do
     describe "b" do
-      it "works" do
-        1 `shouldEqual` 1
+      it "works" $ pure unit
     describe "c" do
-      it "also works" do
-        1 `shouldEqual` 1
+      it "also works" $ pure unit
 
-describeOnlyNestedTest :: Spec Unit
+describeOnlyNestedTest :: SpecM Identity Identity Unit Unit
 describeOnlyNestedTest =
   describe "a" do
     describeOnly "b" do
-      it "works" do
-        1 `shouldEqual` 1
+      it "works" $ pure unit
     describe "c" do
-      it "also works" do
-        1 `shouldEqual` 1
+      it "also works" $ pure unit
 
-itOnlyTest :: Spec Unit
+itOnlyTest :: SpecM Identity Identity Unit Unit
 itOnlyTest =
   describe "a" do
     describe "b" do
-      itOnly "works" do
-        1 `shouldEqual` 1
+      itOnly "works" $ pure unit
     describe "c" do
-      it "also works" do
-        1 `shouldEqual` 1
-
-failureTest :: Spec Unit
-failureTest = it "fails" $ 1 `shouldEqual` 2
-
-pendingTest :: Spec Unit
-pendingTest = pending "is not written yet"
+      it "also works" $ pure unit
diff --git a/test/Test/Spec/HoistSpec.purs b/test/Test/Spec/HoistSpec.purs
index ee10ee3..4a388a0 100644
--- a/test/Test/Spec/HoistSpec.purs
+++ b/test/Test/Spec/HoistSpec.purs
@@ -4,14 +4,17 @@ import Prelude
 
 import Control.Monad.Reader (ReaderT, ask, runReaderT)
 import Control.Monad.Writer (WriterT, runWriterT, tell)
-import Data.Semigroup.Foldable (intercalate)
+import Data.Array.NonEmpty as NAE
+import Data.Identity (Identity)
 import Data.Time.Duration (Milliseconds(..))
-import Data.Traversable (for_)
+import Data.Traversable (for_, intercalate)
 import Data.Tuple (Tuple(..))
 import Effect.Aff (Aff, delay)
 import Effect.Aff.Class (liftAff)
 import Effect.Class.Console (log)
-import Test.Spec (Spec, Spec', describe, hoistSpec, hoistSpec', it, parallel)
+import Test.Spec (ComputationType(..), Spec, SpecM, describe, hoistSpec, it, parallel)
+
+type Spec' t a = SpecM Identity t Unit a
 
 hoistSpecSpec :: Spec Unit
 hoistSpecSpec = describe "hoist" do
@@ -27,7 +30,7 @@ hoistSpecSpecWriterT = go $ parallel do
     }
   where
     go :: Spec' (WriterT (Array String) Aff) ~> Spec
-    go = hoistSpec \m -> do
+    go = hoistSpec \_ m -> do
      Tuple res logMsgs <- runWriterT m
      for_ logMsgs log
      pure res
@@ -40,7 +43,12 @@ hoistSpecSpecReaderT = go $ parallel do
     }
   where
     go :: Spec' (ReaderT (String -> Aff Unit) Aff) ~> Spec
-    go = hoistSpec' \{name} m -> runReaderT m \logMsg -> log $ intercalate " > " name <> "| " <>logMsg
+    go = hoistSpec \name m ->
+      let
+        prefix = case name of
+          CleanUpWithContext n -> intercalate " > " n <> " (afterAll) "
+          TestWithName n -> intercalate " > " $ NAE.toArray n
+      in runReaderT m \logMsg -> log $ prefix  <> "| " <> logMsg
 
 delaySpecExample
   :: forall m
@@ -54,23 +62,25 @@ delaySpecExample opts = describe "delay" do
     opts.log "start 1"
     opts.delay $ Milliseconds $ 500.0 + 300.0 * 1.0
     opts.log "done 1"
-  it "proc 2" do
-    opts.log "start 2"
-    opts.delay $ Milliseconds $ 500.0 + 300.0 * 2.0
-    opts.log "done 2"
-  it "proc 3" do
-    opts.log "start 3"
-    opts.delay $ Milliseconds $ 500.0 + 300.0 * 3.0
-    opts.log "done 3"
-  it "proc 4" do
-    opts.log "start 4"
-    opts.delay $ Milliseconds $ 500.0 + 300.0 * 4.0
-    opts.log "done 4"
-  it "proc 5" do
-    opts.log "start 5"
-    opts.delay $ Milliseconds $ 500.0 + 300.0 * 5.0
-    opts.log "done 5"
-  it "proc 6" do
-    opts.log "start 6"
-    opts.delay $ Milliseconds $ 500.0 + 300.0 * 6.0
-    opts.log "done 6"
\ No newline at end of file
+  describe "some" do
+    it "proc 2" do
+      opts.log "start 2"
+      opts.delay $ Milliseconds $ 500.0 + 300.0 * 2.0
+      opts.log "done 2"
+    it "proc 3" do
+      opts.log "start 3"
+      opts.delay $ Milliseconds $ 500.0 + 300.0 * 3.0
+      opts.log "done 3"
+    describe "nesting" do
+      it "proc 4" do
+        opts.log "start 4"
+        opts.delay $ Milliseconds $ 500.0 + 300.0 * 4.0
+        opts.log "done 4"
+      it "proc 5" do
+        opts.log "start 5"
+        opts.delay $ Milliseconds $ 500.0 + 300.0 * 5.0
+        opts.log "done 5"
+      it "proc 6" do
+        opts.log "start 6"
+        opts.delay $ Milliseconds $ 500.0 + 300.0 * 6.0
+        opts.log "done 6"
\ No newline at end of file
diff --git a/test/Test/Spec/HookSpec.purs b/test/Test/Spec/HookSpec.purs
new file mode 100644
index 0000000..bd8b0ba
--- /dev/null
+++ b/test/Test/Spec/HookSpec.purs
@@ -0,0 +1,26 @@
+module Test.Spec.HookSpec where
+
+import Prelude
+
+import Test.Spec (Spec, after, aroundWith, before, beforeWith, describe, it)
+import Test.Spec.Assertions (shouldEqual)
+
+hookSpec :: Spec Unit
+hookSpec = do
+  describe "Test" do
+    describe "Spec" do
+      describe "hooks" do
+        it "a regular test case" do
+          1 `shouldEqual` 1
+        before (pure 1) $ after (\a -> a `shouldEqual` 1) do
+          it "before & after usage" \num -> do
+            num `shouldEqual` 1
+          beforeWith (\num -> num `shouldEqual` 1 *> pure true) do
+            it "beforeWith usage" \bool -> do
+              bool `shouldEqual` true
+            aroundWith (\computation bool -> bool `shouldEqual` true *> pure "fiz" >>= computation <* pure unit) do
+              it "aroundWith usage" \str -> do
+                str `shouldEqual` "fiz"
+          beforeWith (\num -> num `shouldEqual` 1 *> pure (show num)) do
+            it "beforeWith" \str -> do
+              str `shouldEqual` "1"
diff --git a/test/Test/Spec/RunnerSpec.purs b/test/Test/Spec/RunnerSpec.purs
index f873923..0ad8392 100644
--- a/test/Test/Spec/RunnerSpec.purs
+++ b/test/Test/Spec/RunnerSpec.purs
@@ -1,12 +1,18 @@
 module Test.Spec.RunnerSpec where
 
 import Prelude
+
+import Control.Monad.Writer (execWriter)
+import Data.Bifunctor (bimap)
+import Data.Either (Either(..))
+import Data.Maybe (Maybe(..))
+import Data.Newtype (un)
 import Data.Time.Duration (Milliseconds(..))
 import Effect.Aff (delay)
-import Test.Spec (Group(..), Result(..), Spec, describe, it)
+import Test.Spec (Item(..), Spec, Tree(..), describe, it)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Spec.Fixtures (itOnlyTest, describeOnlyNestedTest, describeOnlyTest, sharedDescribeTest, successTest)
-import Test.Spec.Runner (runSpec)
+import Test.Spec.Tree (discardUnfocused)
 
 runnerSpec :: Spec Unit
 runnerSpec =
@@ -14,22 +20,39 @@ runnerSpec =
     describe "Spec" $
       describe "Runner" do
         it "collects \"it\" and \"pending\" in Describe groups" do
-          results <- runSpec successTest
-          results `shouldEqual` [Describe false "a" [Describe false "b" [It false "works" Success]]]
+          runSpecFocused successTest `shouldEqual` 
+            [ Node (Left "a") 
+              [ Node (Left "b") [ Leaf "works" $ Just false ]
+              ]
+            ]
         it "collects \"it\" and \"pending\" with shared Describes" do
-          results <- runSpec sharedDescribeTest
-          results `shouldEqual` [Describe false "a" [Describe false "b" [It false "works" Success],
-                                                     Describe false "c" [It false "also works" Success]]]
+          runSpecFocused sharedDescribeTest `shouldEqual` 
+            [ Node (Left "a") 
+              [ Node (Left "b") [ Leaf "works" $ Just false ]
+              , Node (Left "c") [ Leaf "also works" $ Just false ]
+              ]
+            ]
         it "filters using \"only\" modifier on \"describe\" block" do
-          results <- runSpec describeOnlyTest
-          results `shouldEqual` [Describe true "a" [Describe false "b" [It false "works" Success],
-                                                    Describe false "c" [It false "also works" Success]]]
+          runSpecFocused describeOnlyTest `shouldEqual` 
+            [ Node (Left "a") 
+              [ Node (Left "b") [ Leaf "works" $ Just true ]
+              , Node (Left "c") [ Leaf "also works" $ Just true ]
+              ]
+            ]
         it "filters using \"only\" modifier on nested \"describe\" block" do
-          results <- runSpec describeOnlyNestedTest
-          results `shouldEqual` [Describe true "b" [It false "works" Success]]
+          runSpecFocused describeOnlyNestedTest `shouldEqual` 
+            [ Node (Left "a") 
+              [ Node (Left "b") [ Leaf "works" $ Just true ]
+              ]
+            ]
         it "filters using \"only\" modifier on \"it\" block" do
-          results <- runSpec itOnlyTest
-          results `shouldEqual` [It true "works" Success]
+          runSpecFocused itOnlyTest `shouldEqual` 
+            [ Node (Left "a") 
+              [ Node (Left "b") [ Leaf "works" $ Just true ]
+              ]
+            ]
         it "supports async" do
           res <- delay (Milliseconds 10.0) *> pure 1
           res `shouldEqual` 1
+  where
+    runSpecFocused t = discardUnfocused (execWriter t) <#> bimap (const unit) (un Item >>> _.isFocused)
\ No newline at end of file

From 2ad5c0c66040617b4ba3b27eef37f4bcace32a3e Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Fri, 11 Jan 2019 11:21:06 +0400
Subject: [PATCH 08/39] moved Aff tests into Predicates

as they are not Aff specific any more
---
 test/Test/Spec/AssertionSpec.purs | 44 +++++++++++++++----------------
 1 file changed, 21 insertions(+), 23 deletions(-)

diff --git a/test/Test/Spec/AssertionSpec.purs b/test/Test/Spec/AssertionSpec.purs
index f5dad18..18e2de9 100644
--- a/test/Test/Spec/AssertionSpec.purs
+++ b/test/Test/Spec/AssertionSpec.purs
@@ -51,26 +51,6 @@ assertionSpec =
             it "rejects values where predicate returns true" $
               A.expectError $ 3 `A.shouldNotSatisfy` (_ > 2)
 
-        describe "Foldable" do
-          describe "for some foldable" do
-            let f = ["haha", "nono"]
-            let contained = "nono"
-            let notcontained = "zzz"
-
-            describe "shouldContain" do
-              it "accepts f that contains a" $
-                f `A.shouldContain` contained
-              it "rejects f that does not contain a" $
-                A.expectError $ f `A.shouldContain` notcontained
-
-            describe "shouldNotContain" do
-              it "accepts f that does not contain a" $
-                f `A.shouldNotContain` notcontained
-              it "rejects f that contains a" $
-                A.expectError $ f `A.shouldNotContain` contained
-
-
-        describe "Aff" do
           let contained = "nono"
               notcontained = "zzz"
               f = pure contained
@@ -82,13 +62,31 @@ assertionSpec =
               A.expectError $ A.expectError $ pure "ok"
 
           describe "shouldReturn" do
-            it "accepts that `Aff String` contains \"nono\"" $
+            it "accepts that `m String` contains \"nono\"" $
               f `A.shouldReturn` contained
-            it "rejects that `Aff String` contains \"zzz\"" $
+            it "rejects that `m String` contains \"zzz\"" $
               A.expectError $ f `A.shouldReturn` notcontained
 
           describe "shouldNotReturn" do
             it "accepts f does not contain \"zzz\"" $
               f `A.shouldNotReturn` notcontained
-            it "rejects that `Aff String` does not contain \"zzz\"" $
+            it "rejects that `m String` does not contain \"zzz\"" $
               A.expectError $ f `A.shouldNotReturn` contained
+
+        describe "Foldable" do
+          describe "for some foldable" do
+            let f = ["haha", "nono"]
+            let contained = "nono"
+            let notcontained = "zzz"
+
+            describe "shouldContain" do
+              it "accepts f that contains a" $
+                f `A.shouldContain` contained
+              it "rejects f that does not contain a" $
+                A.expectError $ f `A.shouldContain` notcontained
+
+            describe "shouldNotContain" do
+              it "accepts f that does not contain a" $
+                f `A.shouldNotContain` notcontained
+              it "rejects f that contains a" $
+                A.expectError $ f `A.shouldNotContain` contained

From b356736707a32e7feaa8d573857a82d602421056 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Fri, 11 Jan 2019 12:32:40 +0400
Subject: [PATCH 09/39] add Path to Runner.Events

now consoleReporter and specReporter need to coordinate tests which are running in parallel
---
 src/Test/Spec/Reporter/Console.purs | 11 ++--
 src/Test/Spec/Reporter/Dot.purs     | 10 ++--
 src/Test/Spec/Reporter/Spec.purs    | 11 ++--
 src/Test/Spec/Reporter/Tap.purs     |  9 ++--
 src/Test/Spec/Runner.purs           | 84 +++++++++++++++--------------
 src/Test/Spec/Runner/Event.purs     | 35 +++++++-----
 6 files changed, 86 insertions(+), 74 deletions(-)

diff --git a/src/Test/Spec/Reporter/Console.purs b/src/Test/Spec/Reporter/Console.purs
index 3359e26..ac3cb2d 100644
--- a/src/Test/Spec/Reporter/Console.purs
+++ b/src/Test/Spec/Reporter/Console.purs
@@ -44,14 +44,15 @@ popCrumb s = s {
 consoleReporter :: Reporter
 consoleReporter = defaultReporter initialState update
   where
+  -- TODO coordinate events when multiple test/suites are running in parallel
   update s = case _ of
-    Event.Suite name -> pure (pushCrumb name s)
-    Event.SuiteEnd -> pure (popCrumb s)
-    Event.Pass name _ _ -> flushCrumbs do
+    Event.Suite path name -> pure (pushCrumb name s)
+    Event.SuiteEnd path -> pure (popCrumb s)
+    Event.Pass path name _ _ -> flushCrumbs do
       log $ "  " <> (colored Color.Checkmark "✓︎" <> " " <> colored Color.Pass name)
-    Event.Pending name -> flushCrumbs do
+    Event.Pending path name -> flushCrumbs do
       log $ "  " <> (colored Color.Pending $ "~ " <> name)
-    Event.Fail name msg _ -> flushCrumbs do
+    Event.Fail path name msg _ -> flushCrumbs do
       log $ "  " <> (colored Color.Fail $ "✗ " <> name <> ":")
       log ""
       log $ colored Color.Fail $ "  " <> msg
diff --git a/src/Test/Spec/Reporter/Dot.purs b/src/Test/Spec/Reporter/Dot.purs
index a3bdda6..57568e3 100644
--- a/src/Test/Spec/Reporter/Dot.purs
+++ b/src/Test/Spec/Reporter/Dot.purs
@@ -18,13 +18,13 @@ dotReporter { width } =
 
   where
     update n = case _ of
-      Event.Pass _ speed ms ->
+      Event.Pass _ _ speed ms ->
         let col = Speed.toColor speed
         in wrap $ Console.write (colored col ".")
-      Event.Fail _ _ _ -> wrap $ Console.write (colored Color.Fail "!")
-      Event.Pending _  -> wrap $ Console.write (colored Color.Pass ",")
-      Event.End _      -> n <$ Console.write "\n"
-      _                -> pure n
+      Event.Fail _ _ _ _ -> wrap $ Console.write (colored Color.Fail "!")
+      Event.Pending _ _ -> wrap $ Console.write (colored Color.Pass ",")
+      Event.End _ -> n <$ Console.write "\n"
+      _ -> pure n
 
       where
         wrap action =
diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index f3741bb..1920ab3 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -16,13 +16,14 @@ specReporter :: Reporter
 specReporter
   = defaultReporter { indent: 0, numFailures: 0 } update
  where
+  -- TODO coordinate events when multiple test/suites are running in parallel
   update s = case _ of
     Event.Start _ -> s <$ log ""
-    Event.Suite name -> modIndent (_ + 1) $ \_ -> _log name
-    Event.SuiteEnd   -> modIndent (_ - 1) $ \i -> when (i == 1) (log "")
-    Event.Pending name -> s <$ do
+    Event.Suite path name -> modIndent (_ + 1) $ \_ -> _log name
+    Event.SuiteEnd path   -> modIndent (_ - 1) $ \i -> when (i == 1) (log "")
+    Event.Pending path name -> s <$ do
       _log $ colored Color.Pending $ "- " <> name
-    Event.Pass name speed ms -> s <$ do
+    Event.Pass path name speed ms -> s <$ do
       _log $ colored Color.Checkmark "✓︎"
               <> " "
               <> colored Color.Pass name
@@ -33,7 +34,7 @@ specReporter
                           label = " (" <> show ms <> "ms)"
                       in colored col label
 
-    Event.Fail name _ _ ->
+    Event.Fail path name _ _ ->
       let s' = s { numFailures = s.numFailures + 1 }
        in s' <$ (_log $ colored Color.Fail $ show s'.numFailures <> ") " <> name)
 
diff --git a/src/Test/Spec/Reporter/Tap.purs b/src/Test/Spec/Reporter/Tap.purs
index d195e8b..c1f4877 100644
--- a/src/Test/Spec/Reporter/Tap.purs
+++ b/src/Test/Spec/Reporter/Tap.purs
@@ -22,12 +22,12 @@ tapReporter =
  where
   update n = case _ of
     Event.Start nTests -> n <$ (log $ "1.." <> show nTests)
-    Event.TestEnd -> pure (n + 1)
-    Event.Pending name -> n <$ log do
+    Event.TestEnd _ -> pure (n + 1)
+    Event.Pending _ name -> n <$ log do
       "ok " <> show n <> " " <> (escTitle name) <> " # SKIP -"
-    Event.Pass name _ _ -> n <$ log do
+    Event.Pass _ name _ _ -> n <$ log do
       "ok " <> show n <> " " <> (escTitle name)
-    Event.Fail name msg mStack -> n <$ do
+    Event.Fail _ name msg mStack -> n <$ do
       log $ "not ok " <> show n <> " " <> (escTitle name)
       log $ escMsg msg
       case mStack of
@@ -40,7 +40,6 @@ tapReporter =
           log $ "# pass "  <> show (passed + pending)
           log $ "# fail "  <> show failed
       pure n
-
     _ -> pure n
 
 -- create a TAP-safe title
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index c5dcf4d..35ca60c 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -16,7 +16,7 @@ import Control.Alternative ((<|>))
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Writer (execWriterT)
 import Control.Parallel (parTraverse, parallel, sequential)
-import Data.Array (groupBy)
+import Data.Array (groupBy, mapWithIndex)
 import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Array.NonEmpty as NEA
 import Data.Either (Either(..), either)
@@ -27,7 +27,7 @@ import Data.Maybe (Maybe(..))
 import Data.Newtype (un)
 import Data.Time.Duration (Milliseconds(..))
 import Data.Traversable (class Traversable, for)
-import Data.Tuple (Tuple(..), fst, snd)
+import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Aff (Aff, attempt, delay, forkAff, joinFiber, makeAff, throwError, try)
 import Effect.Aff.AVar as AV
@@ -79,6 +79,7 @@ timeout time t = do
   sequential (parallel (try (makeTimeout time)) <|> parallel (try t))
     >>= either throwError pure
 
+type TestWithPath r = {test :: SpecTree Aff Unit, path :: Event.Path | r}
 
 -- Run the given spec as `Producer` in the underlying `Aff` monad.
 -- This producer has two responsibilities:
@@ -95,53 +96,56 @@ _run
   -> m (Producer Event Aff (Array (Tree Void Result)))
 _run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
   yield (Event.Start (countTests tests))
-  r <- loop tests
+  let
+    indexer index test = {test, path: [Event.PathItem {name: Nothing, index}]}
+  r <- loop $ mapWithIndex indexer tests
   yield (Event.End r)
   pure r
   where
-    loop :: Array (SpecTree Aff Unit) -> Producer Event Aff (Array (Tree Void Result))
+    loop :: Array (TestWithPath ()) -> Producer Event Aff (Array (Tree Void Result))
     loop tests =
       let
-        marked :: Array (Tuple Boolean (SpecTree Aff Unit))
-        marked = tests <#> \t -> Tuple (isAllParallelizable t) t
-        grouped' :: Array (NonEmptyArray (Tuple Boolean (SpecTree Aff Unit)))
-        grouped' = groupBy (\a b -> fst a && fst b) marked
-        grouped :: Array (Tuple Boolean (Array (SpecTree Aff Unit)))
-        grouped = grouped' <#> \g -> Tuple (fst $ NEA.head g) $ snd <$> NEA.toArray g
+        marked :: Array (TestWithPath (isParallelizable :: Boolean))
+        marked = tests <#> \{test,path} -> {isParallelizable: isAllParallelizable test, test, path}
+        grouped' :: Array (NonEmptyArray (TestWithPath (isParallelizable :: Boolean)))
+        grouped' = groupBy (\a b -> a.isParallelizable && b.isParallelizable) marked
+        grouped :: Array (Tuple Boolean (Array (TestWithPath ())))
+        grouped = grouped' <#> \g -> Tuple ((NEA.head g).isParallelizable) $ (\{test,path} -> {test,path}) <$> NEA.toArray g
       in join <$> for grouped \(Tuple isParallelizable xs) -> join <$> if isParallelizable
         then mergeProducers (runGroup <$> xs)
         else for xs runGroup
 
-    runGroup :: SpecTree Aff Unit -> Producer Event Aff (Array (Tree Void Result))
-    runGroup (Leaf name (Just (Item item))) = do
-      yield Event.Test
-      let test = item.example \a -> a unit
-      start <- lift $ liftEffect dateNow
-      e <- lift $ attempt case config.timeout of
-        Just t -> timeout t test
-        _      -> test
-      duration <- lift $ (_ - start) <$> liftEffect dateNow
-      yield $ either
-        (\err ->
-          let msg = Error.message err
-              stack = Error.stack err
-          in Event.Fail name msg stack)
-        (const $ Event.Pass name (speedOf config.slow duration) duration)
-        e
-      yield Event.TestEnd
-      pure [ Leaf name $ Just $ either Failure (const Success) e ]
-
-    runGroup (Leaf name Nothing) = do
-      yield $ Event.Pending name
-      pure [ Leaf name Nothing ]
-
-    runGroup (Node (Right cleanup) xs) = do
-      loop xs <* lift (cleanup unit)
-    runGroup (Node (Left name) xs) = do
-      yield $ Event.Suite name
-      res <- loop xs
-      yield Event.SuiteEnd
-      pure [ Node (Left name) res ]
+    runGroup :: forall r. TestWithPath r -> Producer Event Aff (Array (Tree Void Result))
+    runGroup {test, path} = case test of
+      (Leaf name (Just (Item item))) -> do
+        yield $ Event.Test path
+        let example = item.example \a -> a unit
+        start <- lift $ liftEffect dateNow
+        e <- lift $ attempt case config.timeout of
+          Just t -> timeout t example
+          _      -> example
+        duration <- lift $ (_ - start) <$> liftEffect dateNow
+        yield $ either
+          (\err ->
+            let msg = Error.message err
+                stack = Error.stack err
+            in Event.Fail path name msg stack)
+          (const $ Event.Pass path name (speedOf config.slow duration) duration)
+          e
+        yield $ Event.TestEnd path
+        pure [ Leaf name $ Just $ either Failure (const Success) e ]
+      (Leaf name Nothing) -> do
+        yield $ Event.Pending path name
+        pure [ Leaf name Nothing ]
+      (Node (Right cleanup) xs) -> do
+        let indexer index x = {test:x, path: path <> [Event.PathItem {name: Nothing, index}]}
+        loop (mapWithIndex indexer xs) <* lift (cleanup unit)
+      (Node (Left name) xs) -> do
+        yield $ Event.Suite path name
+        let indexer index x = {test:x, path: path <> [Event.PathItem {name: Just name, index}]}
+        res <- loop (mapWithIndex indexer xs)
+        yield $ Event.SuiteEnd path
+        pure [ Node (Left name) res ]
 
 -- https://github.com/felixSchl/purescript-pipes/issues/16
 mergeProducers :: forall t o a. Traversable t => t (Producer o Aff a) -> Producer o Aff (t a)
diff --git a/src/Test/Spec/Runner/Event.purs b/src/Test/Spec/Runner/Event.purs
index 4b6575e..332d881 100644
--- a/src/Test/Spec/Runner/Event.purs
+++ b/src/Test/Spec/Runner/Event.purs
@@ -12,28 +12,35 @@ type Duration = Int
 type NumberOfTests = Int
 type Stack = String
 
+newtype PathItem = PathItem { name :: Maybe String, index :: Int}
+
+derive newtype instance showIdTerm :: Show PathItem
+derive newtype instance eqIdTerm :: Eq PathItem
+
+type Path = Array PathItem
+
 data Event
   = Start NumberOfTests
-  | Suite Name
-  | Test
-  | TestEnd
-  | SuiteEnd
-  | Fail Name Message (Maybe Stack)
-  | Pass Name Speed Duration
-  | Pending Name
+  | Suite Path Name
+  | Test Path
+  | TestEnd Path
+  | SuiteEnd Path
+  | Fail Path Name Message (Maybe Stack)
+  | Pass Path Name Speed Duration
+  | Pending Path Name
   | End (Array (Tree Void Result))
 
 instance showEvent :: Show Event where
   show =
     case _ of
       Start n -> "Start " <> show n
-      Suite name ->  "Suite " <> name
-      Test -> "Test"
-      TestEnd -> "TestEnd"
-      SuiteEnd -> "SuiteEnd"
-      Fail name msg _ -> "Fail " <> name <> ": " <> msg
-      Pass name speed duration -> "Pass " <> name <> " "
+      Suite path name -> "Suite " <> show path <> ": " <> name
+      Test path -> "Test " <> show path
+      TestEnd path -> "TestEnd " <> show path
+      SuiteEnd path -> "SuiteEnd " <> show path
+      Fail path name msg _ -> "Fail " <> show path <> " " <> name <> ": " <> msg
+      Pass path name speed duration -> "Pass " <> show path <> " " <> name <> " "
                                   <> show speed <> " "
                                   <> show duration
-      Pending name -> "Pending " <> name
+      Pending path name -> "Pending " <> show path <> " " <> name
       End results -> "End " <> show results

From 12168c837431934a8afafd0959463d8564548381 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Mon, 14 Jan 2019 15:34:31 +0400
Subject: [PATCH 10/39] adopt ConsoleReporter to parallel execution

---
 .editorconfig                       |   9 ++
 src/Test/Spec.purs                  |  16 +--
 src/Test/Spec/Console.js            |  27 ++--
 src/Test/Spec/Console.purs          |  31 ++++-
 src/Test/Spec/Reporter/Console.purs | 194 +++++++++++++++++-----------
 src/Test/Spec/Reporter/Dot.purs     |   8 +-
 src/Test/Spec/Reporter/Spec.purs    |   2 +-
 src/Test/Spec/Reporter/Tap.purs     |  19 +--
 src/Test/Spec/Runner.purs           |  43 +++---
 src/Test/Spec/Runner/Event.purs     |  21 +--
 src/Test/Spec/Tree.purs             |  29 ++++-
 test/Main.purs                      |  31 ++++-
 test/Test/Spec/HoistSpec.purs       |  43 +++---
 13 files changed, 281 insertions(+), 192 deletions(-)
 create mode 100644 .editorconfig

diff --git a/.editorconfig b/.editorconfig
new file mode 100644
index 0000000..52494a4
--- /dev/null
+++ b/.editorconfig
@@ -0,0 +1,9 @@
+# editorconfig.org
+
+[*]
+indent_style = space
+indent_size = 2
+end_of_line = lf
+charset = utf-8
+trim_trailing_whitespace = true
+insert_final_newline = true
diff --git a/src/Test/Spec.purs b/src/Test/Spec.purs
index 6383dac..03d4e77 100644
--- a/src/Test/Spec.purs
+++ b/src/Test/Spec.purs
@@ -9,10 +9,10 @@ module Test.Spec
   , hoistSpec
 
   , Result(..)
-  
+
   , class Example
   , evaluateExample
-  
+
   , parallel
   , sequential
 
@@ -20,12 +20,12 @@ module Test.Spec
   , focus
   , describeOnly
   , itOnly
-  
+
   , describe
   , it
   , pending
   , pending'
-  
+
   , aroundWith
   , around
   , around_
@@ -35,7 +35,7 @@ module Test.Spec
   , beforeWith
   , beforeAll
   , beforeAll_
-  
+
   , after
   , after_
   , afterAll
@@ -76,7 +76,7 @@ type SpecTree m a = Tree (ActionWith m a) (Item m a)
 mapSpecTree
   :: forall m g g' i a i'
    . Monad m
-   => (SpecTree g i -> SpecTree g' i') 
+   => (SpecTree g i -> SpecTree g' i')
    -> SpecM m g i a
    -> SpecM m g' i' a
 mapSpecTree f = mapWriterT $ map $ map $ map f
@@ -250,7 +250,7 @@ around_ action = aroundWith $ \e a -> action (e a)
 -- | Run a custom action after every spec item.
 after :: forall m g e f i a. Monad m => MonadBracket e f g => ActionWith g i -> SpecM m g i a -> SpecM m g i a
 after action = aroundWith $ \e x -> e x `finally` action x
-  where 
+  where
   finally :: forall x. g x -> g Unit -> g x
   finally act fin = bracket (pure unit) (\_ _ -> fin) (const act)
 
@@ -307,4 +307,4 @@ afterAll action = mapWriterT $ map $ map \group -> [Node (Right action) group]
 
 -- | Run a custom action after the last spec item.
 afterAll_ :: forall m g i a. Monad m => g Unit -> SpecM m g i a -> SpecM m g i a
-afterAll_ action = afterAll $ const action
\ No newline at end of file
+afterAll_ action = afterAll $ const action
diff --git a/src/Test/Spec/Console.js b/src/Test/Spec/Console.js
index d36b994..0dc3ec6 100644
--- a/src/Test/Spec/Console.js
+++ b/src/Test/Spec/Console.js
@@ -3,24 +3,19 @@
 
 // module Test.Spec.Console
 
-function hasProcessWrite() {
-  try {
-    return process &&
-        process.stdout &&
-        typeof process.stdout.write === 'function'
-  }
-  catch(e) {
-    return false
-  }
-}
-
 exports.write = function(s) {
   return function () {
-    if (hasProcessWrite()) {
-      try {
-        process.stdout.write(s);
-      }
-      catch (e) {}
+    try {
+      process.stdout.write(s);
     }
+    catch (e) {}
   };
 };
+
+exports.moveUpAndClearLine = function() {
+  try {
+    process.stderr.moveCursor(0, -1);
+    process.stderr.clearLine(0);
+  }
+  catch (e) {}
+};
diff --git a/src/Test/Spec/Console.purs b/src/Test/Spec/Console.purs
index 1cbb580..4e9853f 100644
--- a/src/Test/Spec/Console.purs
+++ b/src/Test/Spec/Console.purs
@@ -3,24 +3,41 @@ module Test.Spec.Console
   , reset
   , withAttrs
   , write
+  , logWriter
+  , moveUpAndClearLine
   ) where
 
 import Prelude
 
 import Ansi.Codes (colorSuffix, prefix)
-import Effect (Effect)
+import Control.Monad.Writer (class MonadWriter, Writer, execWriter, tell)
 import Data.Foldable (foldr)
+import Effect (Effect)
 
 foreign import write :: String -> Effect Unit
+foreign import moveUpAndClearLine :: Effect Unit
+
+logWriter :: Writer String Unit -> Effect Unit
+logWriter = execWriter >>> write
 
-setAttr :: Int -> Effect Unit
-setAttr code = write (prefix <> show code <> colorSuffix)
+setAttr
+  :: forall m
+   . MonadWriter String m
+  => Int
+  -> m Unit
+setAttr code = tell $ prefix <> show code <> colorSuffix
 
-reset :: Effect Unit
+reset
+  :: forall m
+   . MonadWriter String m
+  => m Unit
 reset = setAttr 0
 
-withAttrs :: (Array Int)
-          -> Effect Unit
-          -> Effect Unit
+withAttrs
+  :: forall m
+   . MonadWriter String m
+  => Array Int
+  -> m Unit
+  -> m Unit
 withAttrs as r = foldr iter r as
   where iter attr acc = setAttr attr *> acc *> reset
diff --git a/src/Test/Spec/Reporter/Console.purs b/src/Test/Spec/Reporter/Console.purs
index ac3cb2d..4327b9d 100644
--- a/src/Test/Spec/Reporter/Console.purs
+++ b/src/Test/Spec/Reporter/Console.purs
@@ -2,92 +2,140 @@ module Test.Spec.Reporter.Console (consoleReporter) where
 
 import Prelude
 
-import Data.Array (init)
-import Data.Foldable (intercalate)
-import Data.Maybe (fromMaybe)
-import Effect (Effect)
-import Effect.Console (log)
+import Control.Monad.State (execStateT, get, lift, put)
+import Control.Monad.Writer (class MonadWriter, execWriter, tell)
+import Data.Array (all, foldMap, groupBy, length, mapMaybe, null, replicate, sortBy)
+import Data.Array.NonEmpty as NEA
+import Data.Foldable (for_, intercalate, sequence_)
+import Data.Function (on)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
+import Data.Maybe (Maybe(..), isJust)
+import Data.String (split, Pattern(..))
+import Effect.Exception as Error
+import Test.Spec (Result(..))
+import Test.Spec.Tree (Tree, Path, parentSuiteName, removeLastIndex)
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
-import Test.Spec.Console (withAttrs)
+import Test.Spec.Console (moveUpAndClearLine, logWriter, withAttrs)
 import Test.Spec.Reporter.Base (defaultReporter)
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Summary (Summary(..))
 import Test.Spec.Summary as Summary
 
-type ConsoleReporterStateObj = {
-  crumbs :: Array String
-, crumbsChanged :: Boolean
-, hasEmitted :: Boolean
-}
-
-initialState :: ConsoleReporterStateObj
-initialState = {
-  crumbs: []
-, crumbsChanged: false
-, hasEmitted: false
-}
-
-pushCrumb :: String -> ConsoleReporterStateObj -> ConsoleReporterStateObj
-pushCrumb c s = s {
-  crumbs = s.crumbs <> [c]
-, crumbsChanged = true
-}
-
-popCrumb :: ConsoleReporterStateObj -> ConsoleReporterStateObj
-popCrumb s = s {
-  crumbs = fromMaybe [] $ init s.crumbs
-, crumbsChanged = true
-}
+data RunningItem
+  = RunningTest Path String (Maybe Result)
+  | PendingTest Path String
+  | RunningSuite Path String Boolean
+
+runningItemPath :: RunningItem -> Path
+runningItemPath = case _ of
+  RunningTest p _ _ -> p
+  PendingTest p _ -> p
+  RunningSuite p _ _ -> p
+
+derive instance runningItemGeneric :: Generic RunningItem _
+instance runningItemShow :: Show RunningItem where show = genericShow
+
+initialState :: Array RunningItem
+initialState = []
 
 consoleReporter :: Reporter
-consoleReporter = defaultReporter initialState update
+consoleReporter = defaultReporter initialState $ flip update
+  where
+  update = execStateT <<< case _ of
+    Event.Suite path name -> do
+      modifyRunningItems (_ <> [RunningSuite path name false])
+    Event.SuiteEnd path -> do
+      modifyRunningItems $ map case _ of
+        RunningSuite p n _ | p == path -> RunningSuite p n true
+        a -> a
+    Event.Test path name -> do
+      modifyRunningItems (_ <> [RunningTest path name Nothing])
+    Event.Pass path name _ _ -> do
+      modifyRunningItems $ updateRunningTestResult path $ Success
+    Event.Pending path name -> do
+      modifyRunningItems (_ <> [PendingTest path name])
+    Event.Fail path name err -> do
+      modifyRunningItems $ updateRunningTestResult path $ Failure err
+    Event.End results -> lift $ logWriter $ printSummary results
+    Event.Start _ -> pure unit
+
+  updateRunningTestResult path res = map case _ of
+    RunningTest p n _ | p == path -> RunningTest p n $ Just res
+    a -> a
+
+  modifyRunningItems f = do
+    currentRunningItems <- get
+    let nextRunningItems = f currentRunningItems
+    put if allRunningItemsAreFinished nextRunningItems then [] else nextRunningItems
+    unless (null currentRunningItems) do
+      let c = lineCount $ execWriter $ writeRunningItems currentRunningItems
+      lift $ sequence_ $ replicate c moveUpAndClearLine
+    lift $ logWriter $ writeRunningItems nextRunningItems
+    where
+      lineCount str = length (split (Pattern "\n") str) - 1
+      allRunningItemsAreFinished = all case _ of
+        PendingTest _ _ -> true
+        RunningTest _ _ res -> isJust res
+        RunningSuite _ _ finished -> finished
+
+  writeRunningItems :: forall m. MonadWriter String m => Array RunningItem -> m Unit
+  writeRunningItems runningItems = do
+    for_ (groupeBySuite $ sortByPath $ removeSuitesNodes runningItems) \g -> do
+      logCrumbs (parentSuiteName $ runningItemPath $ NEA.head g)
+      for_ (NEA.toArray g ) case _ of
+        PendingTest _ name -> tell $ asLine
+          [ "  " <> (colored Color.Pending $ "~ " <> name)
+          ]
+        RunningTest _ name Nothing -> tell $ asLine
+          [ "  " <> colored Color.Pending "⥀ " <> name
+          ]
+        RunningTest _ name (Just Success) -> tell $ asLine
+          [ "  " <> colored Color.Checkmark "✓︎ " <> colored Color.Pass name
+          ]
+        RunningTest _ name (Just (Failure err)) -> tell $ asLine
+          [ "  " <> colored Color.Fail ("✗ " <> name <> ":")
+          , ""
+          , "  " <> colored Color.Fail (Error.message err)
+          ]
+        RunningSuite _ _ _ -> pure unit
+    where
+      removeSuitesNodes = mapMaybe case _ of
+        RunningSuite _ _ _ -> Nothing
+        a -> Just a
+      sortByPath = sortBy \a b -> on compare (runningItemPath) a b
+      groupeBySuite = groupBy (on (==) $ runningItemPath >>> removeLastIndex)
+
+
+printSummary :: forall m. MonadWriter String m => Array (Tree Void Result) -> m Unit
+printSummary = Summary.summarize >>> \(Count {passed, failed, pending}) -> do
+  tell $ asLine [""]
+  withAttrs [1] $ tell $ asLine ["Summary"]
+  printPassedFailed passed failed
+  printPending pending
+  tell $ asLine [""]
   where
-  -- TODO coordinate events when multiple test/suites are running in parallel
-  update s = case _ of
-    Event.Suite path name -> pure (pushCrumb name s)
-    Event.SuiteEnd path -> pure (popCrumb s)
-    Event.Pass path name _ _ -> flushCrumbs do
-      log $ "  " <> (colored Color.Checkmark "✓︎" <> " " <> colored Color.Pass name)
-    Event.Pending path name -> flushCrumbs do
-      log $ "  " <> (colored Color.Pending $ "~ " <> name)
-    Event.Fail path name msg _ -> flushCrumbs do
-      log $ "  " <> (colored Color.Fail $ "✗ " <> name <> ":")
-      log ""
-      log $ colored Color.Fail $ "  " <> msg
-    Event.End results -> s <$ printSummary results
-    _ -> pure s
-      where
-      flushCrumbs action =
-        if not s.crumbsChanged
-           then s <$ action
-           else s { crumbsChanged = false, hasEmitted = true } <$ do
-            when s.hasEmitted $ log ""
-            withAttrs [1, 35] $ log $ intercalate " » " s.crumbs
-            action
-
-      printSummary = Summary.summarize >>> \(Count {passed, failed, pending}) -> do
-        log ""
-        withAttrs [1] $ log "Summary"
-        printPassedFailed passed failed
-        printPending pending
-        log ""
+    printPassedFailed :: Int -> Int -> m Unit
+    printPassedFailed p f = do
+      let total = p + f
+          testStr = pluralize "test" total
+          amount = show p <> "/" <> (show total) <> " " <> testStr <> " passed"
+          attrs = if f > 0 then [31] else [32]
+      withAttrs attrs $ tell $ asLine [amount]
 
+    printPending :: Int -> m Unit
+    printPending p
+      | p > 0     = withAttrs [33] $ tell $ asLine [show p <> " " <> pluralize "test" p <> " pending"]
+      | otherwise = pure unit
+
+logCrumbs :: forall m. MonadWriter String m => Array String -> m Unit
+logCrumbs crumbs = withAttrs [1, 35] $ tell $ asLine [intercalate " » " crumbs]
+
+asLine :: Array String -> String
+asLine = foldMap (_ <> "\n")
 
 pluralize :: String -> Int -> String
 pluralize s 1 = s
 pluralize s _ = s <> "s"
-
-printPassedFailed :: Int -> Int -> Effect Unit
-printPassedFailed p f = do
-  let total = p + f
-      testStr = pluralize "test" total
-      amount = show p <> "/" <> (show total) <> " " <> testStr <> " passed"
-      attrs = if f > 0 then [31] else [32]
-  withAttrs attrs $ log amount
-
-printPending :: Int -> Effect Unit
-printPending p
-  | p > 0     = withAttrs [33] $ log (show p <> " " <> pluralize "test" p <> " pending")
-  | otherwise = pure unit
diff --git a/src/Test/Spec/Reporter/Dot.purs b/src/Test/Spec/Reporter/Dot.purs
index 57568e3..f36809b 100644
--- a/src/Test/Spec/Reporter/Dot.purs
+++ b/src/Test/Spec/Reporter/Dot.purs
@@ -20,9 +20,9 @@ dotReporter { width } =
     update n = case _ of
       Event.Pass _ _ speed ms ->
         let col = Speed.toColor speed
-        in wrap $ Console.write (colored col ".")
-      Event.Fail _ _ _ _ -> wrap $ Console.write (colored Color.Fail "!")
-      Event.Pending _ _ -> wrap $ Console.write (colored Color.Pass ",")
+        in wrap $ colored col "."
+      Event.Fail _ _ _ -> wrap $ colored Color.Fail "!"
+      Event.Pending _ _ -> wrap $ colored Color.Pass ","
       Event.End _ -> n <$ Console.write "\n"
       _ -> pure n
 
@@ -31,4 +31,4 @@ dotReporter { width } =
           let n' = n + 1
           in n' <$ do
             when (n' `mod` width == 0) (Console.write "\n")
-            action
+            Console.write action
diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index 1920ab3..7eb04f1 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -34,7 +34,7 @@ specReporter
                           label = " (" <> show ms <> "ms)"
                       in colored col label
 
-    Event.Fail path name _ _ ->
+    Event.Fail path name _ ->
       let s' = s { numFailures = s.numFailures + 1 }
        in s' <$ (_log $ colored Color.Fail $ show s'.numFailures <> ") " <> name)
 
diff --git a/src/Test/Spec/Reporter/Tap.purs b/src/Test/Spec/Reporter/Tap.purs
index c1f4877..cd0b146 100644
--- a/src/Test/Spec/Reporter/Tap.purs
+++ b/src/Test/Spec/Reporter/Tap.purs
@@ -1,18 +1,20 @@
 module Test.Spec.Reporter.Tap (tapReporter) where
 
 import Prelude
-import Data.String.Regex as Regex
-import Test.Spec.Runner.Event as Event
-import Test.Spec.Summary as Summary
-import Effect.Console (log)
+
 import Data.Either (fromRight)
 import Data.Maybe (Maybe(..))
 import Data.String (Pattern(Pattern), joinWith, split)
 import Data.String.Regex (regex)
+import Data.String.Regex as Regex
+import Effect.Console (log)
+import Effect.Exception as Error
 import Partial.Unsafe (unsafePartial)
 import Test.Spec.Reporter.Base (defaultReporter)
 import Test.Spec.Runner (Reporter)
+import Test.Spec.Runner.Event as Event
 import Test.Spec.Summary (Summary(..))
+import Test.Spec.Summary as Summary
 
 type TapReporterState = Int
 
@@ -22,15 +24,14 @@ tapReporter =
  where
   update n = case _ of
     Event.Start nTests -> n <$ (log $ "1.." <> show nTests)
-    Event.TestEnd _ -> pure (n + 1)
     Event.Pending _ name -> n <$ log do
       "ok " <> show n <> " " <> (escTitle name) <> " # SKIP -"
-    Event.Pass _ name _ _ -> n <$ log do
+    Event.Pass _ name _ _ -> n + 1 <$ log do
       "ok " <> show n <> " " <> (escTitle name)
-    Event.Fail _ name msg mStack -> n <$ do
+    Event.Fail _ name err -> n + 1 <$ do
       log $ "not ok " <> show n <> " " <> (escTitle name)
-      log $ escMsg msg
-      case mStack of
+      log $ escMsg $ Error.message err
+      case Error.stack err of
         Nothing -> pure unit
         Just s  -> log $ joinWith "\n" (append "    " <$> split (Pattern "\n") s)
     Event.End results -> do
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index 35ca60c..787cd41 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -14,10 +14,9 @@ import Prelude
 
 import Control.Alternative ((<|>))
 import Control.Monad.Trans.Class (lift)
-import Control.Monad.Writer (execWriterT)
+import Control.Monad.Writer (execWriterT, tell)
 import Control.Parallel (parTraverse, parallel, sequential)
 import Data.Array (groupBy, mapWithIndex)
-import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Array.NonEmpty as NEA
 import Data.Either (Either(..), either)
 import Data.Foldable (foldl)
@@ -27,24 +26,21 @@ import Data.Maybe (Maybe(..))
 import Data.Newtype (un)
 import Data.Time.Duration (Milliseconds(..))
 import Data.Traversable (class Traversable, for)
-import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Aff (Aff, attempt, delay, forkAff, joinFiber, makeAff, throwError, try)
 import Effect.Aff.AVar as AV
 import Effect.Class (liftEffect)
-import Effect.Console (logShow)
 import Effect.Exception (Error, error)
-import Effect.Exception as Error
 import Pipes ((>->), yield)
 import Pipes.Core (Pipe, Producer, (//>))
 import Pipes.Core (runEffectRec) as P
 import Test.Spec (Item(..), Result(..), Spec, SpecM, SpecTree, Tree(..))
-import Test.Spec.Console (withAttrs)
+import Test.Spec.Console (logWriter, withAttrs)
 import Test.Spec.Runner.Event (Event)
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Speed (speedOf)
 import Test.Spec.Summary (successful)
-import Test.Spec.Tree (countTests, discardUnfocused, isAllParallelizable)
+import Test.Spec.Tree (Path, PathItem(..), countTests, discardUnfocused, isAllParallelizable)
 
 foreign import exit :: Int -> Effect Unit
 
@@ -79,7 +75,7 @@ timeout time t = do
   sequential (parallel (try (makeTimeout time)) <|> parallel (try t))
     >>= either throwError pure
 
-type TestWithPath r = {test :: SpecTree Aff Unit, path :: Event.Path | r}
+type TestWithPath r = {test :: SpecTree Aff Unit, path :: Path | r}
 
 -- Run the given spec as `Producer` in the underlying `Aff` monad.
 -- This producer has two responsibilities:
@@ -97,7 +93,7 @@ _run
 _run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
   yield (Event.Start (countTests tests))
   let
-    indexer index test = {test, path: [Event.PathItem {name: Nothing, index}]}
+    indexer index test = {test, path: [PathItem {name: Nothing, index}]}
   r <- loop $ mapWithIndex indexer tests
   yield (Event.End r)
   pure r
@@ -105,20 +101,17 @@ _run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
     loop :: Array (TestWithPath ()) -> Producer Event Aff (Array (Tree Void Result))
     loop tests =
       let
-        marked :: Array (TestWithPath (isParallelizable :: Boolean))
-        marked = tests <#> \{test,path} -> {isParallelizable: isAllParallelizable test, test, path}
-        grouped' :: Array (NonEmptyArray (TestWithPath (isParallelizable :: Boolean)))
-        grouped' = groupBy (\a b -> a.isParallelizable && b.isParallelizable) marked
-        grouped :: Array (Tuple Boolean (Array (TestWithPath ())))
-        grouped = grouped' <#> \g -> Tuple ((NEA.head g).isParallelizable) $ (\{test,path} -> {test,path}) <$> NEA.toArray g
-      in join <$> for grouped \(Tuple isParallelizable xs) -> join <$> if isParallelizable
-        then mergeProducers (runGroup <$> xs)
-        else for xs runGroup
+        noteWithIsAllParallelizable = map \{test,path} -> { isParallelizable: isAllParallelizable test, test, path}
+        groupByIsParallelizable = groupBy (\a b -> a.isParallelizable && b.isParallelizable)
+      in join <$> for (groupByIsParallelizable $ noteWithIsAllParallelizable tests) \g ->
+        join <$> if (NEA.head g).isParallelizable
+          then mergeProducers (runGroup <$> (NEA.toArray g))
+          else for (NEA.toArray g) runGroup
 
     runGroup :: forall r. TestWithPath r -> Producer Event Aff (Array (Tree Void Result))
     runGroup {test, path} = case test of
       (Leaf name (Just (Item item))) -> do
-        yield $ Event.Test path
+        yield $ Event.Test path name
         let example = item.example \a -> a unit
         start <- lift $ liftEffect dateNow
         e <- lift $ attempt case config.timeout of
@@ -126,23 +119,19 @@ _run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
           _      -> example
         duration <- lift $ (_ - start) <$> liftEffect dateNow
         yield $ either
-          (\err ->
-            let msg = Error.message err
-                stack = Error.stack err
-            in Event.Fail path name msg stack)
+          (Event.Fail path name)
           (const $ Event.Pass path name (speedOf config.slow duration) duration)
           e
-        yield $ Event.TestEnd path
         pure [ Leaf name $ Just $ either Failure (const Success) e ]
       (Leaf name Nothing) -> do
         yield $ Event.Pending path name
         pure [ Leaf name Nothing ]
       (Node (Right cleanup) xs) -> do
-        let indexer index x = {test:x, path: path <> [Event.PathItem {name: Nothing, index}]}
+        let indexer index x = {test:x, path: path <> [PathItem {name: Nothing, index}]}
         loop (mapWithIndex indexer xs) <* lift (cleanup unit)
       (Node (Left name) xs) -> do
         yield $ Event.Suite path name
-        let indexer index x = {test:x, path: path <> [Event.PathItem {name: Just name, index}]}
+        let indexer index x = {test:x, path: path <> [PathItem {name: Just name, index}]}
         res <- loop (mapWithIndex indexer xs)
         yield $ Event.SuiteEnd path
         pure [ Node (Left name) res ]
@@ -207,7 +196,7 @@ run' config reporters spec = _run config spec <#> \runner -> do
   where
     onError :: Error -> Aff Unit
     onError err = liftEffect do
-       withAttrs [31] $ logShow err
+       logWriter $ withAttrs [31] $ tell $ show err <> "\n"
        when config.exit (exit 1)
 
     onSuccess :: Array (Tree Void Result) -> Aff Unit
diff --git a/src/Test/Spec/Runner/Event.purs b/src/Test/Spec/Runner/Event.purs
index 332d881..7e8b0d0 100644
--- a/src/Test/Spec/Runner/Event.purs
+++ b/src/Test/Spec/Runner/Event.purs
@@ -2,9 +2,11 @@ module Test.Spec.Runner.Event where
 
 import Prelude
 
-import Data.Maybe (Maybe)
+import Effect.Exception (Error)
+import Effect.Exception as Error
 import Test.Spec (Result, Tree)
 import Test.Spec.Speed (Speed)
+import Test.Spec.Tree (Path)
 
 type Message = String
 type Name = String
@@ -12,20 +14,12 @@ type Duration = Int
 type NumberOfTests = Int
 type Stack = String
 
-newtype PathItem = PathItem { name :: Maybe String, index :: Int}
-
-derive newtype instance showIdTerm :: Show PathItem
-derive newtype instance eqIdTerm :: Eq PathItem
-
-type Path = Array PathItem
-
 data Event
   = Start NumberOfTests
   | Suite Path Name
-  | Test Path
-  | TestEnd Path
   | SuiteEnd Path
-  | Fail Path Name Message (Maybe Stack)
+  | Test Path Name
+  | Fail Path Name Error
   | Pass Path Name Speed Duration
   | Pending Path Name
   | End (Array (Tree Void Result))
@@ -35,10 +29,9 @@ instance showEvent :: Show Event where
     case _ of
       Start n -> "Start " <> show n
       Suite path name -> "Suite " <> show path <> ": " <> name
-      Test path -> "Test " <> show path
-      TestEnd path -> "TestEnd " <> show path
+      Test path name -> "Test " <> show path <> " " <> name
       SuiteEnd path -> "SuiteEnd " <> show path
-      Fail path name msg _ -> "Fail " <> show path <> " " <> name <> ": " <> msg
+      Fail path name err -> "Fail " <> show path <> " " <> name <> ": " <> Error.message err
       Pass path name speed duration -> "Pass " <> show path <> " " <> name <> " "
                                   <> show speed <> " "
                                   <> show duration
diff --git a/src/Test/Spec/Tree.purs b/src/Test/Spec/Tree.purs
index 25d6132..cce0d31 100644
--- a/src/Test/Spec/Tree.purs
+++ b/src/Test/Spec/Tree.purs
@@ -7,21 +7,27 @@ module Test.Spec.Tree
   , isAllParallelizable
   , discardUnfocused
   , modifyAroundAction
+  , PathItem(..)
+  , Path
+  , parentSuiteName
+  , removeLastIndex
   ) where
 
 import Prelude
 
 import Control.Monad.State (execState)
 import Control.Monad.State as State
-import Data.Array (mapMaybe)
+import Data.Array (mapMaybe, unsnoc)
 import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Array.NonEmpty as NEA
 import Data.Bifunctor (class Bifunctor)
-import Data.Either (Either)
+import Data.Either (Either, either)
 import Data.Foldable (class Foldable, all, foldMapDefaultL, foldl, foldr)
+import Data.FunctorWithIndex (mapWithIndex)
 import Data.Maybe (Maybe(..), maybe)
 import Data.Newtype (class Newtype, un)
 import Data.Traversable (for, for_)
+import Data.Tuple (Tuple(..))
 
 
 data Tree c a
@@ -37,6 +43,7 @@ instance eqGroup :: (Eq c, Eq a) => Eq (Tree c a) where
   eq (Leaf n1 t1) (Leaf n2 t2) = n1 == n2 && t1 == t2
   eq _                    _                    = false
 
+-- TODO fix name aggregation
 bimapTree :: forall a b c d. (Array String -> a -> b) -> (NonEmptyArray String ->c -> d) -> Tree a c -> Tree b d
 bimapTree g f = go []
   where
@@ -85,7 +92,7 @@ countTests g = execState (for g go) 0
 isAllParallelizable :: forall c m a. Tree c (Item m a) -> Boolean
 isAllParallelizable = case _ of
   Node _ xs -> all isAllParallelizable xs
-  Leaf _ x -> (x >>= un Item >>> _.isParallelizable) == Just true
+  Leaf _ (x) -> x == Nothing || (x >>= un Item >>> _.isParallelizable) == Just true
 
 
 -- | If there is at least one focused element, all paths which don't
@@ -109,3 +116,19 @@ modifyAroundAction action (Item item) = Item $ item
   { example = \aroundAction -> item.example (aroundAction <<< action)
   }
 
+newtype PathItem = PathItem { index :: Int, name :: Maybe String }
+
+derive instance newtypePathItem :: Newtype PathItem _
+derive newtype instance showIdTerm :: Show PathItem
+derive newtype instance pathItemEq :: Eq PathItem
+derive newtype instance pathItemOrd :: Ord PathItem
+
+type Path = Array PathItem
+
+parentSuiteName :: Path -> Array String
+parentSuiteName = mapMaybe (un PathItem >>> _.name)
+
+removeLastIndex :: Path -> Tuple Path (Maybe String)
+removeLastIndex p = case unsnoc p of
+  Nothing -> Tuple [] Nothing
+  Just {init, last: PathItem {name}} -> Tuple init name
diff --git a/test/Main.purs b/test/Main.purs
index 0cb6cd5..79c5ac9 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -6,11 +6,13 @@ import Data.Identity (Identity(..))
 import Data.Maybe (Maybe(..))
 import Data.Newtype (un)
 import Effect (Effect)
-import Effect.Aff (launchAff_)
+import Effect.Aff (Milliseconds(..), delay, launchAff_)
+import Test.Spec (describe, it, parallel, pending, sequential)
 import Test.Spec.AssertionSpec (assertionSpec)
+import Test.Spec.Assertions (shouldEqual)
 import Test.Spec.HoistSpec (hoistSpecSpec)
 import Test.Spec.HookSpec (hookSpec)
-import Test.Spec.Reporter (consoleReporter)
+import Test.Spec.Reporter (consoleReporter, specReporter)
 import Test.Spec.Runner (defaultConfig, run')
 import Test.Spec.RunnerSpec (runnerSpec)
 
@@ -20,3 +22,28 @@ main = launchAff_ $ un Identity $ run' (defaultConfig{timeout = Nothing}) [ cons
   assertionSpec
   hookSpec
   hoistSpecSpec
+  describe "g" do
+    it "g.1" $ delay $ Milliseconds 500.0
+    it "g.2" $ delay $ Milliseconds 500.0
+    pending "g.3"
+  describe "p" do
+    describe "pp" do
+      describe "ppp" do
+        pending "ppp.1"
+  describe "a" $ parallel do
+    it "a.err" $ delay (Milliseconds 300.0) *> 1 `shouldEqual` 2
+    it "a.1" $ delay $ Milliseconds 500.0
+    it "a.2" $ delay $ Milliseconds 1500.0
+    describe "z" do
+      it "z.1" $ delay $ Milliseconds 700.0
+      it "z.2" $ delay $ Milliseconds 900.0
+      pending "z.3"
+    describe "j" do
+      it "j.1" $ delay $ Milliseconds 1000.0
+      it "j.2" $ delay $ Milliseconds 400.0
+    describe "d" $ sequential do
+      it "d.1" $ delay $ Milliseconds 500.0
+      it "d.2" $ delay $ Milliseconds 500.0
+  describe "k" do
+    it "k.1" $ delay $ Milliseconds 500.0
+    it "k.2" $ delay $ Milliseconds 500.0
diff --git a/test/Test/Spec/HoistSpec.purs b/test/Test/Spec/HoistSpec.purs
index 4a388a0..8578747 100644
--- a/test/Test/Spec/HoistSpec.purs
+++ b/test/Test/Spec/HoistSpec.purs
@@ -3,12 +3,10 @@ module Test.Spec.HoistSpec where
 import Prelude
 
 import Control.Monad.Reader (ReaderT, ask, runReaderT)
-import Control.Monad.Writer (WriterT, runWriterT, tell)
 import Data.Array.NonEmpty as NAE
 import Data.Identity (Identity)
 import Data.Time.Duration (Milliseconds(..))
-import Data.Traversable (for_, intercalate)
-import Data.Tuple (Tuple(..))
+import Data.Traversable (intercalate)
 import Effect.Aff (Aff, delay)
 import Effect.Aff.Class (liftAff)
 import Effect.Class.Console (log)
@@ -19,21 +17,8 @@ type Spec' t a = SpecM Identity t Unit a
 hoistSpecSpec :: Spec Unit
 hoistSpecSpec = describe "hoist" do
   describe "normal" $ delaySpecExample {log, delay}
-  describe "writer" $ hoistSpecSpecWriterT
   describe "reader" $ hoistSpecSpecReaderT
 
-hoistSpecSpecWriterT :: Spec Unit
-hoistSpecSpecWriterT = go $ parallel do
-  delaySpecExample
-    { log: \s -> tell [s]
-    , delay: \ms -> liftAff $ delay ms
-    }
-  where
-    go :: Spec' (WriterT (Array String) Aff) ~> Spec
-    go = hoistSpec \_ m -> do
-     Tuple res logMsgs <- runWriterT m
-     for_ logMsgs log
-     pure res
 
 hoistSpecSpecReaderT :: Spec Unit
 hoistSpecSpecReaderT = go $ parallel do
@@ -50,6 +35,7 @@ hoistSpecSpecReaderT = go $ parallel do
           TestWithName n -> intercalate " > " $ NAE.toArray n
       in runReaderT m \logMsg -> log $ prefix  <> "| " <> logMsg
 
+-- TODO restore `log`
 delaySpecExample
   :: forall m
   . Monad m
@@ -59,28 +45,29 @@ delaySpecExample
   -> Spec' m Unit
 delaySpecExample opts = describe "delay" do
   it "proc 1" do
-    opts.log "start 1"
+    -- opts.log "start 1"
     opts.delay $ Milliseconds $ 500.0 + 300.0 * 1.0
-    opts.log "done 1"
+    -- opts.log "done 1"
   describe "some" do
     it "proc 2" do
-      opts.log "start 2"
+      -- opts.log "start 2"
       opts.delay $ Milliseconds $ 500.0 + 300.0 * 2.0
-      opts.log "done 2"
+      -- opts.log "done 2"
     it "proc 3" do
-      opts.log "start 3"
+      -- opts.log "start 3"
       opts.delay $ Milliseconds $ 500.0 + 300.0 * 3.0
-      opts.log "done 3"
+      -- opts.log "done 3"
     describe "nesting" do
       it "proc 4" do
-        opts.log "start 4"
+        -- opts.log "start 4"
         opts.delay $ Milliseconds $ 500.0 + 300.0 * 4.0
-        opts.log "done 4"
+        -- opts.log "done 4"
+    describe "nesting" do
       it "proc 5" do
-        opts.log "start 5"
+        -- opts.log "start 5"
         opts.delay $ Milliseconds $ 500.0 + 300.0 * 5.0
-        opts.log "done 5"
+        -- opts.log "done 5"
       it "proc 6" do
-        opts.log "start 6"
+        -- opts.log "start 6"
         opts.delay $ Milliseconds $ 500.0 + 300.0 * 6.0
-        opts.log "done 6"
\ No newline at end of file
+        -- opts.log "done 6"

From ec4bda618c6f8912ba02b375705295210de78eca Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Mon, 14 Jan 2019 16:50:10 +0400
Subject: [PATCH 11/39] some cleanup

---
 src/Test/Spec/Console.purs          | 26 ++++++++++--
 src/Test/Spec/Reporter/Base.purs    | 64 +++++++++++++++--------------
 src/Test/Spec/Reporter/Console.purs | 40 +++++++++---------
 src/Test/Spec/Reporter/Dot.purs     | 41 ++++++++----------
 src/Test/Spec/Reporter/Spec.purs    | 62 ++++++++++++++--------------
 src/Test/Spec/Reporter/Tap.purs     | 53 +++++++++++++-----------
 src/Test/Spec/Runner.purs           |  3 +-
 src/Test/Spec/Tree.purs             |  7 ++--
 test/Main.purs                      |  4 +-
 9 files changed, 158 insertions(+), 142 deletions(-)

diff --git a/src/Test/Spec/Console.purs b/src/Test/Spec/Console.purs
index 4e9853f..c385c09 100644
--- a/src/Test/Spec/Console.purs
+++ b/src/Test/Spec/Console.purs
@@ -2,6 +2,8 @@ module Test.Spec.Console
   ( setAttr
   , reset
   , withAttrs
+  , tellLn
+  , tellLns
   , write
   , logWriter
   , moveUpAndClearLine
@@ -10,15 +12,31 @@ module Test.Spec.Console
 import Prelude
 
 import Ansi.Codes (colorSuffix, prefix)
-import Control.Monad.Writer (class MonadWriter, Writer, execWriter, tell)
-import Data.Foldable (foldr)
+import Control.Monad.Writer (class MonadWriter, WriterT, execWriterT, tell)
+import Data.Foldable (foldr, for_)
 import Effect (Effect)
+import Effect.Class (class MonadEffect, liftEffect)
 
 foreign import write :: String -> Effect Unit
 foreign import moveUpAndClearLine :: Effect Unit
 
-logWriter :: Writer String Unit -> Effect Unit
-logWriter = execWriter >>> write
+logWriter :: forall m. MonadEffect m => WriterT String m Unit -> m Unit
+logWriter = execWriterT >=> write >>> liftEffect
+
+tellLn
+  :: forall m
+   . MonadWriter String m
+  => String
+  -> m Unit
+tellLn l = tell $ l <> "\n"
+
+tellLns
+  :: forall m
+   . MonadWriter String m
+  => Array String
+  -> m Unit
+tellLns l = for_ l $ (_<> "\n") >>> tell
+
 
 setAttr
   :: forall m
diff --git a/src/Test/Spec/Reporter/Base.purs b/src/Test/Spec/Reporter/Base.purs
index b091959..725ebd9 100644
--- a/src/Test/Spec/Reporter/Base.purs
+++ b/src/Test/Spec/Reporter/Base.purs
@@ -6,19 +6,18 @@ module Test.Spec.Reporter.Base
 
 import Prelude
 
-import Control.Monad.State (StateT, evalStateT)
+import Control.Monad.State (StateT, evalStateT, execStateT)
 import Control.Monad.State as State
 import Control.Monad.Trans.Class (lift)
+import Control.Monad.Writer (class MonadWriter)
 import Data.Array ((:), reverse)
 import Data.Array as Array
 import Data.Either (Either(..))
-import Data.Foldable (intercalate)
+import Data.Foldable (intercalate, traverse_)
 import Data.Maybe (Maybe(..))
 import Data.String.CodeUnits as CodeUnits
-import Data.Traversable (for_)
 import Effect (Effect)
 import Effect.Class (liftEffect)
-import Effect.Console (log)
 import Effect.Exception as Error
 import Pipes (await, yield)
 import Pipes.Core (Pipe)
@@ -26,6 +25,7 @@ import Test.Spec (Result, Tree)
 import Test.Spec as S
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
+import Test.Spec.Console (tellLn)
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event (Event)
 import Test.Spec.Summary (Summary(..))
@@ -38,38 +38,40 @@ indent i = CodeUnits.fromCharArray $ Array.replicate i ' '
 defaultUpdate :: forall s. s -> Event -> Effect s
 defaultUpdate s _ = pure s
 
-defaultSummary :: Array (Tree Void Result) -> Effect Unit
+defaultSummary :: forall m
+   . MonadWriter String m
+  => Array (Tree Void Result)
+  -> m Unit
 defaultSummary xs = do
   case Summary.summarize xs of
     (Count {passed, failed, pending}) -> do
-      when (passed  > 0) $ log $ colored Color.Green   $ show passed  <> " passing"
-      when (pending > 0) $ log $ colored Color.Pending $ show pending <> " pending"
-      when (failed  > 0) $ log $ colored Color.Fail    $ show failed  <> " failed"
-  log ""
+      when (passed  > 0) $ tellLn $ colored Color.Green   $ show passed  <> " passing"
+      when (pending > 0) $ tellLn $ colored Color.Pending $ show pending <> " pending"
+      when (failed  > 0) $ tellLn $ colored Color.Fail    $ show failed  <> " failed"
+  tellLn ""
   printFailures xs
 
-
 printFailures
-  :: Array (Tree Void Result)
-  -> Effect Unit
-printFailures xs = void $ evalStateT (go [] xs) 0
+  :: forall m
+   . MonadWriter String m
+  => Array (Tree Void Result)
+  -> m Unit
+printFailures xs' = evalStateT (go xs') {i: 0, crumbs: []}
   where
-    go
-      :: Array String
-      -> Array (Tree Void Result)
-      -> StateT Int Effect Unit
-    go crumbs groups =
-      for_ groups case _ of
-        S.Node (Left n) xs' -> go (n:crumbs) xs'
-        S.Node (Right _) xs' -> go crumbs xs'
-        S.Leaf n (Just (S.Failure err)) ->
-          let label = intercalate " " (reverse $ n:crumbs)
-            in do
-                _ <- State.modify (_ + 1)
-                i <- State.get
-                lift $ log $ show i <> ") " <> label
-                lift $ log $ colored Color.ErrorMessage $ indent 2 <> Error.message err
-        S.Leaf _ _ -> pure unit
+    go :: Array (Tree Void Result) -> StateT { i :: Int, crumbs :: Array String } m Unit
+    go = traverse_ case _ of
+      S.Node (Left n) xs -> do
+        {crumbs} <- State.get
+        State.modify_ _{crumbs = n : crumbs}
+        go xs
+        State.modify_ _{crumbs = crumbs}
+      S.Node (Right _) xs -> go xs
+      S.Leaf n (Just (S.Failure err)) -> do
+        {i, crumbs} <- State.modify \s -> s{i = s.i +1}
+        let label = intercalate " " (reverse $ n:crumbs)
+        tellLn $ show i <> ") " <> label
+        tellLn $ colored Color.ErrorMessage $ indent 2 <> Error.message err
+      S.Leaf _ _ -> pure unit
 
 -- | Monadic left scan with state.
 -- | TODO: Is this already included in purescript-pipes somehow, or should be?
@@ -92,9 +94,9 @@ scanWithStateM step begin = do
 defaultReporter
   :: forall s
    . s
-  -> (s -> Event -> Effect s)
+  -> (Event -> StateT s Effect Unit)
   -> Reporter
 defaultReporter initialState onEvent = do
   scanWithStateM dispatch (pure initialState)
   where
-    dispatch s e = liftEffect(onEvent s e)
+    dispatch s e = liftEffect (execStateT (onEvent e) s)
diff --git a/src/Test/Spec/Reporter/Console.purs b/src/Test/Spec/Reporter/Console.purs
index 4327b9d..6ffa8c0 100644
--- a/src/Test/Spec/Reporter/Console.purs
+++ b/src/Test/Spec/Reporter/Console.purs
@@ -2,7 +2,7 @@ module Test.Spec.Reporter.Console (consoleReporter) where
 
 import Prelude
 
-import Control.Monad.State (execStateT, get, lift, put)
+import Control.Monad.State (get, lift, put)
 import Control.Monad.Writer (class MonadWriter, execWriter, tell)
 import Data.Array (all, foldMap, groupBy, length, mapMaybe, null, replicate, sortBy)
 import Data.Array.NonEmpty as NEA
@@ -42,26 +42,24 @@ initialState :: Array RunningItem
 initialState = []
 
 consoleReporter :: Reporter
-consoleReporter = defaultReporter initialState $ flip update
+consoleReporter = defaultReporter initialState case _ of
+  Event.Suite path name -> do
+    modifyRunningItems (_ <> [RunningSuite path name false])
+  Event.SuiteEnd path -> do
+    modifyRunningItems $ map case _ of
+      RunningSuite p n _ | p == path -> RunningSuite p n true
+      a -> a
+  Event.Test path name -> do
+    modifyRunningItems (_ <> [RunningTest path name Nothing])
+  Event.Pass path name _ _ -> do
+    modifyRunningItems $ updateRunningTestResult path $ Success
+  Event.Pending path name -> do
+    modifyRunningItems (_ <> [PendingTest path name])
+  Event.Fail path name err -> do
+    modifyRunningItems $ updateRunningTestResult path $ Failure err
+  Event.End results -> logWriter $ printSummary results
+  Event.Start _ -> pure unit
   where
-  update = execStateT <<< case _ of
-    Event.Suite path name -> do
-      modifyRunningItems (_ <> [RunningSuite path name false])
-    Event.SuiteEnd path -> do
-      modifyRunningItems $ map case _ of
-        RunningSuite p n _ | p == path -> RunningSuite p n true
-        a -> a
-    Event.Test path name -> do
-      modifyRunningItems (_ <> [RunningTest path name Nothing])
-    Event.Pass path name _ _ -> do
-      modifyRunningItems $ updateRunningTestResult path $ Success
-    Event.Pending path name -> do
-      modifyRunningItems (_ <> [PendingTest path name])
-    Event.Fail path name err -> do
-      modifyRunningItems $ updateRunningTestResult path $ Failure err
-    Event.End results -> lift $ logWriter $ printSummary results
-    Event.Start _ -> pure unit
-
   updateRunningTestResult path res = map case _ of
     RunningTest p n _ | p == path -> RunningTest p n $ Just res
     a -> a
@@ -73,7 +71,7 @@ consoleReporter = defaultReporter initialState $ flip update
     unless (null currentRunningItems) do
       let c = lineCount $ execWriter $ writeRunningItems currentRunningItems
       lift $ sequence_ $ replicate c moveUpAndClearLine
-    lift $ logWriter $ writeRunningItems nextRunningItems
+    logWriter $ writeRunningItems nextRunningItems
     where
       lineCount str = length (split (Pattern "\n") str) - 1
       allRunningItemsAreFinished = all case _ of
diff --git a/src/Test/Spec/Reporter/Dot.purs b/src/Test/Spec/Reporter/Dot.purs
index f36809b..d2748de 100644
--- a/src/Test/Spec/Reporter/Dot.purs
+++ b/src/Test/Spec/Reporter/Dot.purs
@@ -1,34 +1,29 @@
 module Test.Spec.Reporter.Dot (dotReporter) where
 
 import Prelude
-import Test.Spec.Color as Color
-import Test.Spec.Runner.Event as Event
-import Test.Spec.Speed as Speed
+
+import Control.Monad.State (modify)
+import Control.Monad.Writer (tell)
 import Test.Spec.Color (colored)
-import Test.Spec.Console (write) as Console
+import Test.Spec.Color as Color
+import Test.Spec.Console (logWriter, tellLn)
 import Test.Spec.Reporter.Base (defaultReporter)
 import Test.Spec.Runner (Reporter)
+import Test.Spec.Runner.Event as Event
+import Test.Spec.Speed as Speed
 
-type DotReporterState = Int
 type DotReporterConfig = { width :: Int }
 
 dotReporter :: DotReporterConfig -> Reporter
-dotReporter { width } =
-  defaultReporter (-1) update
-
+dotReporter { width } = defaultReporter (-1) $ logWriter <<< case _ of
+  Event.Pass _ _ speed ms -> wrap $ colored (Speed.toColor speed) "."
+  Event.Fail _ _ _ -> wrap $ colored Color.Fail "!"
+  Event.Pending _ _ -> wrap $ colored Color.Pass ","
+  Event.End _ -> tellLn ""
+  _ -> pure unit
   where
-    update n = case _ of
-      Event.Pass _ _ speed ms ->
-        let col = Speed.toColor speed
-        in wrap $ colored col "."
-      Event.Fail _ _ _ -> wrap $ colored Color.Fail "!"
-      Event.Pending _ _ -> wrap $ colored Color.Pass ","
-      Event.End _ -> n <$ Console.write "\n"
-      _ -> pure n
-
-      where
-        wrap action =
-          let n' = n + 1
-          in n' <$ do
-            when (n' `mod` width == 0) (Console.write "\n")
-            Console.write action
+    wrap action = do
+      n <- modify (_ + 1)
+      when (n `mod` width == 0) do
+        tellLn ""
+      tell action
diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index 7eb04f1..6922230 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -2,50 +2,48 @@ module Test.Spec.Reporter.Spec (specReporter) where
 
 import Prelude
 
+import Control.Monad.State (get, lift, modify, modify_)
 import Data.Array as Array
 import Data.String.CodeUnits as CodeUnits
 import Effect.Console (log)
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
+import Test.Spec.Console (logWriter)
 import Test.Spec.Reporter.Base (defaultSummary, defaultReporter)
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Speed as Speed
 
+-- TODO coordinate events when multiple test/suites are running in parallel
 specReporter :: Reporter
-specReporter
-  = defaultReporter { indent: 0, numFailures: 0 } update
- where
-  -- TODO coordinate events when multiple test/suites are running in parallel
-  update s = case _ of
-    Event.Start _ -> s <$ log ""
-    Event.Suite path name -> modIndent (_ + 1) $ \_ -> _log name
-    Event.SuiteEnd path   -> modIndent (_ - 1) $ \i -> when (i == 1) (log "")
-    Event.Pending path name -> s <$ do
-      _log $ colored Color.Pending $ "- " <> name
-    Event.Pass path name speed ms -> s <$ do
-      _log $ colored Color.Checkmark "✓︎"
-              <> " "
-              <> colored Color.Pass name
-              <> case speed of
-                    Speed.Fast -> ""
-                    _ ->
-                      let col = Speed.toColor speed
-                          label = " (" <> show ms <> "ms)"
-                      in colored col label
+specReporter = defaultReporter { indent: 0, numFailures: 0 } case _ of
+  Event.Suite path name -> do
+    modify_ $ onIndent (_ + 1)
+    _log name
+  Event.SuiteEnd path -> do
+    s <- modify $ onIndent (_ - 1)
+    when (s.indent == 1) do
+      lift $ log ""
+  Event.Pending path name -> do
+    _log $ colored Color.Pending $ "- " <> name
+  Event.Pass path name speed ms -> do
+    let
+      speedDetails = case speed of
+        Speed.Fast -> ""
+        _ -> colored (Speed.toColor speed) $ " (" <> show ms <> "ms)"
+    _log $ colored Color.Checkmark "✓︎" <> " " <> colored Color.Pass name <> speedDetails
+  Event.Fail path name _ -> do
+    s <- modify \s -> s{ numFailures = s.numFailures + 1 }
+    _log $ colored Color.Fail $ show s.numFailures <> ") " <> name
+  Event.End results -> lift $ logWriter (defaultSummary results)
+  Event.Start _ -> pure unit
+  Event.Test _ _ -> pure unit
 
-    Event.Fail path name _ ->
-      let s' = s { numFailures = s.numFailures + 1 }
-       in s' <$ (_log $ colored Color.Fail $ show s'.numFailures <> ") " <> name)
-
-    Event.End results -> s <$ defaultSummary results
-    _ -> pure s
-
-    where
-    _log msg = log $ indent s.indent <> msg
-    modIndent f fm =
-      let s' = s { indent = f s.indent }
-       in s' <$ (fm s'.indent)
+  where
+    onIndent f s = s { indent = f s.indent }
+    _log msg = do
+      s <- get
+      lift $ log $ indent s.indent <> msg
 
     -- TODO: move this somewhere central
     indent i = CodeUnits.fromCharArray $ Array.replicate i ' '
diff --git a/src/Test/Spec/Reporter/Tap.purs b/src/Test/Spec/Reporter/Tap.purs
index cd0b146..26a64c1 100644
--- a/src/Test/Spec/Reporter/Tap.purs
+++ b/src/Test/Spec/Reporter/Tap.purs
@@ -2,14 +2,15 @@ module Test.Spec.Reporter.Tap (tapReporter) where
 
 import Prelude
 
+import Control.Monad.State (get, modify_)
 import Data.Either (fromRight)
 import Data.Maybe (Maybe(..))
 import Data.String (Pattern(Pattern), joinWith, split)
 import Data.String.Regex (regex)
 import Data.String.Regex as Regex
-import Effect.Console (log)
 import Effect.Exception as Error
 import Partial.Unsafe (unsafePartial)
+import Test.Spec.Console (logWriter, tellLn)
 import Test.Spec.Reporter.Base (defaultReporter)
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event as Event
@@ -19,29 +20,33 @@ import Test.Spec.Summary as Summary
 type TapReporterState = Int
 
 tapReporter :: Reporter
-tapReporter =
- defaultReporter 1 update
- where
-  update n = case _ of
-    Event.Start nTests -> n <$ (log $ "1.." <> show nTests)
-    Event.Pending _ name -> n <$ log do
-      "ok " <> show n <> " " <> (escTitle name) <> " # SKIP -"
-    Event.Pass _ name _ _ -> n + 1 <$ log do
-      "ok " <> show n <> " " <> (escTitle name)
-    Event.Fail _ name err -> n + 1 <$ do
-      log $ "not ok " <> show n <> " " <> (escTitle name)
-      log $ escMsg $ Error.message err
-      case Error.stack err of
-        Nothing -> pure unit
-        Just s  -> log $ joinWith "\n" (append "    " <$> split (Pattern "\n") s)
-    Event.End results -> do
-      case Summary.summarize results of
-        (Count {passed, failed, pending}) -> do
-          log $ "# tests " <> show (failed + passed + pending)
-          log $ "# pass "  <> show (passed + pending)
-          log $ "# fail "  <> show failed
-      pure n
-    _ -> pure n
+tapReporter = defaultReporter 1 $ logWriter <<< case _ of
+  Event.Start nTests ->
+    tellLn $ "1.." <> show nTests
+  Event.Pending _ name -> do
+    n <- get
+    tellLn $ "ok " <> show n <> " " <> (escTitle name) <> " # SKIP -"
+    modify_ (_ + 1)
+  Event.Pass _ name _ _ -> do
+    n <- get
+    tellLn $ "ok " <> show n <> " " <> (escTitle name)
+    modify_ (_ + 1)
+  Event.Fail _ name err -> do
+    n <- get
+    tellLn $ "not ok " <> show n <> " " <> (escTitle name)
+    tellLn $ escMsg $ Error.message err
+    case Error.stack err of
+      Nothing -> pure unit
+      Just s  -> tellLn $ joinWith "\n" (append "    " <$> split (Pattern "\n") s)
+    modify_ (_ + 1)
+  Event.End results -> do
+    let (Count {passed, failed, pending}) = Summary.summarize results
+    tellLn $ "# tests " <> show (failed + passed + pending)
+    tellLn $ "# pass " <> show (passed + pending)
+    tellLn $ "# fail " <> show failed
+  Event.Suite _ _ -> pure unit
+  Event.SuiteEnd _ -> pure unit
+  Event.Test _ _ -> pure unit
 
 -- create a TAP-safe title
 escMsg :: String -> String
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index 787cd41..c8e9287 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -92,8 +92,7 @@ _run
   -> m (Producer Event Aff (Array (Tree Void Result)))
 _run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
   yield (Event.Start (countTests tests))
-  let
-    indexer index test = {test, path: [PathItem {name: Nothing, index}]}
+  let indexer index test = {test, path: [PathItem {name: Nothing, index}]}
   r <- loop $ mapWithIndex indexer tests
   yield (Event.End r)
   pure r
diff --git a/src/Test/Spec/Tree.purs b/src/Test/Spec/Tree.purs
index cce0d31..edb6d09 100644
--- a/src/Test/Spec/Tree.purs
+++ b/src/Test/Spec/Tree.purs
@@ -17,7 +17,7 @@ import Prelude
 
 import Control.Monad.State (execState)
 import Control.Monad.State as State
-import Data.Array (mapMaybe, unsnoc)
+import Data.Array (mapMaybe, snoc, unsnoc)
 import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Array.NonEmpty as NEA
 import Data.Bifunctor (class Bifunctor)
@@ -43,13 +43,14 @@ instance eqGroup :: (Eq c, Eq a) => Eq (Tree c a) where
   eq (Leaf n1 t1) (Leaf n2 t2) = n1 == n2 && t1 == t2
   eq _                    _                    = false
 
--- TODO fix name aggregation
 bimapTree :: forall a b c d. (Array String -> a -> b) -> (NonEmptyArray String ->c -> d) -> Tree a c -> Tree b d
 bimapTree g f = go []
   where
     go :: Array String -> Tree a c -> Tree b d
     go namePath spec = case spec of
-      Node d xs -> Node (map (g namePath) d) (map (go namePath) xs)
+      Node d xs ->
+        let namePath' = either (snoc namePath) (const namePath) d
+        in Node (map (g namePath') d) (map (go namePath') xs)
       Leaf n item -> Leaf n (map (f $ NEA.snoc' namePath n) item)
 
 instance treeBifunctor :: Bifunctor Tree where
diff --git a/test/Main.purs b/test/Main.purs
index 79c5ac9..c93d3e1 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -12,12 +12,12 @@ import Test.Spec.AssertionSpec (assertionSpec)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Spec.HoistSpec (hoistSpecSpec)
 import Test.Spec.HookSpec (hookSpec)
-import Test.Spec.Reporter (consoleReporter, specReporter)
+import Test.Spec.Reporter (specReporter)
 import Test.Spec.Runner (defaultConfig, run')
 import Test.Spec.RunnerSpec (runnerSpec)
 
 main :: Effect Unit
-main = launchAff_ $ un Identity $ run' (defaultConfig{timeout = Nothing}) [ consoleReporter ] do
+main = launchAff_ $ un Identity $ run' (defaultConfig{timeout = Nothing}) [ specReporter ] do
   runnerSpec
   assertionSpec
   hookSpec

From 1232a9a1a83ba195802a359daf7de18a8d0c82eb Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Mon, 14 Jan 2019 17:11:42 +0400
Subject: [PATCH 12/39] update reporter with copy&paste

---
 src/Test/Spec/Reporter/Spec.purs | 117 +++++++++++++++++++++++--------
 test/Main.purs                   |   1 +
 2 files changed, 87 insertions(+), 31 deletions(-)

diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index 6922230..0df4ecf 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -2,48 +2,103 @@ module Test.Spec.Reporter.Spec (specReporter) where
 
 import Prelude
 
-import Control.Monad.State (get, lift, modify, modify_)
+import Control.Monad.State (get, lift, put)
+import Control.Monad.Writer (class MonadWriter, execWriter)
+import Data.Array (all, length, null, replicate, sortBy)
 import Data.Array as Array
+import Data.Foldable (for_, sequence_)
+import Data.Function (on)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
+import Data.Maybe (Maybe(..), isJust)
+import Data.String (split, Pattern(..))
 import Data.String.CodeUnits as CodeUnits
-import Effect.Console (log)
+import Effect.Exception (Error)
+import Effect.Exception as Error
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
-import Test.Spec.Console (logWriter)
-import Test.Spec.Reporter.Base (defaultSummary, defaultReporter)
+import Test.Spec.Console (logWriter, moveUpAndClearLine, tellLn)
+import Test.Spec.Reporter.Base (defaultReporter, defaultSummary)
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event as Event
-import Test.Spec.Speed as Speed
+import Test.Spec.Speed (Speed)
+import Test.Spec.Tree (Path)
+
+data RunningItem
+  = RunningTest Path String (Maybe Res)
+  | PendingTest Path String
+  | RunningSuite Path String Boolean
+
+runningItemPath :: RunningItem -> Path
+runningItemPath = case _ of
+  RunningTest p _ _ -> p
+  PendingTest p _ -> p
+  RunningSuite p _ _ -> p
+
+derive instance runningItemGeneric :: Generic RunningItem _
+instance runningItemShow :: Show RunningItem where show = genericShow
+
+initialState :: Array RunningItem
+initialState = []
+
+type Duration = Int
+data Res = Success Speed Duration | Failure Error
+instance showResult :: Show Res where
+  show (Success speed duration) = "Success ()"
+  show (Failure err) = "Failure (Error ...)"
 
--- TODO coordinate events when multiple test/suites are running in parallel
 specReporter :: Reporter
-specReporter = defaultReporter { indent: 0, numFailures: 0 } case _ of
+specReporter = defaultReporter initialState case _ of
   Event.Suite path name -> do
-    modify_ $ onIndent (_ + 1)
-    _log name
+    modifyRunningItems (_ <> [RunningSuite path name false])
   Event.SuiteEnd path -> do
-    s <- modify $ onIndent (_ - 1)
-    when (s.indent == 1) do
-      lift $ log ""
-  Event.Pending path name -> do
-    _log $ colored Color.Pending $ "- " <> name
+    modifyRunningItems $ map case _ of
+      RunningSuite p n _ | p == path -> RunningSuite p n true
+      a -> a
+  Event.Test path name -> do
+    modifyRunningItems (_ <> [RunningTest path name Nothing])
   Event.Pass path name speed ms -> do
-    let
-      speedDetails = case speed of
-        Speed.Fast -> ""
-        _ -> colored (Speed.toColor speed) $ " (" <> show ms <> "ms)"
-    _log $ colored Color.Checkmark "✓︎" <> " " <> colored Color.Pass name <> speedDetails
-  Event.Fail path name _ -> do
-    s <- modify \s -> s{ numFailures = s.numFailures + 1 }
-    _log $ colored Color.Fail $ show s.numFailures <> ") " <> name
-  Event.End results -> lift $ logWriter (defaultSummary results)
+    modifyRunningItems $ updateRunningTestResult path $ Success speed ms
+  Event.Pending path name -> do
+    modifyRunningItems (_ <> [PendingTest path name])
+  Event.Fail path name err -> do
+    modifyRunningItems $ updateRunningTestResult path $ Failure err
+  Event.End results -> logWriter $ defaultSummary results
   Event.Start _ -> pure unit
-  Event.Test _ _ -> pure unit
-
   where
-    onIndent f s = s { indent = f s.indent }
-    _log msg = do
-      s <- get
-      lift $ log $ indent s.indent <> msg
+  updateRunningTestResult path res = map case _ of
+    RunningTest p n _ | p == path -> RunningTest p n $ Just res
+    a -> a
+
+  modifyRunningItems f = do
+    currentRunningItems <- get
+    let nextRunningItems = f currentRunningItems
+    put if allRunningItemsAreFinished nextRunningItems then [] else nextRunningItems
+    unless (null currentRunningItems) do
+      let c = lineCount $ execWriter $ writeRunningItems currentRunningItems
+      lift $ sequence_ $ replicate c moveUpAndClearLine
+    logWriter $ writeRunningItems nextRunningItems
+    where
+      lineCount str = length (split (Pattern "\n") str) - 1
+      allRunningItemsAreFinished = all case _ of
+        PendingTest _ _ -> true
+        RunningTest _ _ res -> isJust res
+        RunningSuite _ _ finished -> finished
 
-    -- TODO: move this somewhere central
-    indent i = CodeUnits.fromCharArray $ Array.replicate i ' '
+  writeRunningItems :: forall m. MonadWriter String m => Array RunningItem -> m Unit
+  writeRunningItems runningItems = do
+    for_ (sortByPath runningItems) case _ of
+      PendingTest path name -> do
+        tellLn $ (indent path) <> (colored Color.Pending $ "- " <> name)
+      RunningTest path name Nothing -> do
+        tellLn $ (indent path) <> colored Color.Pending "⥀ " <> name
+      RunningTest path name (Just (Success _ _)) -> do
+        tellLn $ (indent path) <> colored Color.Checkmark "✓︎ " <> colored Color.Pass name
+      RunningTest path name (Just (Failure err)) -> do
+        tellLn $ (indent path) <> colored Color.Fail ("✗ " <> name <> ":")
+        tellLn $ ""
+        tellLn $ (indent path) <> colored Color.Fail (Error.message err)
+      RunningSuite path name _ -> tellLn $ (indent path) <> name
+    where
+      sortByPath = sortBy \a b -> on compare (runningItemPath) a b
+      indent path = CodeUnits.fromCharArray $ Array.replicate (length path) ' '
diff --git a/test/Main.purs b/test/Main.purs
index c93d3e1..d4cfab4 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -38,6 +38,7 @@ main = launchAff_ $ un Identity $ run' (defaultConfig{timeout = Nothing}) [ spec
       it "z.1" $ delay $ Milliseconds 700.0
       it "z.2" $ delay $ Milliseconds 900.0
       pending "z.3"
+      it "z.err" $ delay (Milliseconds 300.0) *> 1 `shouldEqual` 2
     describe "j" do
       it "j.1" $ delay $ Milliseconds 1000.0
       it "j.2" $ delay $ Milliseconds 400.0

From 1459670e08ca68ba4be3707299854b5e241b600e Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Mon, 14 Jan 2019 17:21:51 +0400
Subject: [PATCH 13/39] put Speed and Duration in Success

---
 src/Test/Spec.purs                  |  9 +++++---
 src/Test/Spec/Reporter/Console.purs |  6 ++---
 src/Test/Spec/Reporter/Spec.purs    | 34 ++++++++++++++---------------
 src/Test/Spec/Runner.purs           |  2 +-
 src/Test/Spec/Speed.purs            |  6 ++---
 src/Test/Spec/Summary.purs          |  4 ++--
 6 files changed, 31 insertions(+), 30 deletions(-)

diff --git a/src/Test/Spec.purs b/src/Test/Spec.purs
index 03d4e77..11b9eae 100644
--- a/src/Test/Spec.purs
+++ b/src/Test/Spec.purs
@@ -9,6 +9,7 @@ module Test.Spec
   , hoistSpec
 
   , Result(..)
+  , Duration
 
   , class Example
   , evaluateExample
@@ -64,6 +65,7 @@ import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Exception (Error)
 import Prim.TypeError (class Warn, Text)
+import Test.Spec.Speed (Speed)
 import Test.Spec.Tree (ActionWith, Item(..), Tree(..)) as Reexport
 import Test.Spec.Tree (ActionWith, Item(..), Tree(..), bimapTree, modifyAroundAction)
 
@@ -108,16 +110,17 @@ else instance exampleMUnit :: Example (m Unit) Unit m where
   evaluateExample t around' = around' $ \_ -> t
 
 
+type Duration = Int
 data Result
-  = Success
+  = Success Speed Duration
   | Failure Error
 
 instance showResult :: Show Result where
-  show Success = "Success"
+  show (Success speed duration ) = "Success (" <> show speed <> " " <> show duration <> ")"
   show (Failure err) = "Failure (Error ...)"
 
 instance eqResult :: Eq Result where
-  eq Success Success = true
+  eq (Success s1 d1) (Success s2 d2) = s1 == s2 && d1 == d2
   eq (Failure _) (Failure _) = true
   eq _ _ = false
 
diff --git a/src/Test/Spec/Reporter/Console.purs b/src/Test/Spec/Reporter/Console.purs
index 6ffa8c0..c79940f 100644
--- a/src/Test/Spec/Reporter/Console.purs
+++ b/src/Test/Spec/Reporter/Console.purs
@@ -51,8 +51,8 @@ consoleReporter = defaultReporter initialState case _ of
       a -> a
   Event.Test path name -> do
     modifyRunningItems (_ <> [RunningTest path name Nothing])
-  Event.Pass path name _ _ -> do
-    modifyRunningItems $ updateRunningTestResult path $ Success
+  Event.Pass path name speed ms -> do
+    modifyRunningItems $ updateRunningTestResult path $ Success speed ms
   Event.Pending path name -> do
     modifyRunningItems (_ <> [PendingTest path name])
   Event.Fail path name err -> do
@@ -90,7 +90,7 @@ consoleReporter = defaultReporter initialState case _ of
         RunningTest _ name Nothing -> tell $ asLine
           [ "  " <> colored Color.Pending "⥀ " <> name
           ]
-        RunningTest _ name (Just Success) -> tell $ asLine
+        RunningTest _ name (Just (Success _ _)) -> tell $ asLine
           [ "  " <> colored Color.Checkmark "✓︎ " <> colored Color.Pass name
           ]
         RunningTest _ name (Just (Failure err)) -> tell $ asLine
diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index 0df4ecf..0527bd3 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -13,19 +13,19 @@ import Data.Generic.Rep.Show (genericShow)
 import Data.Maybe (Maybe(..), isJust)
 import Data.String (split, Pattern(..))
 import Data.String.CodeUnits as CodeUnits
-import Effect.Exception (Error)
 import Effect.Exception as Error
+import Test.Spec (Result(..))
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
 import Test.Spec.Console (logWriter, moveUpAndClearLine, tellLn)
 import Test.Spec.Reporter.Base (defaultReporter, defaultSummary)
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event as Event
-import Test.Spec.Speed (Speed)
+import Test.Spec.Speed as Speed
 import Test.Spec.Tree (Path)
 
 data RunningItem
-  = RunningTest Path String (Maybe Res)
+  = RunningTest Path String (Maybe Result)
   | PendingTest Path String
   | RunningSuite Path String Boolean
 
@@ -38,14 +38,8 @@ runningItemPath = case _ of
 derive instance runningItemGeneric :: Generic RunningItem _
 instance runningItemShow :: Show RunningItem where show = genericShow
 
-initialState :: Array RunningItem
-initialState = []
-
-type Duration = Int
-data Res = Success Speed Duration | Failure Error
-instance showResult :: Show Res where
-  show (Success speed duration) = "Success ()"
-  show (Failure err) = "Failure (Error ...)"
+initialState :: { runningItem :: Array RunningItem, numFailures :: Int }
+initialState = { runningItem: [], numFailures: 0}
 
 specReporter :: Reporter
 specReporter = defaultReporter initialState case _ of
@@ -71,11 +65,11 @@ specReporter = defaultReporter initialState case _ of
     a -> a
 
   modifyRunningItems f = do
-    currentRunningItems <- get
-    let nextRunningItems = f currentRunningItems
-    put if allRunningItemsAreFinished nextRunningItems then [] else nextRunningItems
-    unless (null currentRunningItems) do
-      let c = lineCount $ execWriter $ writeRunningItems currentRunningItems
+    s <- get
+    let nextRunningItems = f s.runningItem
+    put s{runningItem = if allRunningItemsAreFinished nextRunningItems then [] else nextRunningItems}
+    unless (null s.runningItem) do
+      let c = lineCount $ execWriter $ writeRunningItems s.runningItem
       lift $ sequence_ $ replicate c moveUpAndClearLine
     logWriter $ writeRunningItems nextRunningItems
     where
@@ -92,8 +86,12 @@ specReporter = defaultReporter initialState case _ of
         tellLn $ (indent path) <> (colored Color.Pending $ "- " <> name)
       RunningTest path name Nothing -> do
         tellLn $ (indent path) <> colored Color.Pending "⥀ " <> name
-      RunningTest path name (Just (Success _ _)) -> do
-        tellLn $ (indent path) <> colored Color.Checkmark "✓︎ " <> colored Color.Pass name
+      RunningTest path name (Just (Success speed ms)) -> do
+        let
+          speedDetails = case speed of
+            Speed.Fast -> ""
+            _ -> colored (Speed.toColor speed) $ " (" <> show ms <> "ms)"
+        tellLn $ (indent path) <> colored Color.Checkmark "✓︎ " <> colored Color.Pass name <> speedDetails
       RunningTest path name (Just (Failure err)) -> do
         tellLn $ (indent path) <> colored Color.Fail ("✗ " <> name <> ":")
         tellLn $ ""
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index c8e9287..3993dd7 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -121,7 +121,7 @@ _run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
           (Event.Fail path name)
           (const $ Event.Pass path name (speedOf config.slow duration) duration)
           e
-        pure [ Leaf name $ Just $ either Failure (const Success) e ]
+        pure [ Leaf name $ Just $ either Failure (const $ Success (speedOf config.slow duration) duration) e ]
       (Leaf name Nothing) -> do
         yield $ Event.Pending path name
         pure [ Leaf name Nothing ]
diff --git a/src/Test/Spec/Speed.purs b/src/Test/Spec/Speed.purs
index b6a5746..5e0bdf8 100644
--- a/src/Test/Spec/Speed.purs
+++ b/src/Test/Spec/Speed.purs
@@ -3,6 +3,7 @@ module Test.Spec.Speed where
 import Prelude
 
 import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Eq (genericEq)
 import Data.Generic.Rep.Show (genericShow)
 import Test.Spec.Color (Color)
 import Test.Spec.Color as Color
@@ -10,9 +11,8 @@ import Test.Spec.Color as Color
 data Speed = Fast | Medium | Slow
 
 derive instance genericSpeed :: Generic Speed _
-
-instance showSpeed :: Show Speed
-  where show = genericShow
+instance showSpeed :: Show Speed where show = genericShow
+instance showEq :: Eq Speed where eq = genericEq
 
 speedOf :: Int -> Int -> Speed
 speedOf thresh ms | ms > thresh     = Slow
diff --git a/src/Test/Spec/Summary.purs b/src/Test/Spec/Summary.purs
index 9b7f7ce..ea9185f 100644
--- a/src/Test/Spec/Summary.purs
+++ b/src/Test/Spec/Summary.purs
@@ -22,10 +22,10 @@ instance monoidCount :: Monoid Summary where
 
 summarize :: forall a. Array (Tree a Result) -> Summary
 summarize = foldMap case _ of
-  (Leaf _ (Just Success))     -> Count { passed: 1, failed: 0, pending: 0 }
+  (Leaf _ (Just (Success _ _)))     -> Count { passed: 1, failed: 0, pending: 0 }
   (Leaf _ (Just (Failure _))) -> Count { passed: 0, failed: 1, pending: 0 }
   (Leaf _ Nothing)            -> Count { passed: 0, failed: 0, pending: 1 }
   (Node _ dgs)                -> summarize dgs
 
 successful :: forall a. Array (Tree a Result) -> Boolean
-successful groups = (un Count $ summarize groups).failed == 0
\ No newline at end of file
+successful groups = (un Count $ summarize groups).failed == 0

From e1df5dd6a4ac742bbcf15ad1f7dee5a232d9d5bc Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Mon, 14 Jan 2019 17:56:58 +0400
Subject: [PATCH 14/39] merge Fail and Pass into TestEnd

---
 src/Test/Spec.purs                  | 18 ----------------
 src/Test/Spec/Reporter/Base.purs    |  5 +++--
 src/Test/Spec/Reporter/Console.purs | 15 ++++++--------
 src/Test/Spec/Reporter/Dot.purs     |  5 +++--
 src/Test/Spec/Reporter/Spec.purs    | 14 +++++--------
 src/Test/Spec/Reporter/Tap.purs     |  5 +++--
 src/Test/Spec/Result.purs           | 23 +++++++++++++++++++++
 src/Test/Spec/Runner.purs           | 11 +++++-----
 src/Test/Spec/Runner/Event.purs     | 32 ++++++++++-------------------
 src/Test/Spec/Summary.purs          |  9 ++++----
 src/Test/Spec/Tree.purs             |  1 -
 11 files changed, 64 insertions(+), 74 deletions(-)
 create mode 100644 src/Test/Spec/Result.purs

diff --git a/src/Test/Spec.purs b/src/Test/Spec.purs
index 11b9eae..59e9947 100644
--- a/src/Test/Spec.purs
+++ b/src/Test/Spec.purs
@@ -8,9 +8,6 @@ module Test.Spec
   , ComputationType(..)
   , hoistSpec
 
-  , Result(..)
-  , Duration
-
   , class Example
   , evaluateExample
 
@@ -65,7 +62,6 @@ import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Exception (Error)
 import Prim.TypeError (class Warn, Text)
-import Test.Spec.Speed (Speed)
 import Test.Spec.Tree (ActionWith, Item(..), Tree(..)) as Reexport
 import Test.Spec.Tree (ActionWith, Item(..), Tree(..), bimapTree, modifyAroundAction)
 
@@ -110,20 +106,6 @@ else instance exampleMUnit :: Example (m Unit) Unit m where
   evaluateExample t around' = around' $ \_ -> t
 
 
-type Duration = Int
-data Result
-  = Success Speed Duration
-  | Failure Error
-
-instance showResult :: Show Result where
-  show (Success speed duration ) = "Success (" <> show speed <> " " <> show duration <> ")"
-  show (Failure err) = "Failure (Error ...)"
-
-instance eqResult :: Eq Result where
-  eq (Success s1 d1) (Success s2 d2) = s1 == s2 && d1 == d2
-  eq (Failure _) (Failure _) = true
-  eq _ _ = false
-
 
 -- | Nullary class used to raise a custom warning for the focusing functions.
 class FocusWarning
diff --git a/src/Test/Spec/Reporter/Base.purs b/src/Test/Spec/Reporter/Base.purs
index 725ebd9..da0d9a4 100644
--- a/src/Test/Spec/Reporter/Base.purs
+++ b/src/Test/Spec/Reporter/Base.purs
@@ -21,11 +21,12 @@ import Effect.Class (liftEffect)
 import Effect.Exception as Error
 import Pipes (await, yield)
 import Pipes.Core (Pipe)
-import Test.Spec (Result, Tree)
+import Test.Spec (Tree)
 import Test.Spec as S
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
 import Test.Spec.Console (tellLn)
+import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event (Event)
 import Test.Spec.Summary (Summary(..))
@@ -66,7 +67,7 @@ printFailures xs' = evalStateT (go xs') {i: 0, crumbs: []}
         go xs
         State.modify_ _{crumbs = crumbs}
       S.Node (Right _) xs -> go xs
-      S.Leaf n (Just (S.Failure err)) -> do
+      S.Leaf n (Just (Failure err)) -> do
         {i, crumbs} <- State.modify \s -> s{i = s.i +1}
         let label = intercalate " " (reverse $ n:crumbs)
         tellLn $ show i <> ") " <> label
diff --git a/src/Test/Spec/Reporter/Console.purs b/src/Test/Spec/Reporter/Console.purs
index c79940f..fbf1211 100644
--- a/src/Test/Spec/Reporter/Console.purs
+++ b/src/Test/Spec/Reporter/Console.purs
@@ -13,8 +13,7 @@ import Data.Generic.Rep.Show (genericShow)
 import Data.Maybe (Maybe(..), isJust)
 import Data.String (split, Pattern(..))
 import Effect.Exception as Error
-import Test.Spec (Result(..))
-import Test.Spec.Tree (Tree, Path, parentSuiteName, removeLastIndex)
+import Test.Spec.Result (Result(..))
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
 import Test.Spec.Console (moveUpAndClearLine, logWriter, withAttrs)
@@ -23,6 +22,7 @@ import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Summary (Summary(..))
 import Test.Spec.Summary as Summary
+import Test.Spec.Tree (Tree, Path, parentSuiteName, removeLastIndex)
 
 data RunningItem
   = RunningTest Path String (Maybe Result)
@@ -51,18 +51,15 @@ consoleReporter = defaultReporter initialState case _ of
       a -> a
   Event.Test path name -> do
     modifyRunningItems (_ <> [RunningTest path name Nothing])
-  Event.Pass path name speed ms -> do
-    modifyRunningItems $ updateRunningTestResult path $ Success speed ms
+  Event.TestEnd path name res -> do
+    modifyRunningItems $ map case _ of
+      RunningTest p n _ | p == path -> RunningTest p n $ Just res
+      a -> a
   Event.Pending path name -> do
     modifyRunningItems (_ <> [PendingTest path name])
-  Event.Fail path name err -> do
-    modifyRunningItems $ updateRunningTestResult path $ Failure err
   Event.End results -> logWriter $ printSummary results
   Event.Start _ -> pure unit
   where
-  updateRunningTestResult path res = map case _ of
-    RunningTest p n _ | p == path -> RunningTest p n $ Just res
-    a -> a
 
   modifyRunningItems f = do
     currentRunningItems <- get
diff --git a/src/Test/Spec/Reporter/Dot.purs b/src/Test/Spec/Reporter/Dot.purs
index d2748de..f5c77e9 100644
--- a/src/Test/Spec/Reporter/Dot.purs
+++ b/src/Test/Spec/Reporter/Dot.purs
@@ -8,6 +8,7 @@ import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
 import Test.Spec.Console (logWriter, tellLn)
 import Test.Spec.Reporter.Base (defaultReporter)
+import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Speed as Speed
@@ -16,8 +17,8 @@ type DotReporterConfig = { width :: Int }
 
 dotReporter :: DotReporterConfig -> Reporter
 dotReporter { width } = defaultReporter (-1) $ logWriter <<< case _ of
-  Event.Pass _ _ speed ms -> wrap $ colored (Speed.toColor speed) "."
-  Event.Fail _ _ _ -> wrap $ colored Color.Fail "!"
+  Event.TestEnd _ _ (Success speed _) -> wrap $ colored (Speed.toColor speed) "."
+  Event.TestEnd _ _ (Failure _) -> wrap $ colored Color.Fail "!"
   Event.Pending _ _ -> wrap $ colored Color.Pass ","
   Event.End _ -> tellLn ""
   _ -> pure unit
diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index 0527bd3..874f0a3 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -14,7 +14,7 @@ import Data.Maybe (Maybe(..), isJust)
 import Data.String (split, Pattern(..))
 import Data.String.CodeUnits as CodeUnits
 import Effect.Exception as Error
-import Test.Spec (Result(..))
+import Test.Spec.Result (Result(..))
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
 import Test.Spec.Console (logWriter, moveUpAndClearLine, tellLn)
@@ -51,19 +51,15 @@ specReporter = defaultReporter initialState case _ of
       a -> a
   Event.Test path name -> do
     modifyRunningItems (_ <> [RunningTest path name Nothing])
-  Event.Pass path name speed ms -> do
-    modifyRunningItems $ updateRunningTestResult path $ Success speed ms
+  Event.TestEnd path name res -> do
+    modifyRunningItems $ map case _ of
+      RunningTest p n _ | p == path -> RunningTest p n $ Just res
+      a -> a
   Event.Pending path name -> do
     modifyRunningItems (_ <> [PendingTest path name])
-  Event.Fail path name err -> do
-    modifyRunningItems $ updateRunningTestResult path $ Failure err
   Event.End results -> logWriter $ defaultSummary results
   Event.Start _ -> pure unit
   where
-  updateRunningTestResult path res = map case _ of
-    RunningTest p n _ | p == path -> RunningTest p n $ Just res
-    a -> a
-
   modifyRunningItems f = do
     s <- get
     let nextRunningItems = f s.runningItem
diff --git a/src/Test/Spec/Reporter/Tap.purs b/src/Test/Spec/Reporter/Tap.purs
index 26a64c1..4231a69 100644
--- a/src/Test/Spec/Reporter/Tap.purs
+++ b/src/Test/Spec/Reporter/Tap.purs
@@ -12,6 +12,7 @@ import Effect.Exception as Error
 import Partial.Unsafe (unsafePartial)
 import Test.Spec.Console (logWriter, tellLn)
 import Test.Spec.Reporter.Base (defaultReporter)
+import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Summary (Summary(..))
@@ -27,11 +28,11 @@ tapReporter = defaultReporter 1 $ logWriter <<< case _ of
     n <- get
     tellLn $ "ok " <> show n <> " " <> (escTitle name) <> " # SKIP -"
     modify_ (_ + 1)
-  Event.Pass _ name _ _ -> do
+  Event.TestEnd _ name (Success _ _) -> do
     n <- get
     tellLn $ "ok " <> show n <> " " <> (escTitle name)
     modify_ (_ + 1)
-  Event.Fail _ name err -> do
+  Event.TestEnd _ name (Failure err) -> do
     n <- get
     tellLn $ "not ok " <> show n <> " " <> (escTitle name)
     tellLn $ escMsg $ Error.message err
diff --git a/src/Test/Spec/Result.purs b/src/Test/Spec/Result.purs
new file mode 100644
index 0000000..3d51081
--- /dev/null
+++ b/src/Test/Spec/Result.purs
@@ -0,0 +1,23 @@
+module Test.Spec.Result where
+
+import Prelude
+
+import Data.Function (on)
+import Effect.Exception (Error)
+import Effect.Exception as Error
+import Test.Spec.Speed (Speed)
+
+
+type Duration = Int
+data Result
+  = Success Speed Duration
+  | Failure Error
+
+instance showResult :: Show Result where
+  show (Success speed duration ) = "Success (" <> show speed <> " " <> show duration <> ")"
+  show (Failure err) = "Failure (Error " <> Error.message err <> ")"
+
+instance eqResult :: Eq Result where
+  eq (Success s1 d1) (Success s2 d2) = s1 == s2 && d1 == d2
+  eq (Failure err1) (Failure err2) = on (==) Error.message err1 err2 && on (==) Error.stack err1 err2
+  eq _ _ = false
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index 3993dd7..4dae5df 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -34,8 +34,9 @@ import Effect.Exception (Error, error)
 import Pipes ((>->), yield)
 import Pipes.Core (Pipe, Producer, (//>))
 import Pipes.Core (runEffectRec) as P
-import Test.Spec (Item(..), Result(..), Spec, SpecM, SpecTree, Tree(..))
+import Test.Spec (Item(..), Spec, SpecM, SpecTree, Tree(..))
 import Test.Spec.Console (logWriter, withAttrs)
+import Test.Spec.Result (Result(..))
 import Test.Spec.Runner.Event (Event)
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Speed (speedOf)
@@ -117,11 +118,9 @@ _run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
           Just t -> timeout t example
           _      -> example
         duration <- lift $ (_ - start) <$> liftEffect dateNow
-        yield $ either
-          (Event.Fail path name)
-          (const $ Event.Pass path name (speedOf config.slow duration) duration)
-          e
-        pure [ Leaf name $ Just $ either Failure (const $ Success (speedOf config.slow duration) duration) e ]
+        let res = either Failure (const $ Success (speedOf config.slow duration) duration) e
+        yield $ Event.TestEnd path name res
+        pure [ Leaf name $ Just res ]
       (Leaf name Nothing) -> do
         yield $ Event.Pending path name
         pure [ Leaf name Nothing ]
diff --git a/src/Test/Spec/Runner/Event.purs b/src/Test/Spec/Runner/Event.purs
index 7e8b0d0..6ba323b 100644
--- a/src/Test/Spec/Runner/Event.purs
+++ b/src/Test/Spec/Runner/Event.purs
@@ -2,38 +2,28 @@ module Test.Spec.Runner.Event where
 
 import Prelude
 
-import Effect.Exception (Error)
-import Effect.Exception as Error
-import Test.Spec (Result, Tree)
-import Test.Spec.Speed (Speed)
+import Test.Spec (Tree)
+import Test.Spec.Result (Result)
 import Test.Spec.Tree (Path)
 
-type Message = String
 type Name = String
-type Duration = Int
 type NumberOfTests = Int
-type Stack = String
 
 data Event
   = Start NumberOfTests
   | Suite Path Name
   | SuiteEnd Path
   | Test Path Name
-  | Fail Path Name Error
-  | Pass Path Name Speed Duration
+  | TestEnd Path Name Result
   | Pending Path Name
   | End (Array (Tree Void Result))
 
 instance showEvent :: Show Event where
-  show =
-    case _ of
-      Start n -> "Start " <> show n
-      Suite path name -> "Suite " <> show path <> ": " <> name
-      Test path name -> "Test " <> show path <> " " <> name
-      SuiteEnd path -> "SuiteEnd " <> show path
-      Fail path name err -> "Fail " <> show path <> " " <> name <> ": " <> Error.message err
-      Pass path name speed duration -> "Pass " <> show path <> " " <> name <> " "
-                                  <> show speed <> " "
-                                  <> show duration
-      Pending path name -> "Pending " <> show path <> " " <> name
-      End results -> "End " <> show results
+  show = case _ of
+    Start n -> "Start " <> show n
+    Suite path name -> "Suite " <> show path <> ": " <> name
+    SuiteEnd path -> "SuiteEnd " <> show path
+    Test path name -> "Test " <> show path <> " " <> name
+    TestEnd path name res -> "TestEnd " <> show path <> " " <> name <> ": " <> show res
+    Pending path name -> "Pending " <> show path <> " " <> name
+    End results -> "End " <> show results
diff --git a/src/Test/Spec/Summary.purs b/src/Test/Spec/Summary.purs
index ea9185f..d7cdba7 100644
--- a/src/Test/Spec/Summary.purs
+++ b/src/Test/Spec/Summary.purs
@@ -9,7 +9,8 @@ import Prelude
 import Data.Foldable (foldMap)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype, un)
-import Test.Spec (Result(..), Tree(..))
+import Test.Spec.Result (Result(..))
+import Test.Spec.Tree (Tree(..))
 
 newtype Summary = Count { passed :: Int, failed :: Int, pending :: Int }
 derive instance newtypeSummary :: Newtype Summary _
@@ -22,10 +23,10 @@ instance monoidCount :: Monoid Summary where
 
 summarize :: forall a. Array (Tree a Result) -> Summary
 summarize = foldMap case _ of
-  (Leaf _ (Just (Success _ _)))     -> Count { passed: 1, failed: 0, pending: 0 }
+  (Leaf _ (Just (Success _ _))) -> Count { passed: 1, failed: 0, pending: 0 }
   (Leaf _ (Just (Failure _))) -> Count { passed: 0, failed: 1, pending: 0 }
-  (Leaf _ Nothing)            -> Count { passed: 0, failed: 0, pending: 1 }
-  (Node _ dgs)                -> summarize dgs
+  (Leaf _ Nothing) -> Count { passed: 0, failed: 0, pending: 1 }
+  (Node _ dgs) -> summarize dgs
 
 successful :: forall a. Array (Tree a Result) -> Boolean
 successful groups = (un Count $ summarize groups).failed == 0
diff --git a/src/Test/Spec/Tree.purs b/src/Test/Spec/Tree.purs
index edb6d09..903f717 100644
--- a/src/Test/Spec/Tree.purs
+++ b/src/Test/Spec/Tree.purs
@@ -23,7 +23,6 @@ import Data.Array.NonEmpty as NEA
 import Data.Bifunctor (class Bifunctor)
 import Data.Either (Either, either)
 import Data.Foldable (class Foldable, all, foldMapDefaultL, foldl, foldr)
-import Data.FunctorWithIndex (mapWithIndex)
 import Data.Maybe (Maybe(..), maybe)
 import Data.Newtype (class Newtype, un)
 import Data.Traversable (for, for_)

From f433b4df83f294c83477535d94de7346e9367ea0 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Mon, 14 Jan 2019 17:57:38 +0400
Subject: [PATCH 15/39] optimize redraw

---
 src/Test/Spec/Console.js            | 14 ++++++++------
 src/Test/Spec/Console.purs          |  4 ++--
 src/Test/Spec/Reporter/Console.purs | 11 +++++------
 src/Test/Spec/Reporter/Spec.purs    | 11 +++++------
 4 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/src/Test/Spec/Console.js b/src/Test/Spec/Console.js
index 0dc3ec6..5de9d6b 100644
--- a/src/Test/Spec/Console.js
+++ b/src/Test/Spec/Console.js
@@ -12,10 +12,12 @@ exports.write = function(s) {
   };
 };
 
-exports.moveUpAndClearLine = function() {
-  try {
-    process.stderr.moveCursor(0, -1);
-    process.stderr.clearLine(0);
-  }
-  catch (e) {}
+exports.moveUpAndClearDown = function(lines) {
+  return function() {
+    try {
+      process.stderr.moveCursor(0, -lines);
+      process.stderr.clearScreenDown();
+    }
+    catch (e) {}
+  };
 };
diff --git a/src/Test/Spec/Console.purs b/src/Test/Spec/Console.purs
index c385c09..16d85b1 100644
--- a/src/Test/Spec/Console.purs
+++ b/src/Test/Spec/Console.purs
@@ -6,7 +6,7 @@ module Test.Spec.Console
   , tellLns
   , write
   , logWriter
-  , moveUpAndClearLine
+  , moveUpAndClearDown
   ) where
 
 import Prelude
@@ -18,7 +18,7 @@ import Effect (Effect)
 import Effect.Class (class MonadEffect, liftEffect)
 
 foreign import write :: String -> Effect Unit
-foreign import moveUpAndClearLine :: Effect Unit
+foreign import moveUpAndClearDown :: Int -> Effect Unit
 
 logWriter :: forall m. MonadEffect m => WriterT String m Unit -> m Unit
 logWriter = execWriterT >=> write >>> liftEffect
diff --git a/src/Test/Spec/Reporter/Console.purs b/src/Test/Spec/Reporter/Console.purs
index fbf1211..86d026d 100644
--- a/src/Test/Spec/Reporter/Console.purs
+++ b/src/Test/Spec/Reporter/Console.purs
@@ -4,20 +4,20 @@ import Prelude
 
 import Control.Monad.State (get, lift, put)
 import Control.Monad.Writer (class MonadWriter, execWriter, tell)
-import Data.Array (all, foldMap, groupBy, length, mapMaybe, null, replicate, sortBy)
+import Data.Array (all, foldMap, groupBy, length, mapMaybe, null, sortBy)
 import Data.Array.NonEmpty as NEA
-import Data.Foldable (for_, intercalate, sequence_)
+import Data.Foldable (for_, intercalate)
 import Data.Function (on)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
 import Data.Maybe (Maybe(..), isJust)
 import Data.String (split, Pattern(..))
 import Effect.Exception as Error
-import Test.Spec.Result (Result(..))
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
-import Test.Spec.Console (moveUpAndClearLine, logWriter, withAttrs)
+import Test.Spec.Console (logWriter, moveUpAndClearDown, withAttrs)
 import Test.Spec.Reporter.Base (defaultReporter)
+import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Summary (Summary(..))
@@ -66,8 +66,7 @@ consoleReporter = defaultReporter initialState case _ of
     let nextRunningItems = f currentRunningItems
     put if allRunningItemsAreFinished nextRunningItems then [] else nextRunningItems
     unless (null currentRunningItems) do
-      let c = lineCount $ execWriter $ writeRunningItems currentRunningItems
-      lift $ sequence_ $ replicate c moveUpAndClearLine
+      lift $ moveUpAndClearDown $ lineCount $ execWriter $ writeRunningItems currentRunningItems
     logWriter $ writeRunningItems nextRunningItems
     where
       lineCount str = length (split (Pattern "\n") str) - 1
diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index 874f0a3..ba56286 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -4,9 +4,9 @@ import Prelude
 
 import Control.Monad.State (get, lift, put)
 import Control.Monad.Writer (class MonadWriter, execWriter)
-import Data.Array (all, length, null, replicate, sortBy)
+import Data.Array (all, length, null, sortBy)
 import Data.Array as Array
-import Data.Foldable (for_, sequence_)
+import Data.Foldable (for_)
 import Data.Function (on)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
@@ -14,11 +14,11 @@ import Data.Maybe (Maybe(..), isJust)
 import Data.String (split, Pattern(..))
 import Data.String.CodeUnits as CodeUnits
 import Effect.Exception as Error
-import Test.Spec.Result (Result(..))
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
-import Test.Spec.Console (logWriter, moveUpAndClearLine, tellLn)
+import Test.Spec.Console (logWriter, moveUpAndClearDown, tellLn)
 import Test.Spec.Reporter.Base (defaultReporter, defaultSummary)
+import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Speed as Speed
@@ -65,8 +65,7 @@ specReporter = defaultReporter initialState case _ of
     let nextRunningItems = f s.runningItem
     put s{runningItem = if allRunningItemsAreFinished nextRunningItems then [] else nextRunningItems}
     unless (null s.runningItem) do
-      let c = lineCount $ execWriter $ writeRunningItems s.runningItem
-      lift $ sequence_ $ replicate c moveUpAndClearLine
+      lift $ moveUpAndClearDown $ lineCount $ execWriter $ writeRunningItems s.runningItem
     logWriter $ writeRunningItems nextRunningItems
     where
       lineCount str = length (split (Pattern "\n") str) - 1

From 8ae1a00a8f9884f374276ec2fc93172db1d64d25 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Mon, 14 Jan 2019 18:53:08 +0400
Subject: [PATCH 16/39] use Ansi codes for screan clearing

---
 src/Test/Spec/Console.js            | 10 ----------
 src/Test/Spec/Console.purs          | 11 ++++++++---
 src/Test/Spec/Reporter/Base.purs    | 13 +++++++------
 src/Test/Spec/Reporter/Console.purs | 10 +++++-----
 src/Test/Spec/Reporter/Dot.purs     |  4 ++--
 src/Test/Spec/Reporter/Spec.purs    | 12 ++++++------
 src/Test/Spec/Reporter/Tap.purs     |  4 ++--
 7 files changed, 30 insertions(+), 34 deletions(-)

diff --git a/src/Test/Spec/Console.js b/src/Test/Spec/Console.js
index 5de9d6b..4e00022 100644
--- a/src/Test/Spec/Console.js
+++ b/src/Test/Spec/Console.js
@@ -11,13 +11,3 @@ exports.write = function(s) {
     catch (e) {}
   };
 };
-
-exports.moveUpAndClearDown = function(lines) {
-  return function() {
-    try {
-      process.stderr.moveCursor(0, -lines);
-      process.stderr.clearScreenDown();
-    }
-    catch (e) {}
-  };
-};
diff --git a/src/Test/Spec/Console.purs b/src/Test/Spec/Console.purs
index 16d85b1..b4f118a 100644
--- a/src/Test/Spec/Console.purs
+++ b/src/Test/Spec/Console.purs
@@ -11,18 +11,23 @@ module Test.Spec.Console
 
 import Prelude
 
-import Ansi.Codes (colorSuffix, prefix)
+import Ansi.Codes (EraseParam(..), EscapeCode(..), colorSuffix, escapeCodeToString, prefix)
 import Control.Monad.Writer (class MonadWriter, WriterT, execWriterT, tell)
-import Data.Foldable (foldr, for_)
+import Data.Foldable (foldMap, foldr, for_)
 import Effect (Effect)
 import Effect.Class (class MonadEffect, liftEffect)
 
 foreign import write :: String -> Effect Unit
-foreign import moveUpAndClearDown :: Int -> Effect Unit
 
 logWriter :: forall m. MonadEffect m => WriterT String m Unit -> m Unit
 logWriter = execWriterT >=> write >>> liftEffect
 
+moveUpAndClearDown :: Int -> String
+moveUpAndClearDown lines = foldMap escapeCodeToString
+  [ Up lines
+  , EraseData ToEnd
+  ]
+
 tellLn
   :: forall m
    . MonadWriter String m
diff --git a/src/Test/Spec/Reporter/Base.purs b/src/Test/Spec/Reporter/Base.purs
index da0d9a4..60a4ad7 100644
--- a/src/Test/Spec/Reporter/Base.purs
+++ b/src/Test/Spec/Reporter/Base.purs
@@ -9,13 +9,14 @@ import Prelude
 import Control.Monad.State (StateT, evalStateT, execStateT)
 import Control.Monad.State as State
 import Control.Monad.Trans.Class (lift)
-import Control.Monad.Writer (class MonadWriter)
+import Control.Monad.Writer (class MonadWriter, Writer, runWriter)
 import Data.Array ((:), reverse)
 import Data.Array as Array
 import Data.Either (Either(..))
 import Data.Foldable (intercalate, traverse_)
 import Data.Maybe (Maybe(..))
 import Data.String.CodeUnits as CodeUnits
+import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Class (liftEffect)
 import Effect.Exception as Error
@@ -26,6 +27,7 @@ import Test.Spec as S
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
 import Test.Spec.Console (tellLn)
+import Test.Spec.Console as Console
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event (Event)
@@ -95,9 +97,8 @@ scanWithStateM step begin = do
 defaultReporter
   :: forall s
    . s
-  -> (Event -> StateT s Effect Unit)
+  -> (Event -> StateT s (Writer String) Unit)
   -> Reporter
-defaultReporter initialState onEvent = do
-  scanWithStateM dispatch (pure initialState)
-  where
-    dispatch s e = liftEffect (execStateT (onEvent e) s)
+defaultReporter initialState onEvent = pure initialState # scanWithStateM \s e ->
+  let Tuple res log = runWriter $ execStateT (onEvent e) s
+  in liftEffect $ Console.write log $> res
diff --git a/src/Test/Spec/Reporter/Console.purs b/src/Test/Spec/Reporter/Console.purs
index 86d026d..fa649f8 100644
--- a/src/Test/Spec/Reporter/Console.purs
+++ b/src/Test/Spec/Reporter/Console.purs
@@ -2,7 +2,7 @@ module Test.Spec.Reporter.Console (consoleReporter) where
 
 import Prelude
 
-import Control.Monad.State (get, lift, put)
+import Control.Monad.State (get, put)
 import Control.Monad.Writer (class MonadWriter, execWriter, tell)
 import Data.Array (all, foldMap, groupBy, length, mapMaybe, null, sortBy)
 import Data.Array.NonEmpty as NEA
@@ -15,7 +15,7 @@ import Data.String (split, Pattern(..))
 import Effect.Exception as Error
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
-import Test.Spec.Console (logWriter, moveUpAndClearDown, withAttrs)
+import Test.Spec.Console (moveUpAndClearDown, withAttrs)
 import Test.Spec.Reporter.Base (defaultReporter)
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
@@ -57,7 +57,7 @@ consoleReporter = defaultReporter initialState case _ of
       a -> a
   Event.Pending path name -> do
     modifyRunningItems (_ <> [PendingTest path name])
-  Event.End results -> logWriter $ printSummary results
+  Event.End results -> printSummary results
   Event.Start _ -> pure unit
   where
 
@@ -66,8 +66,8 @@ consoleReporter = defaultReporter initialState case _ of
     let nextRunningItems = f currentRunningItems
     put if allRunningItemsAreFinished nextRunningItems then [] else nextRunningItems
     unless (null currentRunningItems) do
-      lift $ moveUpAndClearDown $ lineCount $ execWriter $ writeRunningItems currentRunningItems
-    logWriter $ writeRunningItems nextRunningItems
+      tell $ moveUpAndClearDown $ lineCount $ execWriter $ writeRunningItems currentRunningItems
+    writeRunningItems nextRunningItems
     where
       lineCount str = length (split (Pattern "\n") str) - 1
       allRunningItemsAreFinished = all case _ of
diff --git a/src/Test/Spec/Reporter/Dot.purs b/src/Test/Spec/Reporter/Dot.purs
index f5c77e9..6581953 100644
--- a/src/Test/Spec/Reporter/Dot.purs
+++ b/src/Test/Spec/Reporter/Dot.purs
@@ -6,7 +6,7 @@ import Control.Monad.State (modify)
 import Control.Monad.Writer (tell)
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
-import Test.Spec.Console (logWriter, tellLn)
+import Test.Spec.Console (tellLn)
 import Test.Spec.Reporter.Base (defaultReporter)
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
@@ -16,7 +16,7 @@ import Test.Spec.Speed as Speed
 type DotReporterConfig = { width :: Int }
 
 dotReporter :: DotReporterConfig -> Reporter
-dotReporter { width } = defaultReporter (-1) $ logWriter <<< case _ of
+dotReporter { width } = defaultReporter (-1) case _ of
   Event.TestEnd _ _ (Success speed _) -> wrap $ colored (Speed.toColor speed) "."
   Event.TestEnd _ _ (Failure _) -> wrap $ colored Color.Fail "!"
   Event.Pending _ _ -> wrap $ colored Color.Pass ","
diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index ba56286..be6989a 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -2,8 +2,8 @@ module Test.Spec.Reporter.Spec (specReporter) where
 
 import Prelude
 
-import Control.Monad.State (get, lift, put)
-import Control.Monad.Writer (class MonadWriter, execWriter)
+import Control.Monad.State (get, put)
+import Control.Monad.Writer (class MonadWriter, execWriter, tell)
 import Data.Array (all, length, null, sortBy)
 import Data.Array as Array
 import Data.Foldable (for_)
@@ -16,7 +16,7 @@ import Data.String.CodeUnits as CodeUnits
 import Effect.Exception as Error
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
-import Test.Spec.Console (logWriter, moveUpAndClearDown, tellLn)
+import Test.Spec.Console (moveUpAndClearDown, tellLn)
 import Test.Spec.Reporter.Base (defaultReporter, defaultSummary)
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
@@ -57,7 +57,7 @@ specReporter = defaultReporter initialState case _ of
       a -> a
   Event.Pending path name -> do
     modifyRunningItems (_ <> [PendingTest path name])
-  Event.End results -> logWriter $ defaultSummary results
+  Event.End results -> defaultSummary results
   Event.Start _ -> pure unit
   where
   modifyRunningItems f = do
@@ -65,8 +65,8 @@ specReporter = defaultReporter initialState case _ of
     let nextRunningItems = f s.runningItem
     put s{runningItem = if allRunningItemsAreFinished nextRunningItems then [] else nextRunningItems}
     unless (null s.runningItem) do
-      lift $ moveUpAndClearDown $ lineCount $ execWriter $ writeRunningItems s.runningItem
-    logWriter $ writeRunningItems nextRunningItems
+      tell $ moveUpAndClearDown $ lineCount $ execWriter $ writeRunningItems s.runningItem
+    writeRunningItems nextRunningItems
     where
       lineCount str = length (split (Pattern "\n") str) - 1
       allRunningItemsAreFinished = all case _ of
diff --git a/src/Test/Spec/Reporter/Tap.purs b/src/Test/Spec/Reporter/Tap.purs
index 4231a69..8c88cf3 100644
--- a/src/Test/Spec/Reporter/Tap.purs
+++ b/src/Test/Spec/Reporter/Tap.purs
@@ -10,7 +10,7 @@ import Data.String.Regex (regex)
 import Data.String.Regex as Regex
 import Effect.Exception as Error
 import Partial.Unsafe (unsafePartial)
-import Test.Spec.Console (logWriter, tellLn)
+import Test.Spec.Console (tellLn)
 import Test.Spec.Reporter.Base (defaultReporter)
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
@@ -21,7 +21,7 @@ import Test.Spec.Summary as Summary
 type TapReporterState = Int
 
 tapReporter :: Reporter
-tapReporter = defaultReporter 1 $ logWriter <<< case _ of
+tapReporter = defaultReporter 1 case _ of
   Event.Start nTests ->
     tellLn $ "1.." <> show nTests
   Event.Pending _ name -> do

From 58d4f9e804cf3cd831ba24d6239ed93196d7231c Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 15 Jan 2019 12:20:47 +0400
Subject: [PATCH 17/39] optimize redraw

---
 src/Test/Spec/Console.purs          |  7 +++--
 src/Test/Spec/Reporter/Console.purs | 42 ++++++++++++++++-------------
 src/Test/Spec/Reporter/Spec.purs    | 34 ++++++++++++-----------
 src/Test/Spec/Reporter/Tap.purs     |  4 +--
 src/Test/Spec/Runner.purs           | 10 +++----
 src/Test/Spec/Runner/Event.purs     | 14 +++++++---
 6 files changed, 61 insertions(+), 50 deletions(-)

diff --git a/src/Test/Spec/Console.purs b/src/Test/Spec/Console.purs
index b4f118a..3ded374 100644
--- a/src/Test/Spec/Console.purs
+++ b/src/Test/Spec/Console.purs
@@ -23,10 +23,9 @@ logWriter :: forall m. MonadEffect m => WriterT String m Unit -> m Unit
 logWriter = execWriterT >=> write >>> liftEffect
 
 moveUpAndClearDown :: Int -> String
-moveUpAndClearDown lines = foldMap escapeCodeToString
-  [ Up lines
-  , EraseData ToEnd
-  ]
+moveUpAndClearDown lines = foldMap escapeCodeToString case lines of
+  0 -> [ HorizontalAbsolute 0, EraseData ToEnd ]
+  n -> [ PreviousLine lines, EraseData ToEnd ]
 
 tellLn
   :: forall m
diff --git a/src/Test/Spec/Reporter/Console.purs b/src/Test/Spec/Reporter/Console.purs
index fa649f8..a6c1d07 100644
--- a/src/Test/Spec/Reporter/Console.purs
+++ b/src/Test/Spec/Reporter/Console.purs
@@ -5,6 +5,7 @@ import Prelude
 import Control.Monad.State (get, put)
 import Control.Monad.Writer (class MonadWriter, execWriter, tell)
 import Data.Array (all, foldMap, groupBy, length, mapMaybe, null, sortBy)
+import Data.Array as Arr
 import Data.Array.NonEmpty as NEA
 import Data.Foldable (for_, intercalate)
 import Data.Function (on)
@@ -19,21 +20,22 @@ import Test.Spec.Console (moveUpAndClearDown, withAttrs)
 import Test.Spec.Reporter.Base (defaultReporter)
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
+import Test.Spec.Runner.Event (Execution)
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Summary (Summary(..))
 import Test.Spec.Summary as Summary
 import Test.Spec.Tree (Tree, Path, parentSuiteName, removeLastIndex)
 
 data RunningItem
-  = RunningTest Path String (Maybe Result)
+  = RunningTest Execution Path String (Maybe Result)
   | PendingTest Path String
-  | RunningSuite Path String Boolean
+  | RunningSuite Execution Path String Boolean
 
 runningItemPath :: RunningItem -> Path
 runningItemPath = case _ of
-  RunningTest p _ _ -> p
+  RunningTest _ p _ _ -> p
   PendingTest p _ -> p
-  RunningSuite p _ _ -> p
+  RunningSuite _ p _ _ -> p
 
 derive instance runningItemGeneric :: Generic RunningItem _
 instance runningItemShow :: Show RunningItem where show = genericShow
@@ -43,17 +45,21 @@ initialState = []
 
 consoleReporter :: Reporter
 consoleReporter = defaultReporter initialState case _ of
-  Event.Suite path name -> do
-    modifyRunningItems (_ <> [RunningSuite path name false])
+  Event.Suite execution path name -> do
+    modifyRunningItems (\r ->
+      (case Arr.unsnoc r of
+        Just {init, last: RunningSuite _ _ _ _} -> init
+        _ -> r) <> [RunningSuite execution path name false]
+      )
   Event.SuiteEnd path -> do
     modifyRunningItems $ map case _ of
-      RunningSuite p n _ | p == path -> RunningSuite p n true
+      RunningSuite e p n _ | p == path -> RunningSuite e p n true
       a -> a
-  Event.Test path name -> do
-    modifyRunningItems (_ <> [RunningTest path name Nothing])
+  Event.Test execution path name -> do
+    modifyRunningItems (_ <> [RunningTest execution path name Nothing])
   Event.TestEnd path name res -> do
     modifyRunningItems $ map case _ of
-      RunningTest p n _ | p == path -> RunningTest p n $ Just res
+      RunningTest e p n _ | p == path -> RunningTest e p n $ Just res
       a -> a
   Event.Pending path name -> do
     modifyRunningItems (_ <> [PendingTest path name])
@@ -64,7 +70,7 @@ consoleReporter = defaultReporter initialState case _ of
   modifyRunningItems f = do
     currentRunningItems <- get
     let nextRunningItems = f currentRunningItems
-    put if allRunningItemsAreFinished nextRunningItems then [] else nextRunningItems
+    put if (allRunningItemsAreFinished nextRunningItems) then [] else nextRunningItems
     unless (null currentRunningItems) do
       tell $ moveUpAndClearDown $ lineCount $ execWriter $ writeRunningItems currentRunningItems
     writeRunningItems nextRunningItems
@@ -72,8 +78,8 @@ consoleReporter = defaultReporter initialState case _ of
       lineCount str = length (split (Pattern "\n") str) - 1
       allRunningItemsAreFinished = all case _ of
         PendingTest _ _ -> true
-        RunningTest _ _ res -> isJust res
-        RunningSuite _ _ finished -> finished
+        RunningTest _ _ _ res -> isJust res
+        RunningSuite _ _ _ finished -> finished
 
   writeRunningItems :: forall m. MonadWriter String m => Array RunningItem -> m Unit
   writeRunningItems runningItems = do
@@ -83,21 +89,21 @@ consoleReporter = defaultReporter initialState case _ of
         PendingTest _ name -> tell $ asLine
           [ "  " <> (colored Color.Pending $ "~ " <> name)
           ]
-        RunningTest _ name Nothing -> tell $ asLine
+        RunningTest _ _ name Nothing -> tell $ asLine
           [ "  " <> colored Color.Pending "⥀ " <> name
           ]
-        RunningTest _ name (Just (Success _ _)) -> tell $ asLine
+        RunningTest _ _ name (Just (Success _ _)) -> tell $ asLine
           [ "  " <> colored Color.Checkmark "✓︎ " <> colored Color.Pass name
           ]
-        RunningTest _ name (Just (Failure err)) -> tell $ asLine
+        RunningTest _ _ name (Just (Failure err)) -> tell $ asLine
           [ "  " <> colored Color.Fail ("✗ " <> name <> ":")
           , ""
           , "  " <> colored Color.Fail (Error.message err)
           ]
-        RunningSuite _ _ _ -> pure unit
+        RunningSuite _ _ _ _ -> pure unit
     where
       removeSuitesNodes = mapMaybe case _ of
-        RunningSuite _ _ _ -> Nothing
+        RunningSuite _ _ _ _ -> Nothing
         a -> Just a
       sortByPath = sortBy \a b -> on compare (runningItemPath) a b
       groupeBySuite = groupBy (on (==) $ runningItemPath >>> removeLastIndex)
diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index be6989a..7c6bad1 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -20,20 +20,21 @@ import Test.Spec.Console (moveUpAndClearDown, tellLn)
 import Test.Spec.Reporter.Base (defaultReporter, defaultSummary)
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
+import Test.Spec.Runner.Event (Execution(..))
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Speed as Speed
 import Test.Spec.Tree (Path)
 
 data RunningItem
-  = RunningTest Path String (Maybe Result)
+  = RunningTest Execution Path String (Maybe Result)
   | PendingTest Path String
-  | RunningSuite Path String Boolean
+  | RunningSuite Execution Path String Boolean
 
 runningItemPath :: RunningItem -> Path
 runningItemPath = case _ of
-  RunningTest p _ _ -> p
+  RunningTest _ p _ _ -> p
   PendingTest p _ -> p
-  RunningSuite p _ _ -> p
+  RunningSuite _ p _ _ -> p
 
 derive instance runningItemGeneric :: Generic RunningItem _
 instance runningItemShow :: Show RunningItem where show = genericShow
@@ -43,17 +44,17 @@ initialState = { runningItem: [], numFailures: 0}
 
 specReporter :: Reporter
 specReporter = defaultReporter initialState case _ of
-  Event.Suite path name -> do
-    modifyRunningItems (_ <> [RunningSuite path name false])
+  Event.Suite execution path name -> do
+    modifyRunningItems (_ <> [RunningSuite execution path name false])
   Event.SuiteEnd path -> do
     modifyRunningItems $ map case _ of
-      RunningSuite p n _ | p == path -> RunningSuite p n true
+      RunningSuite e p n _ | p == path -> RunningSuite e p n true
       a -> a
-  Event.Test path name -> do
-    modifyRunningItems (_ <> [RunningTest path name Nothing])
+  Event.Test execution path name -> do
+    modifyRunningItems (_ <> [RunningTest execution path name Nothing])
   Event.TestEnd path name res -> do
     modifyRunningItems $ map case _ of
-      RunningTest p n _ | p == path -> RunningTest p n $ Just res
+      RunningTest e p n _ | p == path -> RunningTest e p n $ Just res
       a -> a
   Event.Pending path name -> do
     modifyRunningItems (_ <> [PendingTest path name])
@@ -71,27 +72,28 @@ specReporter = defaultReporter initialState case _ of
       lineCount str = length (split (Pattern "\n") str) - 1
       allRunningItemsAreFinished = all case _ of
         PendingTest _ _ -> true
-        RunningTest _ _ res -> isJust res
-        RunningSuite _ _ finished -> finished
+        RunningTest _ _ _ res -> isJust res
+        RunningSuite Sequential _ _ finished -> true
+        RunningSuite Parallel _ _ finished -> finished
 
   writeRunningItems :: forall m. MonadWriter String m => Array RunningItem -> m Unit
   writeRunningItems runningItems = do
     for_ (sortByPath runningItems) case _ of
       PendingTest path name -> do
         tellLn $ (indent path) <> (colored Color.Pending $ "- " <> name)
-      RunningTest path name Nothing -> do
+      RunningTest e path name Nothing -> do
         tellLn $ (indent path) <> colored Color.Pending "⥀ " <> name
-      RunningTest path name (Just (Success speed ms)) -> do
+      RunningTest e path name (Just (Success speed ms)) -> do
         let
           speedDetails = case speed of
             Speed.Fast -> ""
             _ -> colored (Speed.toColor speed) $ " (" <> show ms <> "ms)"
         tellLn $ (indent path) <> colored Color.Checkmark "✓︎ " <> colored Color.Pass name <> speedDetails
-      RunningTest path name (Just (Failure err)) -> do
+      RunningTest e path name (Just (Failure err)) -> do
         tellLn $ (indent path) <> colored Color.Fail ("✗ " <> name <> ":")
         tellLn $ ""
         tellLn $ (indent path) <> colored Color.Fail (Error.message err)
-      RunningSuite path name _ -> tellLn $ (indent path) <> name
+      RunningSuite e path name _ -> tellLn $ (indent path) <> name
     where
       sortByPath = sortBy \a b -> on compare (runningItemPath) a b
       indent path = CodeUnits.fromCharArray $ Array.replicate (length path) ' '
diff --git a/src/Test/Spec/Reporter/Tap.purs b/src/Test/Spec/Reporter/Tap.purs
index 8c88cf3..e2d8c5e 100644
--- a/src/Test/Spec/Reporter/Tap.purs
+++ b/src/Test/Spec/Reporter/Tap.purs
@@ -45,9 +45,7 @@ tapReporter = defaultReporter 1 case _ of
     tellLn $ "# tests " <> show (failed + passed + pending)
     tellLn $ "# pass " <> show (passed + pending)
     tellLn $ "# fail " <> show failed
-  Event.Suite _ _ -> pure unit
-  Event.SuiteEnd _ -> pure unit
-  Event.Test _ _ -> pure unit
+  _ -> pure unit
 
 -- create a TAP-safe title
 escMsg :: String -> String
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index 4dae5df..a92b2ba 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -37,7 +37,7 @@ import Pipes.Core (runEffectRec) as P
 import Test.Spec (Item(..), Spec, SpecM, SpecTree, Tree(..))
 import Test.Spec.Console (logWriter, withAttrs)
 import Test.Spec.Result (Result(..))
-import Test.Spec.Runner.Event (Event)
+import Test.Spec.Runner.Event (Event, Execution(..))
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Speed (speedOf)
 import Test.Spec.Summary (successful)
@@ -108,10 +108,10 @@ _run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
           then mergeProducers (runGroup <$> (NEA.toArray g))
           else for (NEA.toArray g) runGroup
 
-    runGroup :: forall r. TestWithPath r -> Producer Event Aff (Array (Tree Void Result))
-    runGroup {test, path} = case test of
+    runGroup :: TestWithPath (isParallelizable :: Boolean) -> Producer Event Aff (Array (Tree Void Result))
+    runGroup {test, path, isParallelizable} = case test of
       (Leaf name (Just (Item item))) -> do
-        yield $ Event.Test path name
+        yield $ Event.Test (if isParallelizable then Parallel else Sequential) path name
         let example = item.example \a -> a unit
         start <- lift $ liftEffect dateNow
         e <- lift $ attempt case config.timeout of
@@ -128,7 +128,7 @@ _run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
         let indexer index x = {test:x, path: path <> [PathItem {name: Nothing, index}]}
         loop (mapWithIndex indexer xs) <* lift (cleanup unit)
       (Node (Left name) xs) -> do
-        yield $ Event.Suite path name
+        yield $ Event.Suite (if isParallelizable then Parallel else Sequential) path name
         let indexer index x = {test:x, path: path <> [PathItem {name: Just name, index}]}
         res <- loop (mapWithIndex indexer xs)
         yield $ Event.SuiteEnd path
diff --git a/src/Test/Spec/Runner/Event.purs b/src/Test/Spec/Runner/Event.purs
index 6ba323b..4a04919 100644
--- a/src/Test/Spec/Runner/Event.purs
+++ b/src/Test/Spec/Runner/Event.purs
@@ -9,11 +9,17 @@ import Test.Spec.Tree (Path)
 type Name = String
 type NumberOfTests = Int
 
+data Execution = Parallel | Sequential
+instance showExecution :: Show Execution where
+  show = case _ of
+    Parallel -> "Parallel"
+    Sequential -> "Sequential"
+
 data Event
   = Start NumberOfTests
-  | Suite Path Name
+  | Suite Execution Path Name
   | SuiteEnd Path
-  | Test Path Name
+  | Test Execution Path Name
   | TestEnd Path Name Result
   | Pending Path Name
   | End (Array (Tree Void Result))
@@ -21,9 +27,9 @@ data Event
 instance showEvent :: Show Event where
   show = case _ of
     Start n -> "Start " <> show n
-    Suite path name -> "Suite " <> show path <> ": " <> name
+    Suite e path name -> "Suite " <> show e <> show path <> ": " <> name
     SuiteEnd path -> "SuiteEnd " <> show path
-    Test path name -> "Test " <> show path <> " " <> name
+    Test e path name -> "Test " <> show e <> show path <> " " <> name
     TestEnd path name res -> "TestEnd " <> show path <> " " <> name <> ": " <> show res
     Pending path name -> "Pending " <> show path <> " " <> name
     End results -> "End " <> show results

From d22706f39f8f694dd0d7ae168c629cd582a8d44e Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 15 Jan 2019 17:02:21 +0400
Subject: [PATCH 18/39] no redraw

only log things to console when execution of test is finished so we don't need to do redraw
---
 src/Test/Spec/Reporter/Console.purs | 184 ++++++++++++++--------------
 src/Test/Spec/Reporter/Spec.purs    | 142 ++++++++++++---------
 src/Test/Spec/Tree.purs             |  11 +-
 test/Main.purs                      |  30 ++---
 4 files changed, 197 insertions(+), 170 deletions(-)

diff --git a/src/Test/Spec/Reporter/Console.purs b/src/Test/Spec/Reporter/Console.purs
index a6c1d07..01c3d00 100644
--- a/src/Test/Spec/Reporter/Console.purs
+++ b/src/Test/Spec/Reporter/Console.purs
@@ -2,120 +2,132 @@ module Test.Spec.Reporter.Console (consoleReporter) where
 
 import Prelude
 
-import Control.Monad.State (get, put)
-import Control.Monad.Writer (class MonadWriter, execWriter, tell)
-import Data.Array (all, foldMap, groupBy, length, mapMaybe, null, sortBy)
-import Data.Array as Arr
-import Data.Array.NonEmpty as NEA
+import Control.Monad.State (class MonadState, get, put)
+import Control.Monad.Writer (class MonadWriter)
+import Data.Array (all)
 import Data.Foldable (for_, intercalate)
-import Data.Function (on)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
+import Data.Map (Map)
+import Data.Map as Map
 import Data.Maybe (Maybe(..), isJust)
-import Data.String (split, Pattern(..))
+import Data.Tuple (uncurry)
 import Effect.Exception as Error
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
-import Test.Spec.Console (moveUpAndClearDown, withAttrs)
+import Test.Spec.Console (tellLn, withAttrs)
 import Test.Spec.Reporter.Base (defaultReporter)
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
-import Test.Spec.Runner.Event (Execution)
+import Test.Spec.Runner.Event (Execution(..))
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Summary (Summary(..))
 import Test.Spec.Summary as Summary
-import Test.Spec.Tree (Tree, Path, parentSuiteName, removeLastIndex)
+import Test.Spec.Tree (Path, Tree, parentSuite, parentSuiteName)
 
 data RunningItem
-  = RunningTest Execution Path String (Maybe Result)
-  | PendingTest Path String
-  | RunningSuite Execution Path String Boolean
-
-runningItemPath :: RunningItem -> Path
-runningItemPath = case _ of
-  RunningTest _ p _ _ -> p
-  PendingTest p _ -> p
-  RunningSuite _ p _ _ -> p
+  = RunningTest String (Maybe Result)
+  | RunningPending String
+  | RunningSuite String Boolean
 
 derive instance runningItemGeneric :: Generic RunningItem _
 instance runningItemShow :: Show RunningItem where show = genericShow
 
-initialState :: Array RunningItem
-initialState = []
+
+data PrintAction
+  = PrintTest String Result
+  | PrintPending String
+
+derive instance printActionGeneric :: Generic PrintAction _
+instance printActionShow :: Show PrintAction where show = genericShow
+
+print
+  :: forall s m
+   . MonadState { lastPrintedSuitePath :: Maybe Path | s} m
+  => MonadWriter String m
+  => Path
+  -> PrintAction
+  -> m Unit
+print path a = do
+  for_ (parentSuite path) \suite -> do
+    s <- get
+    case s.lastPrintedSuitePath of
+      Just p | p == suite.path -> pure unit
+      _ -> do
+        withAttrs [1, 35] $ tellLn
+          $ intercalate " » " (parentSuiteName suite.path <> [suite.name])
+        put s{lastPrintedSuitePath = Just suite.path}
+  case a of
+    PrintTest name (Success speed ms) -> do
+      tellLn $ "  " <> colored Color.Checkmark "✓︎ " <> colored Color.Pass name
+    PrintTest name (Failure err) -> do
+      tellLn $ "  " <> colored Color.Fail ("✗ " <> name <> ":")
+      tellLn $ ""
+      tellLn $ "  " <> colored Color.Fail (Error.message err)
+    PrintPending name -> do
+      tellLn $ "  " <> colored Color.Pending ("~ " <> name)
+
+type State = { runningItem :: Map Path RunningItem, lastPrintedSuitePath :: Maybe Path}
+
+initialState :: State
+initialState = { runningItem: Map.empty, lastPrintedSuitePath: Nothing }
 
 consoleReporter :: Reporter
 consoleReporter = defaultReporter initialState case _ of
-  Event.Suite execution path name -> do
-    modifyRunningItems (\r ->
-      (case Arr.unsnoc r of
-        Just {init, last: RunningSuite _ _ _ _} -> init
-        _ -> r) <> [RunningSuite execution path name false]
-      )
+  Event.Suite Sequential path name ->
+    pure unit
+  Event.Suite Parallel path name -> do
+    modifyRunningItems $ Map.insert path $ RunningSuite name false
   Event.SuiteEnd path -> do
-    modifyRunningItems $ map case _ of
-      RunningSuite e p n _ | p == path -> RunningSuite e p n true
-      a -> a
-  Event.Test execution path name -> do
-    modifyRunningItems (_ <> [RunningTest execution path name Nothing])
+    modifyRunningItems $ flip Map.update path case _ of
+      RunningSuite n _ -> Just $ RunningSuite n true
+      a -> Nothing
+  Event.Test Sequential path name -> do
+    pure unit
+  Event.Test Parallel path name -> do
+    modifyRunningItems $ Map.insert path $ RunningTest name Nothing
   Event.TestEnd path name res -> do
-    modifyRunningItems $ map case _ of
-      RunningTest e p n _ | p == path -> RunningTest e p n $ Just res
-      a -> a
+    {runningItem} <- get
+    case Map.lookup path runningItem of
+      Just (RunningTest n _) ->
+        modifyRunningItems $ Map.insert path $ RunningTest n $ Just res
+      _ ->
+        print path $ PrintTest name res
   Event.Pending path name -> do
-    modifyRunningItems (_ <> [PendingTest path name])
+    {runningItem} <- get
+    if Map.isEmpty runningItem
+      then print path $ PrintPending name
+      else modifyRunningItems $ Map.insert path $ RunningPending name
   Event.End results -> printSummary results
   Event.Start _ -> pure unit
   where
-
   modifyRunningItems f = do
-    currentRunningItems <- get
-    let nextRunningItems = f currentRunningItems
-    put if (allRunningItemsAreFinished nextRunningItems) then [] else nextRunningItems
-    unless (null currentRunningItems) do
-      tell $ moveUpAndClearDown $ lineCount $ execWriter $ writeRunningItems currentRunningItems
-    writeRunningItems nextRunningItems
-    where
-      lineCount str = length (split (Pattern "\n") str) - 1
-      allRunningItemsAreFinished = all case _ of
-        PendingTest _ _ -> true
-        RunningTest _ _ _ res -> isJust res
-        RunningSuite _ _ _ finished -> finished
-
-  writeRunningItems :: forall m. MonadWriter String m => Array RunningItem -> m Unit
-  writeRunningItems runningItems = do
-    for_ (groupeBySuite $ sortByPath $ removeSuitesNodes runningItems) \g -> do
-      logCrumbs (parentSuiteName $ runningItemPath $ NEA.head g)
-      for_ (NEA.toArray g ) case _ of
-        PendingTest _ name -> tell $ asLine
-          [ "  " <> (colored Color.Pending $ "~ " <> name)
-          ]
-        RunningTest _ _ name Nothing -> tell $ asLine
-          [ "  " <> colored Color.Pending "⥀ " <> name
-          ]
-        RunningTest _ _ name (Just (Success _ _)) -> tell $ asLine
-          [ "  " <> colored Color.Checkmark "✓︎ " <> colored Color.Pass name
-          ]
-        RunningTest _ _ name (Just (Failure err)) -> tell $ asLine
-          [ "  " <> colored Color.Fail ("✗ " <> name <> ":")
-          , ""
-          , "  " <> colored Color.Fail (Error.message err)
-          ]
-        RunningSuite _ _ _ _ -> pure unit
+    s <- get
+    let
+      nextRunningItems = f s.runningItem
+      allFinished = all runningItemIsFinished nextRunningItems
+    put s{runningItem = if allFinished then Map.empty else nextRunningItems}
+
+    when allFinished do
+      for_ (asArray $ Map.toUnfoldable nextRunningItems) $ uncurry \path -> case _ of
+        RunningTest name (Just res) -> print path $ PrintTest name res
+        RunningPending name -> print path $ PrintPending name
+        _ -> pure unit
     where
-      removeSuitesNodes = mapMaybe case _ of
-        RunningSuite _ _ _ _ -> Nothing
-        a -> Just a
-      sortByPath = sortBy \a b -> on compare (runningItemPath) a b
-      groupeBySuite = groupBy (on (==) $ runningItemPath >>> removeLastIndex)
+      asArray = identity :: Array ~> Array
+      runningItemIsFinished = case _ of
+        RunningPending _ -> true
+        RunningTest _ res -> isJust res
+        RunningSuite _ finished -> finished
 
 
 printSummary :: forall m. MonadWriter String m => Array (Tree Void Result) -> m Unit
 printSummary = Summary.summarize >>> \(Count {passed, failed, pending}) -> do
-  tell $ asLine [""]
-  withAttrs [1] $ tell $ asLine ["Summary"]
+  tellLn ""
+  withAttrs [1] $ tellLn "Summary"
   printPassedFailed passed failed
   printPending pending
-  tell $ asLine [""]
+  tellLn ""
   where
     printPassedFailed :: Int -> Int -> m Unit
     printPassedFailed p f = do
@@ -123,19 +135,13 @@ printSummary = Summary.summarize >>> \(Count {passed, failed, pending}) -> do
           testStr = pluralize "test" total
           amount = show p <> "/" <> (show total) <> " " <> testStr <> " passed"
           attrs = if f > 0 then [31] else [32]
-      withAttrs attrs $ tell $ asLine [amount]
+      withAttrs attrs $ tellLn amount
 
     printPending :: Int -> m Unit
     printPending p
-      | p > 0     = withAttrs [33] $ tell $ asLine [show p <> " " <> pluralize "test" p <> " pending"]
+      | p > 0     = withAttrs [33] $ tellLn $ show p <> " " <> pluralize "test" p <> " pending"
       | otherwise = pure unit
 
-logCrumbs :: forall m. MonadWriter String m => Array String -> m Unit
-logCrumbs crumbs = withAttrs [1, 35] $ tell $ asLine [intercalate " » " crumbs]
-
-asLine :: Array String -> String
-asLine = foldMap (_ <> "\n")
-
-pluralize :: String -> Int -> String
-pluralize s 1 = s
-pluralize s _ = s <> "s"
+    pluralize :: String -> Int -> String
+    pluralize s 1 = s
+    pluralize s _ = s <> "s"
diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index 7c6bad1..9cab0b0 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -2,21 +2,21 @@ module Test.Spec.Reporter.Spec (specReporter) where
 
 import Prelude
 
-import Control.Monad.State (get, put)
-import Control.Monad.Writer (class MonadWriter, execWriter, tell)
-import Data.Array (all, length, null, sortBy)
+import Control.Monad.State (class MonadState, get, modify, put)
+import Control.Monad.Writer (class MonadWriter)
+import Data.Array (all, length)
 import Data.Array as Array
 import Data.Foldable (for_)
-import Data.Function (on)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
+import Data.Map (Map)
+import Data.Map as Map
 import Data.Maybe (Maybe(..), isJust)
-import Data.String (split, Pattern(..))
 import Data.String.CodeUnits as CodeUnits
-import Effect.Exception as Error
+import Data.Tuple (uncurry)
 import Test.Spec.Color (colored)
 import Test.Spec.Color as Color
-import Test.Spec.Console (moveUpAndClearDown, tellLn)
+import Test.Spec.Console (tellLn)
 import Test.Spec.Reporter.Base (defaultReporter, defaultSummary)
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
@@ -26,74 +26,94 @@ import Test.Spec.Speed as Speed
 import Test.Spec.Tree (Path)
 
 data RunningItem
-  = RunningTest Execution Path String (Maybe Result)
-  | PendingTest Path String
-  | RunningSuite Execution Path String Boolean
-
-runningItemPath :: RunningItem -> Path
-runningItemPath = case _ of
-  RunningTest _ p _ _ -> p
-  PendingTest p _ -> p
-  RunningSuite _ p _ _ -> p
+  = RunningTest String (Maybe Result)
+  | RunningPending String
+  | RunningSuite String Boolean
 
 derive instance runningItemGeneric :: Generic RunningItem _
 instance runningItemShow :: Show RunningItem where show = genericShow
 
-initialState :: { runningItem :: Array RunningItem, numFailures :: Int }
-initialState = { runningItem: [], numFailures: 0}
+type State = { runningItem :: Map Path RunningItem, numFailures :: Int }
+
+initialState :: State
+initialState = { runningItem: Map.empty, numFailures: 0}
+
+data PrintAction
+  = PrintSuite Path String
+  | PrintTest Path String Result
+  | PrintPending Path String
+
+derive instance printActionGeneric :: Generic PrintAction _
+instance printActionShow :: Show PrintAction where show = genericShow
+
+print
+  :: forall s m
+   . MonadState { numFailures :: Int | s } m
+  => MonadWriter String m
+  => PrintAction
+  -> m Unit
+print = case _ of
+  PrintSuite path name -> do
+    tellLn $ indent path <> name
+  PrintTest path name (Success speed ms) -> do
+    let
+      speedDetails = case speed of
+        Speed.Fast -> ""
+        _ -> colored (Speed.toColor speed) $ " (" <> show ms <> "ms)"
+    tellLn $ (indent path) <> colored Color.Checkmark "✓︎ " <> colored Color.Pass name <> speedDetails
+  PrintTest path name (Failure err) -> do
+    {numFailures} <- modify \s -> s{numFailures = s.numFailures +1}
+    tellLn $ (indent path) <> colored Color.Fail (show numFailures <> ") " <> name)
+  PrintPending path name -> do
+    tellLn $ (indent path) <> (colored Color.Pending $ "- " <> name)
+  where
+    indent path = CodeUnits.fromCharArray $ Array.replicate (length path) ' '
 
 specReporter :: Reporter
 specReporter = defaultReporter initialState case _ of
-  Event.Suite execution path name -> do
-    modifyRunningItems (_ <> [RunningSuite execution path name false])
+  Event.Suite Sequential path name -> do
+    print $ PrintSuite path name
+  Event.Suite Parallel path name -> do
+    modifyRunningItems $ Map.insert path $ RunningSuite name false
   Event.SuiteEnd path -> do
-    modifyRunningItems $ map case _ of
-      RunningSuite e p n _ | p == path -> RunningSuite e p n true
-      a -> a
-  Event.Test execution path name -> do
-    modifyRunningItems (_ <> [RunningTest execution path name Nothing])
+    modifyRunningItems $ flip Map.update path case _ of
+      RunningSuite n _ -> Just $ RunningSuite n true
+      a -> Nothing
+  Event.Test Sequential path name -> do
+    pure unit
+  Event.Test Parallel path name -> do
+    modifyRunningItems $ Map.insert path $ RunningTest name Nothing
   Event.TestEnd path name res -> do
-    modifyRunningItems $ map case _ of
-      RunningTest e p n _ | p == path -> RunningTest e p n $ Just res
-      a -> a
+    {runningItem} <- get
+    case Map.lookup path runningItem of
+      Just (RunningTest n _) ->
+        modifyRunningItems $ Map.insert path $ RunningTest n $ Just res
+      _ ->
+        print $ PrintTest path name res
   Event.Pending path name -> do
-    modifyRunningItems (_ <> [PendingTest path name])
+    {runningItem} <- get
+    if Map.isEmpty runningItem
+      then print $ PrintPending path name
+      else modifyRunningItems $ Map.insert path $ RunningPending name
   Event.End results -> defaultSummary results
   Event.Start _ -> pure unit
   where
   modifyRunningItems f = do
     s <- get
-    let nextRunningItems = f s.runningItem
-    put s{runningItem = if allRunningItemsAreFinished nextRunningItems then [] else nextRunningItems}
-    unless (null s.runningItem) do
-      tell $ moveUpAndClearDown $ lineCount $ execWriter $ writeRunningItems s.runningItem
-    writeRunningItems nextRunningItems
-    where
-      lineCount str = length (split (Pattern "\n") str) - 1
-      allRunningItemsAreFinished = all case _ of
-        PendingTest _ _ -> true
-        RunningTest _ _ _ res -> isJust res
-        RunningSuite Sequential _ _ finished -> true
-        RunningSuite Parallel _ _ finished -> finished
+    let
+      nextRunningItems = f s.runningItem
+      allFinished = all runningItemIsFinished nextRunningItems
+    put s{runningItem = if allFinished then Map.empty else nextRunningItems}
 
-  writeRunningItems :: forall m. MonadWriter String m => Array RunningItem -> m Unit
-  writeRunningItems runningItems = do
-    for_ (sortByPath runningItems) case _ of
-      PendingTest path name -> do
-        tellLn $ (indent path) <> (colored Color.Pending $ "- " <> name)
-      RunningTest e path name Nothing -> do
-        tellLn $ (indent path) <> colored Color.Pending "⥀ " <> name
-      RunningTest e path name (Just (Success speed ms)) -> do
-        let
-          speedDetails = case speed of
-            Speed.Fast -> ""
-            _ -> colored (Speed.toColor speed) $ " (" <> show ms <> "ms)"
-        tellLn $ (indent path) <> colored Color.Checkmark "✓︎ " <> colored Color.Pass name <> speedDetails
-      RunningTest e path name (Just (Failure err)) -> do
-        tellLn $ (indent path) <> colored Color.Fail ("✗ " <> name <> ":")
-        tellLn $ ""
-        tellLn $ (indent path) <> colored Color.Fail (Error.message err)
-      RunningSuite e path name _ -> tellLn $ (indent path) <> name
+    when allFinished do
+      for_ (asArray $ Map.toUnfoldable nextRunningItems) $ uncurry \path -> case _ of
+        RunningTest name (Just res) -> print $ PrintTest path name res
+        RunningPending name -> print $ PrintPending path name
+        RunningSuite name true -> print $ PrintSuite path name
+        _ -> pure unit
     where
-      sortByPath = sortBy \a b -> on compare (runningItemPath) a b
-      indent path = CodeUnits.fromCharArray $ Array.replicate (length path) ' '
+      asArray = identity :: Array ~> Array
+      runningItemIsFinished = case _ of
+        RunningPending _ -> true
+        RunningTest _ res -> isJust res
+        RunningSuite _ finished -> finished
diff --git a/src/Test/Spec/Tree.purs b/src/Test/Spec/Tree.purs
index 903f717..f800e1a 100644
--- a/src/Test/Spec/Tree.purs
+++ b/src/Test/Spec/Tree.purs
@@ -10,7 +10,7 @@ module Test.Spec.Tree
   , PathItem(..)
   , Path
   , parentSuiteName
-  , removeLastIndex
+  , parentSuite
   ) where
 
 import Prelude
@@ -128,7 +128,8 @@ type Path = Array PathItem
 parentSuiteName :: Path -> Array String
 parentSuiteName = mapMaybe (un PathItem >>> _.name)
 
-removeLastIndex :: Path -> Tuple Path (Maybe String)
-removeLastIndex p = case unsnoc p of
-  Nothing -> Tuple [] Nothing
-  Just {init, last: PathItem {name}} -> Tuple init name
+parentSuite :: Path -> Maybe { path :: Path, name :: String }
+parentSuite = flip foldr Nothing case _, _ of
+  PathItem {name: Just name}, Nothing -> Just {path: [], name}
+  PathItem {name: Nothing}, Nothing -> Nothing
+  p, Just acc -> Just acc{path = [p] <> acc.path}
diff --git a/test/Main.purs b/test/Main.purs
index d4cfab4..b946ff4 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -17,34 +17,34 @@ import Test.Spec.Runner (defaultConfig, run')
 import Test.Spec.RunnerSpec (runnerSpec)
 
 main :: Effect Unit
-main = launchAff_ $ un Identity $ run' (defaultConfig{timeout = Nothing}) [ specReporter ] do
+main = launchAff_ $ un Identity $ run' (defaultConfig{exit= false,timeout = Nothing}) [ specReporter ] do
   runnerSpec
   assertionSpec
   hookSpec
   hoistSpecSpec
   describe "g" do
-    it "g.1" $ delay $ Milliseconds 500.0
-    it "g.2" $ delay $ Milliseconds 500.0
+    it "g.1" $ delay $ Milliseconds 1500.0
+    it "g.2" $ delay $ Milliseconds 1500.0
     pending "g.3"
   describe "p" do
     describe "pp" do
       describe "ppp" do
         pending "ppp.1"
   describe "a" $ parallel do
-    it "a.err" $ delay (Milliseconds 300.0) *> 1 `shouldEqual` 2
-    it "a.1" $ delay $ Milliseconds 500.0
+    it "a.err" $ delay (Milliseconds 1300.0) *> 1 `shouldEqual` 2
+    it "a.1" $ delay $ Milliseconds 1500.0
     it "a.2" $ delay $ Milliseconds 1500.0
+    describe "d" $ sequential do
+      it "d.1" $ delay $ Milliseconds 1500.0
+      it "d.2" $ delay $ Milliseconds 1500.0
     describe "z" do
-      it "z.1" $ delay $ Milliseconds 700.0
-      it "z.2" $ delay $ Milliseconds 900.0
+      it "z.1" $ delay $ Milliseconds 1700.0
+      it "z.2" $ delay $ Milliseconds 1900.0
       pending "z.3"
-      it "z.err" $ delay (Milliseconds 300.0) *> 1 `shouldEqual` 2
+      it "z.err" $ delay (Milliseconds 1300.0) *> 1 `shouldEqual` 2
     describe "j" do
-      it "j.1" $ delay $ Milliseconds 1000.0
-      it "j.2" $ delay $ Milliseconds 400.0
-    describe "d" $ sequential do
-      it "d.1" $ delay $ Milliseconds 500.0
-      it "d.2" $ delay $ Milliseconds 500.0
+      it "j.1" $ delay $ Milliseconds 11000.0
+      it "j.2" $ delay $ Milliseconds 1400.0
   describe "k" do
-    it "k.1" $ delay $ Milliseconds 500.0
-    it "k.2" $ delay $ Milliseconds 500.0
+    it "k.1" $ delay $ Milliseconds 1500.0
+    it "k.2" $ delay $ Milliseconds 1500.0

From 6baa794af3efef5d1b89606b982b1cdc7ef93d9f Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 15 Jan 2019 17:13:25 +0400
Subject: [PATCH 19/39] refactor styling

---
 src/Test/Spec/Color.purs            | 44 -----------------------------
 src/Test/Spec/Console.purs          | 37 ++----------------------
 src/Test/Spec/Reporter/Base.purs    | 12 ++++----
 src/Test/Spec/Reporter/Console.purs | 24 ++++++++--------
 src/Test/Spec/Reporter/Dot.purs     | 10 +++----
 src/Test/Spec/Reporter/Spec.purs    | 12 ++++----
 src/Test/Spec/Runner.purs           | 28 +++++++++---------
 src/Test/Spec/Speed.purs            | 16 ++++-------
 src/Test/Spec/Style.purs            | 41 +++++++++++++++++++++++++++
 9 files changed, 93 insertions(+), 131 deletions(-)
 delete mode 100644 src/Test/Spec/Color.purs
 create mode 100644 src/Test/Spec/Style.purs

diff --git a/src/Test/Spec/Color.purs b/src/Test/Spec/Color.purs
deleted file mode 100644
index 53b0acf..0000000
--- a/src/Test/Spec/Color.purs
+++ /dev/null
@@ -1,44 +0,0 @@
-module Test.Spec.Color where
-
-import Ansi.Codes (GraphicsParam(..), colorSuffix, graphicsParamToString, prefix)
-import Data.Semigroup ((<>))
-import Data.Show (show)
-import Prelude ((<<<))
-
-data Color
- = Pass
- | Fail
- | Pending
- | Suite
- | ErrorTitle
- | ErrorMessage
- | ErrorStack
- | Checkmark
- | Fast
- | Medium
- | Slow
- | Green
- | Light
-
-code :: Color -> Int
-code Pass         = 2
-code Fail         = 31
-code Pending      = 36
-code Suite        = 0
-code ErrorTitle   = 0
-code ErrorMessage = 31
-code ErrorStack   = 2
-code Checkmark    = 32
-code Fast         = 2
-code Medium       = 33
-code Slow         = 31
-code Green        = 32
-code Light        = 2
-
-colored :: Color -> String -> String
-colored = _colored <<< code
-
-_colored :: Int -> String -> String
-_colored c str = wrap (show c) <> str <> wrap (graphicsParamToString Reset)
-  where
-  wrap s = prefix <> s <> colorSuffix
diff --git a/src/Test/Spec/Console.purs b/src/Test/Spec/Console.purs
index 3ded374..e5df10f 100644
--- a/src/Test/Spec/Console.purs
+++ b/src/Test/Spec/Console.purs
@@ -1,19 +1,14 @@
 module Test.Spec.Console
-  ( setAttr
-  , reset
-  , withAttrs
-  , tellLn
+  ( tellLn
   , tellLns
   , write
   , logWriter
-  , moveUpAndClearDown
   ) where
 
 import Prelude
 
-import Ansi.Codes (EraseParam(..), EscapeCode(..), colorSuffix, escapeCodeToString, prefix)
 import Control.Monad.Writer (class MonadWriter, WriterT, execWriterT, tell)
-import Data.Foldable (foldMap, foldr, for_)
+import Data.Foldable (for_)
 import Effect (Effect)
 import Effect.Class (class MonadEffect, liftEffect)
 
@@ -22,11 +17,6 @@ foreign import write :: String -> Effect Unit
 logWriter :: forall m. MonadEffect m => WriterT String m Unit -> m Unit
 logWriter = execWriterT >=> write >>> liftEffect
 
-moveUpAndClearDown :: Int -> String
-moveUpAndClearDown lines = foldMap escapeCodeToString case lines of
-  0 -> [ HorizontalAbsolute 0, EraseData ToEnd ]
-  n -> [ PreviousLine lines, EraseData ToEnd ]
-
 tellLn
   :: forall m
    . MonadWriter String m
@@ -40,26 +30,3 @@ tellLns
   => Array String
   -> m Unit
 tellLns l = for_ l $ (_<> "\n") >>> tell
-
-
-setAttr
-  :: forall m
-   . MonadWriter String m
-  => Int
-  -> m Unit
-setAttr code = tell $ prefix <> show code <> colorSuffix
-
-reset
-  :: forall m
-   . MonadWriter String m
-  => m Unit
-reset = setAttr 0
-
-withAttrs
-  :: forall m
-   . MonadWriter String m
-  => Array Int
-  -> m Unit
-  -> m Unit
-withAttrs as r = foldr iter r as
-  where iter attr acc = setAttr attr *> acc *> reset
diff --git a/src/Test/Spec/Reporter/Base.purs b/src/Test/Spec/Reporter/Base.purs
index 60a4ad7..4039045 100644
--- a/src/Test/Spec/Reporter/Base.purs
+++ b/src/Test/Spec/Reporter/Base.purs
@@ -24,8 +24,8 @@ import Pipes (await, yield)
 import Pipes.Core (Pipe)
 import Test.Spec (Tree)
 import Test.Spec as S
-import Test.Spec.Color (colored)
-import Test.Spec.Color as Color
+import Test.Spec.Style (styled)
+import Test.Spec.Style as Style
 import Test.Spec.Console (tellLn)
 import Test.Spec.Console as Console
 import Test.Spec.Result (Result(..))
@@ -48,9 +48,9 @@ defaultSummary :: forall m
 defaultSummary xs = do
   case Summary.summarize xs of
     (Count {passed, failed, pending}) -> do
-      when (passed  > 0) $ tellLn $ colored Color.Green   $ show passed  <> " passing"
-      when (pending > 0) $ tellLn $ colored Color.Pending $ show pending <> " pending"
-      when (failed  > 0) $ tellLn $ colored Color.Fail    $ show failed  <> " failed"
+      when (passed  > 0) $ tellLn $ styled Style.green $ show passed  <> " passing"
+      when (pending > 0) $ tellLn $ styled Style.cyan $ show pending <> " pending"
+      when (failed  > 0) $ tellLn $ styled Style.red $ show failed  <> " failed"
   tellLn ""
   printFailures xs
 
@@ -73,7 +73,7 @@ printFailures xs' = evalStateT (go xs') {i: 0, crumbs: []}
         {i, crumbs} <- State.modify \s -> s{i = s.i +1}
         let label = intercalate " " (reverse $ n:crumbs)
         tellLn $ show i <> ") " <> label
-        tellLn $ colored Color.ErrorMessage $ indent 2 <> Error.message err
+        tellLn $ styled Style.red $ indent 2 <> Error.message err
       S.Leaf _ _ -> pure unit
 
 -- | Monadic left scan with state.
diff --git a/src/Test/Spec/Reporter/Console.purs b/src/Test/Spec/Reporter/Console.purs
index 01c3d00..e037a45 100644
--- a/src/Test/Spec/Reporter/Console.purs
+++ b/src/Test/Spec/Reporter/Console.purs
@@ -13,9 +13,9 @@ import Data.Map as Map
 import Data.Maybe (Maybe(..), isJust)
 import Data.Tuple (uncurry)
 import Effect.Exception as Error
-import Test.Spec.Color (colored)
-import Test.Spec.Color as Color
-import Test.Spec.Console (tellLn, withAttrs)
+import Test.Spec.Style (styled)
+import Test.Spec.Style as Style
+import Test.Spec.Console (tellLn)
 import Test.Spec.Reporter.Base (defaultReporter)
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
@@ -54,18 +54,18 @@ print path a = do
     case s.lastPrintedSuitePath of
       Just p | p == suite.path -> pure unit
       _ -> do
-        withAttrs [1, 35] $ tellLn
+        tellLn $ styled (Style.bold <> Style.magenta)
           $ intercalate " » " (parentSuiteName suite.path <> [suite.name])
         put s{lastPrintedSuitePath = Just suite.path}
   case a of
     PrintTest name (Success speed ms) -> do
-      tellLn $ "  " <> colored Color.Checkmark "✓︎ " <> colored Color.Pass name
+      tellLn $ "  " <> styled Style.green "✓︎ " <> styled Style.dim name
     PrintTest name (Failure err) -> do
-      tellLn $ "  " <> colored Color.Fail ("✗ " <> name <> ":")
+      tellLn $ "  " <> styled Style.red ("✗ " <> name <> ":")
       tellLn $ ""
-      tellLn $ "  " <> colored Color.Fail (Error.message err)
+      tellLn $ "  " <> styled Style.red (Error.message err)
     PrintPending name -> do
-      tellLn $ "  " <> colored Color.Pending ("~ " <> name)
+      tellLn $ "  " <> styled Style.cyan ("~ " <> name)
 
 type State = { runningItem :: Map Path RunningItem, lastPrintedSuitePath :: Maybe Path}
 
@@ -124,7 +124,7 @@ consoleReporter = defaultReporter initialState case _ of
 printSummary :: forall m. MonadWriter String m => Array (Tree Void Result) -> m Unit
 printSummary = Summary.summarize >>> \(Count {passed, failed, pending}) -> do
   tellLn ""
-  withAttrs [1] $ tellLn "Summary"
+  tellLn $ styled Style.bold "Summary"
   printPassedFailed passed failed
   printPending pending
   tellLn ""
@@ -134,12 +134,12 @@ printSummary = Summary.summarize >>> \(Count {passed, failed, pending}) -> do
       let total = p + f
           testStr = pluralize "test" total
           amount = show p <> "/" <> (show total) <> " " <> testStr <> " passed"
-          attrs = if f > 0 then [31] else [32]
-      withAttrs attrs $ tellLn amount
+          color = if f > 0 then Style.red else Style.dim
+      tellLn $ styled color amount
 
     printPending :: Int -> m Unit
     printPending p
-      | p > 0     = withAttrs [33] $ tellLn $ show p <> " " <> pluralize "test" p <> " pending"
+      | p > 0     = tellLn $ styled Style.yellow $ show p <> " " <> pluralize "test" p <> " pending"
       | otherwise = pure unit
 
     pluralize :: String -> Int -> String
diff --git a/src/Test/Spec/Reporter/Dot.purs b/src/Test/Spec/Reporter/Dot.purs
index 6581953..c95e872 100644
--- a/src/Test/Spec/Reporter/Dot.purs
+++ b/src/Test/Spec/Reporter/Dot.purs
@@ -4,8 +4,8 @@ import Prelude
 
 import Control.Monad.State (modify)
 import Control.Monad.Writer (tell)
-import Test.Spec.Color (colored)
-import Test.Spec.Color as Color
+import Test.Spec.Style (styled)
+import Test.Spec.Style as Style
 import Test.Spec.Console (tellLn)
 import Test.Spec.Reporter.Base (defaultReporter)
 import Test.Spec.Result (Result(..))
@@ -17,9 +17,9 @@ type DotReporterConfig = { width :: Int }
 
 dotReporter :: DotReporterConfig -> Reporter
 dotReporter { width } = defaultReporter (-1) case _ of
-  Event.TestEnd _ _ (Success speed _) -> wrap $ colored (Speed.toColor speed) "."
-  Event.TestEnd _ _ (Failure _) -> wrap $ colored Color.Fail "!"
-  Event.Pending _ _ -> wrap $ colored Color.Pass ","
+  Event.TestEnd _ _ (Success speed _) -> wrap $ styled (Speed.toStyle speed) "."
+  Event.TestEnd _ _ (Failure _) -> wrap $ styled Style.red "!"
+  Event.Pending _ _ -> wrap $ styled Style.dim ","
   Event.End _ -> tellLn ""
   _ -> pure unit
   where
diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index 9cab0b0..4edcc9b 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -14,8 +14,8 @@ import Data.Map as Map
 import Data.Maybe (Maybe(..), isJust)
 import Data.String.CodeUnits as CodeUnits
 import Data.Tuple (uncurry)
-import Test.Spec.Color (colored)
-import Test.Spec.Color as Color
+import Test.Spec.Style (styled)
+import Test.Spec.Style as Style
 import Test.Spec.Console (tellLn)
 import Test.Spec.Reporter.Base (defaultReporter, defaultSummary)
 import Test.Spec.Result (Result(..))
@@ -59,13 +59,13 @@ print = case _ of
     let
       speedDetails = case speed of
         Speed.Fast -> ""
-        _ -> colored (Speed.toColor speed) $ " (" <> show ms <> "ms)"
-    tellLn $ (indent path) <> colored Color.Checkmark "✓︎ " <> colored Color.Pass name <> speedDetails
+        _ -> styled (Speed.toStyle speed) $ " (" <> show ms <> "ms)"
+    tellLn $ (indent path) <> styled Style.green "✓︎ " <> styled Style.dim name <> speedDetails
   PrintTest path name (Failure err) -> do
     {numFailures} <- modify \s -> s{numFailures = s.numFailures +1}
-    tellLn $ (indent path) <> colored Color.Fail (show numFailures <> ") " <> name)
+    tellLn $ (indent path) <> styled Style.red (show numFailures <> ") " <> name)
   PrintPending path name -> do
-    tellLn $ (indent path) <> (colored Color.Pending $ "- " <> name)
+    tellLn $ (indent path) <> (styled Style.cyan $ "- " <> name)
   where
     indent path = CodeUnits.fromCharArray $ Array.replicate (length path) ' '
 
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index a92b2ba..da00bdb 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -1,20 +1,20 @@
 module Test.Spec.Runner
-       ( run
-       , run'
-       , runSpec
-       , runSpec'
-       , defaultConfig
-       , timeout
-       , Config
-       , TestEvents
-       , Reporter
-       ) where
+  ( run
+  , run'
+  , runSpec
+  , runSpec'
+  , defaultConfig
+  , timeout
+  , Config
+  , TestEvents
+  , Reporter
+  ) where
 
 import Prelude
 
 import Control.Alternative ((<|>))
 import Control.Monad.Trans.Class (lift)
-import Control.Monad.Writer (execWriterT, tell)
+import Control.Monad.Writer (execWriterT)
 import Control.Parallel (parTraverse, parallel, sequential)
 import Data.Array (groupBy, mapWithIndex)
 import Data.Array.NonEmpty as NEA
@@ -35,7 +35,9 @@ import Pipes ((>->), yield)
 import Pipes.Core (Pipe, Producer, (//>))
 import Pipes.Core (runEffectRec) as P
 import Test.Spec (Item(..), Spec, SpecM, SpecTree, Tree(..))
-import Test.Spec.Console (logWriter, withAttrs)
+import Test.Spec.Style (styled)
+import Test.Spec.Style as Style
+import Test.Spec.Console (logWriter, tellLn)
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner.Event (Event, Execution(..))
 import Test.Spec.Runner.Event as Event
@@ -194,7 +196,7 @@ run' config reporters spec = _run config spec <#> \runner -> do
   where
     onError :: Error -> Aff Unit
     onError err = liftEffect do
-       logWriter $ withAttrs [31] $ tell $ show err <> "\n"
+       logWriter $ tellLn $ styled Style.red (show err)
        when config.exit (exit 1)
 
     onSuccess :: Array (Tree Void Result) -> Aff Unit
diff --git a/src/Test/Spec/Speed.purs b/src/Test/Spec/Speed.purs
index 5e0bdf8..09d01f2 100644
--- a/src/Test/Spec/Speed.purs
+++ b/src/Test/Spec/Speed.purs
@@ -5,8 +5,8 @@ import Prelude
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Eq (genericEq)
 import Data.Generic.Rep.Show (genericShow)
-import Test.Spec.Color (Color)
-import Test.Spec.Color as Color
+import Test.Spec.Style (Style)
+import Test.Spec.Style as Style
 
 data Speed = Fast | Medium | Slow
 
@@ -19,11 +19,7 @@ speedOf thresh ms | ms > thresh     = Slow
 speedOf thresh ms | ms > thresh / 2 = Medium
 speedOf _      _                    = Fast
 
-toColor' :: Int -> Int -> Color
-toColor' thresh ms = toColor $ speedOf thresh ms
-
-toColor :: Speed -> Color
-toColor Fast   = Color.Fast
-toColor Medium = Color.Medium
-toColor Slow   = Color.Slow
-
+toStyle :: Speed -> Style
+toStyle Fast   = Style.dim
+toStyle Medium = Style.yellow
+toStyle Slow   = Style.red
diff --git a/src/Test/Spec/Style.purs b/src/Test/Spec/Style.purs
new file mode 100644
index 0000000..ff623ea
--- /dev/null
+++ b/src/Test/Spec/Style.purs
@@ -0,0 +1,41 @@
+module Test.Spec.Style where
+
+import Prelude
+
+import Ansi.Codes (GraphicsParam, escapeCodeToString)
+import Ansi.Codes as AnsiCode
+import Data.List.NonEmpty as NEL
+import Data.Maybe (Maybe(..))
+
+type Style = Array GraphicsParam
+
+styled :: Style -> String -> String
+styled as str = do
+  case NEL.fromFoldable as of
+    Nothing -> do
+      str
+    Just as' -> do
+      escapeCodeToString (AnsiCode.Graphics as')
+       <> str
+       <> escapeCodeToString (AnsiCode.Graphics $ NEL.singleton AnsiCode.Reset)
+
+red :: Style
+red = [AnsiCode.PForeground AnsiCode.Red]
+
+green :: Style
+green = [AnsiCode.PForeground AnsiCode.Green]
+
+yellow :: Style
+yellow = [AnsiCode.PForeground AnsiCode.Yellow]
+
+cyan :: Style
+cyan = [AnsiCode.PForeground AnsiCode.Cyan]
+
+dim :: Style
+dim = [AnsiCode.PMode AnsiCode.Dim]
+
+bold :: Style
+bold = [AnsiCode.PMode AnsiCode.Bold]
+
+magenta :: Style
+magenta = [AnsiCode.PForeground AnsiCode.Magenta]

From d6bcba266e5a482405f457299fdbef656f3d6dc1 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 15 Jan 2019 17:17:45 +0400
Subject: [PATCH 20/39] restore log in hoistSpec test

---
 test/Test/Spec/HoistSpec.purs | 29 ++++++++++++++---------------
 1 file changed, 14 insertions(+), 15 deletions(-)

diff --git a/test/Test/Spec/HoistSpec.purs b/test/Test/Spec/HoistSpec.purs
index 8578747..f37b805 100644
--- a/test/Test/Spec/HoistSpec.purs
+++ b/test/Test/Spec/HoistSpec.purs
@@ -28,14 +28,13 @@ hoistSpecSpecReaderT = go $ parallel do
     }
   where
     go :: Spec' (ReaderT (String -> Aff Unit) Aff) ~> Spec
-    go = hoistSpec \name m ->
+    go = hoistSpec \cType m ->
       let
-        prefix = case name of
+        prefix = case cType of
           CleanUpWithContext n -> intercalate " > " n <> " (afterAll) "
           TestWithName n -> intercalate " > " $ NAE.toArray n
       in runReaderT m \logMsg -> log $ prefix  <> "| " <> logMsg
 
--- TODO restore `log`
 delaySpecExample
   :: forall m
   . Monad m
@@ -45,29 +44,29 @@ delaySpecExample
   -> Spec' m Unit
 delaySpecExample opts = describe "delay" do
   it "proc 1" do
-    -- opts.log "start 1"
+    opts.log "start 1"
     opts.delay $ Milliseconds $ 500.0 + 300.0 * 1.0
-    -- opts.log "done 1"
+    opts.log "done 1"
   describe "some" do
     it "proc 2" do
-      -- opts.log "start 2"
+      opts.log "start 2"
       opts.delay $ Milliseconds $ 500.0 + 300.0 * 2.0
-      -- opts.log "done 2"
+      opts.log "done 2"
     it "proc 3" do
-      -- opts.log "start 3"
+      opts.log "start 3"
       opts.delay $ Milliseconds $ 500.0 + 300.0 * 3.0
-      -- opts.log "done 3"
+      opts.log "done 3"
     describe "nesting" do
       it "proc 4" do
-        -- opts.log "start 4"
+        opts.log "start 4"
         opts.delay $ Milliseconds $ 500.0 + 300.0 * 4.0
-        -- opts.log "done 4"
+        opts.log "done 4"
     describe "nesting" do
       it "proc 5" do
-        -- opts.log "start 5"
+        opts.log "start 5"
         opts.delay $ Milliseconds $ 500.0 + 300.0 * 5.0
-        -- opts.log "done 5"
+        opts.log "done 5"
       it "proc 6" do
-        -- opts.log "start 6"
+        opts.log "start 6"
         opts.delay $ Milliseconds $ 500.0 + 300.0 * 6.0
-        -- opts.log "done 6"
+        opts.log "done 6"

From 51d385a4cbf1f64c0930de36a8c3437b722beb8a Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 15 Jan 2019 17:22:24 +0400
Subject: [PATCH 21/39] use List instead of Array

---
 src/Test/Spec/Reporter/Base.purs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Test/Spec/Reporter/Base.purs b/src/Test/Spec/Reporter/Base.purs
index 4039045..a486e21 100644
--- a/src/Test/Spec/Reporter/Base.purs
+++ b/src/Test/Spec/Reporter/Base.purs
@@ -10,10 +10,10 @@ import Control.Monad.State (StateT, evalStateT, execStateT)
 import Control.Monad.State as State
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Writer (class MonadWriter, Writer, runWriter)
-import Data.Array ((:), reverse)
 import Data.Array as Array
 import Data.Either (Either(..))
 import Data.Foldable (intercalate, traverse_)
+import Data.List (List(..), (:), reverse)
 import Data.Maybe (Maybe(..))
 import Data.String.CodeUnits as CodeUnits
 import Data.Tuple (Tuple(..))
@@ -24,13 +24,13 @@ import Pipes (await, yield)
 import Pipes.Core (Pipe)
 import Test.Spec (Tree)
 import Test.Spec as S
-import Test.Spec.Style (styled)
-import Test.Spec.Style as Style
 import Test.Spec.Console (tellLn)
 import Test.Spec.Console as Console
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event (Event)
+import Test.Spec.Style (styled)
+import Test.Spec.Style as Style
 import Test.Spec.Summary (Summary(..))
 import Test.Spec.Summary as Summary
 
@@ -59,9 +59,9 @@ printFailures
    . MonadWriter String m
   => Array (Tree Void Result)
   -> m Unit
-printFailures xs' = evalStateT (go xs') {i: 0, crumbs: []}
+printFailures xs' = evalStateT (go xs') {i: 0, crumbs: Nil}
   where
-    go :: Array (Tree Void Result) -> StateT { i :: Int, crumbs :: Array String } m Unit
+    go :: Array (Tree Void Result) -> StateT { i :: Int, crumbs :: List String } m Unit
     go = traverse_ case _ of
       S.Node (Left n) xs -> do
         {crumbs} <- State.get

From 66b67e69e90b5d6d94df93df787c03443aa655fe Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 15 Jan 2019 17:28:23 +0400
Subject: [PATCH 22/39] move indent to Style

---
 src/Test/Spec/Reporter/Base.purs | 7 +------
 src/Test/Spec/Reporter/Spec.purs | 4 +---
 src/Test/Spec/Style.purs         | 5 +++++
 3 files changed, 7 insertions(+), 9 deletions(-)

diff --git a/src/Test/Spec/Reporter/Base.purs b/src/Test/Spec/Reporter/Base.purs
index a486e21..e5f5dfc 100644
--- a/src/Test/Spec/Reporter/Base.purs
+++ b/src/Test/Spec/Reporter/Base.purs
@@ -10,12 +10,10 @@ import Control.Monad.State (StateT, evalStateT, execStateT)
 import Control.Monad.State as State
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Writer (class MonadWriter, Writer, runWriter)
-import Data.Array as Array
 import Data.Either (Either(..))
 import Data.Foldable (intercalate, traverse_)
 import Data.List (List(..), (:), reverse)
 import Data.Maybe (Maybe(..))
-import Data.String.CodeUnits as CodeUnits
 import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Class (liftEffect)
@@ -34,9 +32,6 @@ import Test.Spec.Style as Style
 import Test.Spec.Summary (Summary(..))
 import Test.Spec.Summary as Summary
 
--- TODO: move this somewhere central
-indent :: Int -> String
-indent i = CodeUnits.fromCharArray $ Array.replicate i ' '
 
 defaultUpdate :: forall s. s -> Event -> Effect s
 defaultUpdate s _ = pure s
@@ -73,7 +68,7 @@ printFailures xs' = evalStateT (go xs') {i: 0, crumbs: Nil}
         {i, crumbs} <- State.modify \s -> s{i = s.i +1}
         let label = intercalate " " (reverse $ n:crumbs)
         tellLn $ show i <> ") " <> label
-        tellLn $ styled Style.red $ indent 2 <> Error.message err
+        tellLn $ styled Style.red $ Style.indent 2 <> Error.message err
       S.Leaf _ _ -> pure unit
 
 -- | Monadic left scan with state.
diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index 4edcc9b..cc63bf9 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -5,14 +5,12 @@ import Prelude
 import Control.Monad.State (class MonadState, get, modify, put)
 import Control.Monad.Writer (class MonadWriter)
 import Data.Array (all, length)
-import Data.Array as Array
 import Data.Foldable (for_)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
 import Data.Map (Map)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), isJust)
-import Data.String.CodeUnits as CodeUnits
 import Data.Tuple (uncurry)
 import Test.Spec.Style (styled)
 import Test.Spec.Style as Style
@@ -67,7 +65,7 @@ print = case _ of
   PrintPending path name -> do
     tellLn $ (indent path) <> (styled Style.cyan $ "- " <> name)
   where
-    indent path = CodeUnits.fromCharArray $ Array.replicate (length path) ' '
+    indent = length >>> Style.indent
 
 specReporter :: Reporter
 specReporter = defaultReporter initialState case _ of
diff --git a/src/Test/Spec/Style.purs b/src/Test/Spec/Style.purs
index ff623ea..841dd2b 100644
--- a/src/Test/Spec/Style.purs
+++ b/src/Test/Spec/Style.purs
@@ -4,8 +4,10 @@ import Prelude
 
 import Ansi.Codes (GraphicsParam, escapeCodeToString)
 import Ansi.Codes as AnsiCode
+import Data.Array as Array
 import Data.List.NonEmpty as NEL
 import Data.Maybe (Maybe(..))
+import Data.String.CodeUnits as CodeUnits
 
 type Style = Array GraphicsParam
 
@@ -39,3 +41,6 @@ bold = [AnsiCode.PMode AnsiCode.Bold]
 
 magenta :: Style
 magenta = [AnsiCode.PForeground AnsiCode.Magenta]
+
+indent :: Int -> String
+indent i = CodeUnits.fromCharArray $ Array.replicate i ' '

From 94a08ecbd4c4956711420f1011141cbd1da1ea62 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 15 Jan 2019 17:29:27 +0400
Subject: [PATCH 23/39] remove defaultUpdate

---
 src/Test/Spec/Reporter.purs      | 2 +-
 src/Test/Spec/Reporter/Base.purs | 7 +------
 2 files changed, 2 insertions(+), 7 deletions(-)

diff --git a/src/Test/Spec/Reporter.purs b/src/Test/Spec/Reporter.purs
index 1159883..b2af58d 100644
--- a/src/Test/Spec/Reporter.purs
+++ b/src/Test/Spec/Reporter.purs
@@ -1,6 +1,6 @@
 module Test.Spec.Reporter (module Reexport) where
 
-import Test.Spec.Reporter.Base (defaultUpdate, defaultSummary, defaultReporter) as Reexport
+import Test.Spec.Reporter.Base (defaultSummary, defaultReporter) as Reexport
 import Test.Spec.Reporter.Console (consoleReporter) as Reexport
 import Test.Spec.Reporter.Dot (dotReporter) as Reexport
 import Test.Spec.Reporter.Spec (specReporter) as Reexport
diff --git a/src/Test/Spec/Reporter/Base.purs b/src/Test/Spec/Reporter/Base.purs
index e5f5dfc..54bc661 100644
--- a/src/Test/Spec/Reporter/Base.purs
+++ b/src/Test/Spec/Reporter/Base.purs
@@ -1,6 +1,5 @@
 module Test.Spec.Reporter.Base
-       ( defaultUpdate
-       , defaultSummary
+       ( defaultSummary
        , defaultReporter
        ) where
 
@@ -15,7 +14,6 @@ import Data.Foldable (intercalate, traverse_)
 import Data.List (List(..), (:), reverse)
 import Data.Maybe (Maybe(..))
 import Data.Tuple (Tuple(..))
-import Effect (Effect)
 import Effect.Class (liftEffect)
 import Effect.Exception as Error
 import Pipes (await, yield)
@@ -33,9 +31,6 @@ import Test.Spec.Summary (Summary(..))
 import Test.Spec.Summary as Summary
 
 
-defaultUpdate :: forall s. s -> Event -> Effect s
-defaultUpdate s _ = pure s
-
 defaultSummary :: forall m
    . MonadWriter String m
   => Array (Tree Void Result)

From f6746aabb3322e06611f056c8e88d1507a930416 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 15 Jan 2019 17:53:45 +0400
Subject: [PATCH 24/39] refactor common parts from Console and Spec into
 defaultUpdate

---
 src/Test/Spec/Reporter.purs         |   2 +-
 src/Test/Spec/Reporter/Base.purs    |  85 ++++++++++++++--
 src/Test/Spec/Reporter/Console.purs | 144 ++++++++++------------------
 src/Test/Spec/Reporter/Spec.purs    | 117 ++++++++--------------
 4 files changed, 173 insertions(+), 175 deletions(-)

diff --git a/src/Test/Spec/Reporter.purs b/src/Test/Spec/Reporter.purs
index b2af58d..e2116dc 100644
--- a/src/Test/Spec/Reporter.purs
+++ b/src/Test/Spec/Reporter.purs
@@ -1,6 +1,6 @@
 module Test.Spec.Reporter (module Reexport) where
 
-import Test.Spec.Reporter.Base (defaultSummary, defaultReporter) as Reexport
+import Test.Spec.Reporter.Base (defaultSummary, defaultReporter, defaultUpdate) as Reexport
 import Test.Spec.Reporter.Console (consoleReporter) as Reexport
 import Test.Spec.Reporter.Dot (dotReporter) as Reexport
 import Test.Spec.Reporter.Spec (specReporter) as Reexport
diff --git a/src/Test/Spec/Reporter/Base.purs b/src/Test/Spec/Reporter/Base.purs
index 54bc661..d71df33 100644
--- a/src/Test/Spec/Reporter/Base.purs
+++ b/src/Test/Spec/Reporter/Base.purs
@@ -1,19 +1,25 @@
 module Test.Spec.Reporter.Base
-       ( defaultSummary
-       , defaultReporter
-       ) where
+  ( defaultSummary
+  , defaultReporter
+  , defaultUpdate
+  , RunningItem(..)
+  ) where
 
 import Prelude
 
-import Control.Monad.State (StateT, evalStateT, execStateT)
+import Control.Monad.State (StateT, evalStateT, execStateT, get, gets, put)
 import Control.Monad.State as State
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Writer (class MonadWriter, Writer, runWriter)
 import Data.Either (Either(..))
-import Data.Foldable (intercalate, traverse_)
+import Data.Foldable (all, for_, intercalate, traverse_)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
 import Data.List (List(..), (:), reverse)
-import Data.Maybe (Maybe(..))
-import Data.Tuple (Tuple(..))
+import Data.Map (Map)
+import Data.Map as Map
+import Data.Maybe (Maybe(..), isJust)
+import Data.Tuple (Tuple(..), uncurry)
 import Effect.Class (liftEffect)
 import Effect.Exception as Error
 import Pipes (await, yield)
@@ -25,10 +31,12 @@ import Test.Spec.Console as Console
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event (Event)
+import Test.Spec.Runner.Event as Event
 import Test.Spec.Style (styled)
 import Test.Spec.Style as Style
 import Test.Spec.Summary (Summary(..))
 import Test.Spec.Summary as Summary
+import Test.Spec.Tree (Path)
 
 
 defaultSummary :: forall m
@@ -92,3 +100,66 @@ defaultReporter
 defaultReporter initialState onEvent = pure initialState # scanWithStateM \s e ->
   let Tuple res log = runWriter $ execStateT (onEvent e) s
   in liftEffect $ Console.write log $> res
+
+
+data RunningItem
+  = RunningTest String (Maybe Result)
+  | RunningPending String
+  | RunningSuite String Boolean
+
+derive instance runningItemGeneric :: Generic RunningItem _
+instance runningItemShow :: Show RunningItem where show = genericShow
+
+defaultUpdate
+  :: forall s
+  . { getRunningItems :: s -> Map Path RunningItem
+    , putRunningItems :: Map Path RunningItem -> s -> s
+    , printFinishedItem :: Path -> RunningItem -> StateT s (Writer String) Unit
+    , update :: Event -> StateT s (Writer String) Unit
+    }
+  -> (Event -> StateT s (Writer String) Unit)
+defaultUpdate opts e = do
+  baseUpdate e
+  opts.update e
+  where
+    baseUpdate = case _ of
+      Event.Suite Event.Sequential _ _ ->
+        pure unit
+      Event.Suite Event.Parallel path name -> do
+        modifyRunningItems $ Map.insert path $ RunningSuite name false
+      Event.SuiteEnd path -> do
+        modifyRunningItems $ flip Map.update path case _ of
+          RunningSuite n _ -> Just $ RunningSuite n true
+          a -> Nothing
+      Event.Test Event.Sequential path name -> do
+        pure unit
+      Event.Test Event.Parallel path name -> do
+        modifyRunningItems $ Map.insert path $ RunningTest name Nothing
+      Event.TestEnd path name res -> do
+        runningItem <- gets opts.getRunningItems
+        case Map.lookup path runningItem of
+          Just (RunningTest n _) ->
+            modifyRunningItems $ Map.insert path $ RunningTest n $ Just res
+          _ ->
+            pure unit
+      Event.Pending path name -> do
+        runningItem <- gets opts.getRunningItems
+        unless (Map.isEmpty runningItem) do
+          modifyRunningItems $ Map.insert path $ RunningPending name
+      Event.End _ -> pure unit
+      Event.Start _ -> pure unit
+    modifyRunningItems f = do
+      s <- get
+      let
+        nextRunningItems = f $ opts.getRunningItems s
+        allFinished = all runningItemIsFinished nextRunningItems
+      put $ opts.putRunningItems (if allFinished then Map.empty else nextRunningItems) s
+
+      when allFinished do
+        for_ (asArray $ Map.toUnfoldable nextRunningItems) $ uncurry opts.printFinishedItem
+      where
+        asArray = identity :: Array ~> Array
+        runningItemIsFinished = case _ of
+          RunningPending _ -> true
+          RunningTest _ res -> isJust res
+          RunningSuite _ finished -> finished
diff --git a/src/Test/Spec/Reporter/Console.purs b/src/Test/Spec/Reporter/Console.purs
index e037a45..762921b 100644
--- a/src/Test/Spec/Reporter/Console.purs
+++ b/src/Test/Spec/Reporter/Console.purs
@@ -4,35 +4,74 @@ import Prelude
 
 import Control.Monad.State (class MonadState, get, put)
 import Control.Monad.Writer (class MonadWriter)
-import Data.Array (all)
 import Data.Foldable (for_, intercalate)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
 import Data.Map (Map)
 import Data.Map as Map
-import Data.Maybe (Maybe(..), isJust)
-import Data.Tuple (uncurry)
+import Data.Maybe (Maybe(..), isNothing)
 import Effect.Exception as Error
-import Test.Spec.Style (styled)
-import Test.Spec.Style as Style
 import Test.Spec.Console (tellLn)
-import Test.Spec.Reporter.Base (defaultReporter)
+import Test.Spec.Reporter.Base (RunningItem(..), defaultReporter, defaultUpdate)
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
-import Test.Spec.Runner.Event (Execution(..))
 import Test.Spec.Runner.Event as Event
+import Test.Spec.Style (styled)
+import Test.Spec.Style as Style
 import Test.Spec.Summary (Summary(..))
 import Test.Spec.Summary as Summary
 import Test.Spec.Tree (Path, Tree, parentSuite, parentSuiteName)
 
-data RunningItem
-  = RunningTest String (Maybe Result)
-  | RunningPending String
-  | RunningSuite String Boolean
+type State = { runningItems :: Map Path RunningItem, lastPrintedSuitePath :: Maybe Path}
 
-derive instance runningItemGeneric :: Generic RunningItem _
-instance runningItemShow :: Show RunningItem where show = genericShow
+initialState :: State
+initialState = { runningItems: Map.empty, lastPrintedSuitePath: Nothing }
 
+consoleReporter :: Reporter
+consoleReporter = defaultReporter initialState $ defaultUpdate
+  { getRunningItems: _.runningItems
+  , putRunningItems: flip _{runningItems = _}
+  , printFinishedItem: \path -> case _ of
+      RunningTest name (Just res) -> print path $ PrintTest name res
+      RunningPending name -> print path $ PrintPending name
+      _ -> pure unit
+  , update: case _ of
+      Event.TestEnd path name res -> do
+        {runningItems} <- get
+        when (isNothing $ Map.lookup path runningItems) do
+          print path $ PrintTest name res
+      Event.Pending path name -> do
+        {runningItems} <- get
+        when (Map.isEmpty runningItems) do
+          print path $ PrintPending name
+      Event.End results -> printSummary results
+      _ -> pure unit
+  }
+
+printSummary :: forall m. MonadWriter String m => Array (Tree Void Result) -> m Unit
+printSummary = Summary.summarize >>> \(Count {passed, failed, pending}) -> do
+  tellLn ""
+  tellLn $ styled Style.bold "Summary"
+  printPassedFailed passed failed
+  printPending pending
+  tellLn ""
+  where
+    printPassedFailed :: Int -> Int -> m Unit
+    printPassedFailed p f = do
+      let total = p + f
+          testStr = pluralize "test" total
+          amount = show p <> "/" <> (show total) <> " " <> testStr <> " passed"
+          color = if f > 0 then Style.red else Style.dim
+      tellLn $ styled color amount
+
+    printPending :: Int -> m Unit
+    printPending p
+      | p > 0     = tellLn $ styled Style.yellow $ show p <> " " <> pluralize "test" p <> " pending"
+      | otherwise = pure unit
+
+    pluralize :: String -> Int -> String
+    pluralize s 1 = s
+    pluralize s _ = s <> "s"
 
 data PrintAction
   = PrintTest String Result
@@ -66,82 +105,3 @@ print path a = do
       tellLn $ "  " <> styled Style.red (Error.message err)
     PrintPending name -> do
       tellLn $ "  " <> styled Style.cyan ("~ " <> name)
-
-type State = { runningItem :: Map Path RunningItem, lastPrintedSuitePath :: Maybe Path}
-
-initialState :: State
-initialState = { runningItem: Map.empty, lastPrintedSuitePath: Nothing }
-
-consoleReporter :: Reporter
-consoleReporter = defaultReporter initialState case _ of
-  Event.Suite Sequential path name ->
-    pure unit
-  Event.Suite Parallel path name -> do
-    modifyRunningItems $ Map.insert path $ RunningSuite name false
-  Event.SuiteEnd path -> do
-    modifyRunningItems $ flip Map.update path case _ of
-      RunningSuite n _ -> Just $ RunningSuite n true
-      a -> Nothing
-  Event.Test Sequential path name -> do
-    pure unit
-  Event.Test Parallel path name -> do
-    modifyRunningItems $ Map.insert path $ RunningTest name Nothing
-  Event.TestEnd path name res -> do
-    {runningItem} <- get
-    case Map.lookup path runningItem of
-      Just (RunningTest n _) ->
-        modifyRunningItems $ Map.insert path $ RunningTest n $ Just res
-      _ ->
-        print path $ PrintTest name res
-  Event.Pending path name -> do
-    {runningItem} <- get
-    if Map.isEmpty runningItem
-      then print path $ PrintPending name
-      else modifyRunningItems $ Map.insert path $ RunningPending name
-  Event.End results -> printSummary results
-  Event.Start _ -> pure unit
-  where
-  modifyRunningItems f = do
-    s <- get
-    let
-      nextRunningItems = f s.runningItem
-      allFinished = all runningItemIsFinished nextRunningItems
-    put s{runningItem = if allFinished then Map.empty else nextRunningItems}
-
-    when allFinished do
-      for_ (asArray $ Map.toUnfoldable nextRunningItems) $ uncurry \path -> case _ of
-        RunningTest name (Just res) -> print path $ PrintTest name res
-        RunningPending name -> print path $ PrintPending name
-        _ -> pure unit
-    where
-      asArray = identity :: Array ~> Array
-      runningItemIsFinished = case _ of
-        RunningPending _ -> true
-        RunningTest _ res -> isJust res
-        RunningSuite _ finished -> finished
-
-
-printSummary :: forall m. MonadWriter String m => Array (Tree Void Result) -> m Unit
-printSummary = Summary.summarize >>> \(Count {passed, failed, pending}) -> do
-  tellLn ""
-  tellLn $ styled Style.bold "Summary"
-  printPassedFailed passed failed
-  printPending pending
-  tellLn ""
-  where
-    printPassedFailed :: Int -> Int -> m Unit
-    printPassedFailed p f = do
-      let total = p + f
-          testStr = pluralize "test" total
-          amount = show p <> "/" <> (show total) <> " " <> testStr <> " passed"
-          color = if f > 0 then Style.red else Style.dim
-      tellLn $ styled color amount
-
-    printPending :: Int -> m Unit
-    printPending p
-      | p > 0     = tellLn $ styled Style.yellow $ show p <> " " <> pluralize "test" p <> " pending"
-      | otherwise = pure unit
-
-    pluralize :: String -> Int -> String
-    pluralize s 1 = s
-    pluralize s _ = s <> "s"
diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index cc63bf9..6042e00 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -2,44 +2,58 @@ module Test.Spec.Reporter.Spec (specReporter) where
 
 import Prelude
 
-import Control.Monad.State (class MonadState, get, modify, put)
+import Control.Monad.State (class MonadState, get, modify)
 import Control.Monad.Writer (class MonadWriter)
-import Data.Array (all, length)
-import Data.Foldable (for_)
+import Data.Array (length)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
 import Data.Map (Map)
 import Data.Map as Map
-import Data.Maybe (Maybe(..), isJust)
-import Data.Tuple (uncurry)
-import Test.Spec.Style (styled)
-import Test.Spec.Style as Style
+import Data.Maybe (Maybe(..), isNothing)
 import Test.Spec.Console (tellLn)
-import Test.Spec.Reporter.Base (defaultReporter, defaultSummary)
+import Test.Spec.Reporter.Base (RunningItem(..), defaultReporter, defaultSummary, defaultUpdate)
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner (Reporter)
 import Test.Spec.Runner.Event (Execution(..))
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Speed as Speed
+import Test.Spec.Style (styled)
+import Test.Spec.Style as Style
 import Test.Spec.Tree (Path)
 
-data RunningItem
-  = RunningTest String (Maybe Result)
-  | RunningPending String
-  | RunningSuite String Boolean
-
-derive instance runningItemGeneric :: Generic RunningItem _
-instance runningItemShow :: Show RunningItem where show = genericShow
-
-type State = { runningItem :: Map Path RunningItem, numFailures :: Int }
+type State = { runningItems :: Map Path RunningItem, numFailures :: Int }
 
 initialState :: State
-initialState = { runningItem: Map.empty, numFailures: 0}
+initialState = { runningItems: Map.empty, numFailures: 0}
+
+specReporter :: Reporter
+specReporter = defaultReporter initialState $ defaultUpdate
+  { getRunningItems: _.runningItems
+  , putRunningItems: flip _{runningItems = _}
+  , printFinishedItem: \path -> case _ of
+      RunningTest name (Just res) -> print path $ PrintTest name res
+      RunningPending name -> print path $ PrintPending name
+      RunningSuite name true -> print path $ PrintSuite name
+      _ -> pure unit
+  , update: case _ of
+      Event.Suite Sequential path name -> do
+        print path $ PrintSuite name
+      Event.TestEnd path name res -> do
+        {runningItems} <- get
+        when (isNothing $ Map.lookup path runningItems) do
+          print path $ PrintTest name res
+      Event.Pending path name -> do
+        {runningItems} <- get
+        when (Map.isEmpty runningItems) do
+          print path $ PrintPending name
+      Event.End results -> defaultSummary results
+      _ -> pure unit
+  }
 
 data PrintAction
-  = PrintSuite Path String
-  | PrintTest Path String Result
-  | PrintPending Path String
+  = PrintSuite String
+  | PrintTest String Result
+  | PrintPending String
 
 derive instance printActionGeneric :: Generic PrintAction _
 instance printActionShow :: Show PrintAction where show = genericShow
@@ -48,70 +62,23 @@ print
   :: forall s m
    . MonadState { numFailures :: Int | s } m
   => MonadWriter String m
-  => PrintAction
+  => Path
+  -> PrintAction
   -> m Unit
-print = case _ of
-  PrintSuite path name -> do
+print path = case _ of
+  PrintSuite name -> do
     tellLn $ indent path <> name
-  PrintTest path name (Success speed ms) -> do
+  PrintTest name (Success speed ms) -> do
     let
       speedDetails = case speed of
         Speed.Fast -> ""
         _ -> styled (Speed.toStyle speed) $ " (" <> show ms <> "ms)"
     tellLn $ (indent path) <> styled Style.green "✓︎ " <> styled Style.dim name <> speedDetails
-  PrintTest path name (Failure err) -> do
+  PrintTest name (Failure err) -> do
     {numFailures} <- modify \s -> s{numFailures = s.numFailures +1}
     tellLn $ (indent path) <> styled Style.red (show numFailures <> ") " <> name)
-  PrintPending path name -> do
+  PrintPending name -> do
     tellLn $ (indent path) <> (styled Style.cyan $ "- " <> name)
   where
     indent = length >>> Style.indent
 
-specReporter :: Reporter
-specReporter = defaultReporter initialState case _ of
-  Event.Suite Sequential path name -> do
-    print $ PrintSuite path name
-  Event.Suite Parallel path name -> do
-    modifyRunningItems $ Map.insert path $ RunningSuite name false
-  Event.SuiteEnd path -> do
-    modifyRunningItems $ flip Map.update path case _ of
-      RunningSuite n _ -> Just $ RunningSuite n true
-      a -> Nothing
-  Event.Test Sequential path name -> do
-    pure unit
-  Event.Test Parallel path name -> do
-    modifyRunningItems $ Map.insert path $ RunningTest name Nothing
-  Event.TestEnd path name res -> do
-    {runningItem} <- get
-    case Map.lookup path runningItem of
-      Just (RunningTest n _) ->
-        modifyRunningItems $ Map.insert path $ RunningTest n $ Just res
-      _ ->
-        print $ PrintTest path name res
-  Event.Pending path name -> do
-    {runningItem} <- get
-    if Map.isEmpty runningItem
-      then print $ PrintPending path name
-      else modifyRunningItems $ Map.insert path $ RunningPending name
-  Event.End results -> defaultSummary results
-  Event.Start _ -> pure unit
-  where
-  modifyRunningItems f = do
-    s <- get
-    let
-      nextRunningItems = f s.runningItem
-      allFinished = all runningItemIsFinished nextRunningItems
-    put s{runningItem = if allFinished then Map.empty else nextRunningItems}
-
-    when allFinished do
-      for_ (asArray $ Map.toUnfoldable nextRunningItems) $ uncurry \path -> case _ of
-        RunningTest name (Just res) -> print $ PrintTest path name res
-        RunningPending name -> print $ PrintPending path name
-        RunningSuite name true -> print $ PrintSuite path name
-        _ -> pure unit
-    where
-      asArray = identity :: Array ~> Array
-      runningItemIsFinished = case _ of
-        RunningPending _ -> true
-        RunningTest _ res -> isJust res
-        RunningSuite _ finished -> finished

From 395b4b23d59f74a9985c29008593f6c6b41a09df Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 15 Jan 2019 18:07:13 +0400
Subject: [PATCH 25/39] extract parallelSpec

---
 test/Main.purs                   | 35 +++++-------------------------
 test/Test/Spec/ParallelSpec.purs | 37 ++++++++++++++++++++++++++++++++
 2 files changed, 42 insertions(+), 30 deletions(-)
 create mode 100644 test/Test/Spec/ParallelSpec.purs

diff --git a/test/Main.purs b/test/Main.purs
index b946ff4..d29fd2d 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -6,45 +6,20 @@ import Data.Identity (Identity(..))
 import Data.Maybe (Maybe(..))
 import Data.Newtype (un)
 import Effect (Effect)
-import Effect.Aff (Milliseconds(..), delay, launchAff_)
-import Test.Spec (describe, it, parallel, pending, sequential)
+import Effect.Aff (launchAff_)
 import Test.Spec.AssertionSpec (assertionSpec)
-import Test.Spec.Assertions (shouldEqual)
 import Test.Spec.HoistSpec (hoistSpecSpec)
 import Test.Spec.HookSpec (hookSpec)
+import Test.Spec.ParallelSpec (parallelSpec)
 import Test.Spec.Reporter (specReporter)
 import Test.Spec.Runner (defaultConfig, run')
 import Test.Spec.RunnerSpec (runnerSpec)
 
 main :: Effect Unit
-main = launchAff_ $ un Identity $ run' (defaultConfig{exit= false,timeout = Nothing}) [ specReporter ] do
+main = launchAff_ $ un Identity $ run' (defaultConfig{timeout = Nothing}) [ specReporter ] do
   runnerSpec
   assertionSpec
   hookSpec
   hoistSpecSpec
-  describe "g" do
-    it "g.1" $ delay $ Milliseconds 1500.0
-    it "g.2" $ delay $ Milliseconds 1500.0
-    pending "g.3"
-  describe "p" do
-    describe "pp" do
-      describe "ppp" do
-        pending "ppp.1"
-  describe "a" $ parallel do
-    it "a.err" $ delay (Milliseconds 1300.0) *> 1 `shouldEqual` 2
-    it "a.1" $ delay $ Milliseconds 1500.0
-    it "a.2" $ delay $ Milliseconds 1500.0
-    describe "d" $ sequential do
-      it "d.1" $ delay $ Milliseconds 1500.0
-      it "d.2" $ delay $ Milliseconds 1500.0
-    describe "z" do
-      it "z.1" $ delay $ Milliseconds 1700.0
-      it "z.2" $ delay $ Milliseconds 1900.0
-      pending "z.3"
-      it "z.err" $ delay (Milliseconds 1300.0) *> 1 `shouldEqual` 2
-    describe "j" do
-      it "j.1" $ delay $ Milliseconds 11000.0
-      it "j.2" $ delay $ Milliseconds 1400.0
-  describe "k" do
-    it "k.1" $ delay $ Milliseconds 1500.0
-    it "k.2" $ delay $ Milliseconds 1500.0
+  parallelSpec
+
diff --git a/test/Test/Spec/ParallelSpec.purs b/test/Test/Spec/ParallelSpec.purs
new file mode 100644
index 0000000..ffe9d22
--- /dev/null
+++ b/test/Test/Spec/ParallelSpec.purs
@@ -0,0 +1,37 @@
+module Test.Spec.ParallelSpec where
+
+import Prelude
+
+import Data.Time.Duration (Milliseconds(..))
+import Effect.Aff (delay)
+import Test.Spec (Spec, describe, it, parallel, pending, sequential)
+import Test.Spec.Assertions (shouldEqual)
+
+parallelSpec :: Spec Unit
+parallelSpec = do
+  describe "g" do
+    it "g.1" $ delay $ Milliseconds 500.0
+    it "g.2" $ delay $ Milliseconds 500.0
+    pending "g.3"
+  describe "p" do
+    describe "pp" do
+      describe "ppp" do
+        pending "ppp.1"
+  describe "a" $ parallel do
+    it "a.err" $ delay (Milliseconds 300.0) *> 1 `shouldEqual` 2
+    it "a.1" $ delay $ Milliseconds 1500.0
+    it "a.2" $ delay $ Milliseconds 500.0
+    describe "d" $ sequential do
+      it "d.1" $ delay $ Milliseconds 500.0
+      it "d.2" $ delay $ Milliseconds 500.0
+    describe "z" do
+      it "z.1" $ delay $ Milliseconds 700.0
+      it "z.2" $ delay $ Milliseconds 900.0
+      pending "z.3"
+      it "z.err" $ delay (Milliseconds 300.0) *> 1 `shouldEqual` 2
+    describe "j" do
+      it "j.1" $ delay $ Milliseconds 1000.0
+      it "j.2" $ delay $ Milliseconds 400.0
+  describe "k" do
+    it "k.1" $ delay $ Milliseconds 500.0
+    it "k.2" $ delay $ Milliseconds 500.0

From 3d714141c038b4a99549d4589aebeda7335cea9c Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Tue, 15 Jan 2019 18:07:48 +0400
Subject: [PATCH 26/39] comment failing tests

---
 test/Test/Spec/ParallelSpec.purs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/test/Test/Spec/ParallelSpec.purs b/test/Test/Spec/ParallelSpec.purs
index ffe9d22..905e6ad 100644
--- a/test/Test/Spec/ParallelSpec.purs
+++ b/test/Test/Spec/ParallelSpec.purs
@@ -5,7 +5,7 @@ import Prelude
 import Data.Time.Duration (Milliseconds(..))
 import Effect.Aff (delay)
 import Test.Spec (Spec, describe, it, parallel, pending, sequential)
-import Test.Spec.Assertions (shouldEqual)
+-- import Test.Spec.Assertions (shouldEqual)
 
 parallelSpec :: Spec Unit
 parallelSpec = do
@@ -18,7 +18,7 @@ parallelSpec = do
       describe "ppp" do
         pending "ppp.1"
   describe "a" $ parallel do
-    it "a.err" $ delay (Milliseconds 300.0) *> 1 `shouldEqual` 2
+    -- it "a.err" $ delay (Milliseconds 300.0) *> 1 `shouldEqual` 2
     it "a.1" $ delay $ Milliseconds 1500.0
     it "a.2" $ delay $ Milliseconds 500.0
     describe "d" $ sequential do
@@ -28,7 +28,7 @@ parallelSpec = do
       it "z.1" $ delay $ Milliseconds 700.0
       it "z.2" $ delay $ Milliseconds 900.0
       pending "z.3"
-      it "z.err" $ delay (Milliseconds 300.0) *> 1 `shouldEqual` 2
+      -- it "z.err" $ delay (Milliseconds 300.0) *> 1 `shouldEqual` 2
     describe "j" do
       it "j.1" $ delay $ Milliseconds 1000.0
       it "j.2" $ delay $ Milliseconds 400.0

From 30d68f67aa268e66a5b7ac083fbf7e6b153c6ca3 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Wed, 16 Jan 2019 11:23:04 +0400
Subject: [PATCH 27/39] adopt `Using hooks` section from hspec

---
 docs/writing-specs.md | 110 ++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 107 insertions(+), 3 deletions(-)

diff --git a/docs/writing-specs.md b/docs/writing-specs.md
index 4a9c284..445595a 100644
--- a/docs/writing-specs.md
+++ b/docs/writing-specs.md
@@ -178,7 +178,7 @@ It would take `2000 ms` to finish. But, by sticking in `parallel`, it would take
 ```
 
 **NOTE** that if you are logging things to console, by using `parallel`
-order of log messages will be mixed. For example if you had:
+order of log messages is less deterministic. For example if you had:
 
 ```purescript
 describe "delay" do
@@ -219,5 +219,109 @@ end 3
 ```
 
 `purescript-spec` itself is not providing any specific solution for this
-issue but you can take a look at [/test/Test/Spec/HoistSpec.purs](https://github.com/purescript-spec/purescript-spec/blob/master/test/Test/Spec/HoistSpec.purs) 
-for some inspiration.
\ No newline at end of file
+issue but you can take a look at [/test/Test/Spec/HoistSpec.purs](https://github.com/purescript-spec/purescript-spec/blob/master/test/Test/Spec/HoistSpec.purs)
+for some inspiration.
+
+## Using hooks
+
+`before_` runs a custom action before every spec item. For example, if you
+have an action `flushDb` which flushes your database, you can run it before
+every spec item with:
+
+```purescript
+main :: Spec Unit
+main = before_ flushDb do
+  describe "/api/users/count" do
+    it "returns the number of users" do
+      post "/api/users/create" "name=Jay"
+      get "/api/users/count" `shouldReturn` 1
+
+    describe "when there are no users" do
+      it "returns 0" do
+        get "/api/users/count" `shouldReturn` 0
+```
+
+Similarly, `after_` runs a custom action after every spec item:
+
+```purescript
+main :: Spec Unit
+main = after_ truncateDatabase do
+  describe "createUser" do
+    it "creates a new user" do
+      let eva = User (UserId 1) (Name "Eva")
+      createUser eva
+      getUser (UserId 1) `shouldReturn` eva
+
+  describe "countUsers" do
+    it "counts all registered users" do
+      countUsers `shouldReturn` 0
+```
+
+`around_` is passed an action for each spec item so that it can perform
+whatever setup and teardown is necessary.
+
+```purescript
+serveStubbedApi :: String -> Int -> Aff Server
+stopServer :: Server -> Aff Unit
+
+withStubbedApi :: Aff Unit -> Aff Unit
+withStubbedApi action =
+  bracket (serveStubbedApi "localhost" 80)
+          stopServer
+          (const action)
+
+main :: Spec Unit
+main = around_ withStubbedApi do
+  describe "api client" do
+    it "should authenticate" do
+      c <- newClient (Just ("user", "pass"))
+      get c "/api/auth" `shouldReturn` status200
+
+    it "should allow anonymous access" do
+      c <- newClient Nothing
+      get c "/api/dogs" `shouldReturn` status200
+```
+
+Hooks support passing values to spec items (for example, if you wanted
+to open a database connection before each item and pass the connection in).
+This can be done with `before`, `around` and `after`. Here's an example
+for how to use `around`:
+
+```purescript
+openConnection :: Aff Connection
+openConnection = ...
+
+closeConnection :: Connection -> Aff Unit
+closeConnection = ...
+
+withDatabaseConnection :: (Connection -> Aff Unit) -> Aff Unit
+withDatabaseConnection = bracket openConnection closeConnection
+
+spec :: Spec Unit
+spec = do
+  around withDatabaseConnection do
+    describe "createRecipe" do
+      it "creates a new recipe" $ \c -> do
+        let ingredients = [Eggs, Butter, Flour, Sugar]
+        createRecipe c (Recipe "Cake" ingredients)
+        getRecipe c "Cake" `shouldReturn` ingredients
+```
+
+Hooks support nesting too:
+
+```purescript
+spec :: Spec Unit
+spec = do
+  before (pure 1) $ after (\a -> a `shouldEqual` 1) do
+    it "before & after usage" \num -> do
+      num `shouldEqual` 1
+    beforeWith (\num -> num `shouldEqual` 1 *> pure true) do
+      it "beforeWith usage" \bool -> do
+        bool `shouldEqual` true
+      aroundWith (\computation bool -> bool `shouldEqual` true *> pure "fiz" >>= computation <* pure unit) do
+        it "aroundWith usage" \str -> do
+          str `shouldEqual` "fiz"
+    beforeWith (\num -> num `shouldEqual` 1 *> pure (show num)) do
+      it "beforeWith" \str -> do
+        str `shouldEqual` "1"
+```

From 00f8589996d911792dab2578896112163ac688ae Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Wed, 16 Jan 2019 12:03:58 +0400
Subject: [PATCH 28/39] use purescripts-now and Milliseconds instead of Int

---
 bower.json                       |  3 ++-
 src/Test/Spec/Reporter/Spec.purs |  6 ++++--
 src/Test/Spec/Result.purs        |  4 ++--
 src/Test/Spec/Runner.js          |  4 ----
 src/Test/Spec/Runner.purs        | 34 +++++++++++++++++---------------
 src/Test/Spec/Speed.purs         |  9 +++++----
 6 files changed, 31 insertions(+), 29 deletions(-)

diff --git a/bower.json b/bower.json
index 01cb433..6ceee59 100644
--- a/bower.json
+++ b/bower.json
@@ -26,6 +26,7 @@
     "purescript-pipes": "^6.0.0",
     "purescript-ansi": "^5.0.0",
     "purescript-generics-rep": "^6.0.0",
-    "purescript-fork": "^4.0.0"
+    "purescript-fork": "^4.0.0",
+    "purescript-now": "^4.0.0"
   }
 }
diff --git a/src/Test/Spec/Reporter/Spec.purs b/src/Test/Spec/Reporter/Spec.purs
index 6042e00..87462d2 100644
--- a/src/Test/Spec/Reporter/Spec.purs
+++ b/src/Test/Spec/Reporter/Spec.purs
@@ -7,9 +7,11 @@ import Control.Monad.Writer (class MonadWriter)
 import Data.Array (length)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
+import Data.Int as Int
 import Data.Map (Map)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), isNothing)
+import Data.Time.Duration (Milliseconds(..))
 import Test.Spec.Console (tellLn)
 import Test.Spec.Reporter.Base (RunningItem(..), defaultReporter, defaultSummary, defaultUpdate)
 import Test.Spec.Result (Result(..))
@@ -68,11 +70,11 @@ print
 print path = case _ of
   PrintSuite name -> do
     tellLn $ indent path <> name
-  PrintTest name (Success speed ms) -> do
+  PrintTest name (Success speed (Milliseconds ms)) -> do
     let
       speedDetails = case speed of
         Speed.Fast -> ""
-        _ -> styled (Speed.toStyle speed) $ " (" <> show ms <> "ms)"
+        _ -> styled (Speed.toStyle speed) $ " (" <> show (Int.round ms) <> "ms)"
     tellLn $ (indent path) <> styled Style.green "✓︎ " <> styled Style.dim name <> speedDetails
   PrintTest name (Failure err) -> do
     {numFailures} <- modify \s -> s{numFailures = s.numFailures +1}
diff --git a/src/Test/Spec/Result.purs b/src/Test/Spec/Result.purs
index 3d51081..7cb5fad 100644
--- a/src/Test/Spec/Result.purs
+++ b/src/Test/Spec/Result.purs
@@ -3,14 +3,14 @@ module Test.Spec.Result where
 import Prelude
 
 import Data.Function (on)
+import Data.Time.Duration (Milliseconds)
 import Effect.Exception (Error)
 import Effect.Exception as Error
 import Test.Spec.Speed (Speed)
 
 
-type Duration = Int
 data Result
-  = Success Speed Duration
+  = Success Speed Milliseconds
   | Failure Error
 
 instance showResult :: Show Result where
diff --git a/src/Test/Spec/Runner.js b/src/Test/Spec/Runner.js
index 6a6ee57..92fce2a 100644
--- a/src/Test/Spec/Runner.js
+++ b/src/Test/Spec/Runner.js
@@ -3,10 +3,6 @@
 
 // module Test.Spec.Runner
 
-exports.dateNow = function () {
-  return Date.now();
-}
-
 exports.exit = function(code) {
   return function() {
     try {
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index da00bdb..5a780ad 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -18,10 +18,12 @@ import Control.Monad.Writer (execWriterT)
 import Control.Parallel (parTraverse, parallel, sequential)
 import Data.Array (groupBy, mapWithIndex)
 import Data.Array.NonEmpty as NEA
+import Data.DateTime.Instant (unInstant)
 import Data.Either (Either(..), either)
 import Data.Foldable (foldl)
+import Data.Function (on)
 import Data.Identity (Identity(..))
-import Data.Int (toNumber)
+import Data.Int as Int
 import Data.Maybe (Maybe(..))
 import Data.Newtype (un)
 import Data.Time.Duration (Milliseconds(..))
@@ -31,47 +33,46 @@ import Effect.Aff (Aff, attempt, delay, forkAff, joinFiber, makeAff, throwError,
 import Effect.Aff.AVar as AV
 import Effect.Class (liftEffect)
 import Effect.Exception (Error, error)
+import Effect.Now (now)
 import Pipes ((>->), yield)
 import Pipes.Core (Pipe, Producer, (//>))
 import Pipes.Core (runEffectRec) as P
 import Test.Spec (Item(..), Spec, SpecM, SpecTree, Tree(..))
-import Test.Spec.Style (styled)
-import Test.Spec.Style as Style
 import Test.Spec.Console (logWriter, tellLn)
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner.Event (Event, Execution(..))
 import Test.Spec.Runner.Event as Event
 import Test.Spec.Speed (speedOf)
+import Test.Spec.Style (styled)
+import Test.Spec.Style as Style
 import Test.Spec.Summary (successful)
 import Test.Spec.Tree (Path, PathItem(..), countTests, discardUnfocused, isAllParallelizable)
 
 foreign import exit :: Int -> Effect Unit
 
-foreign import dateNow :: Effect Int
-
 type Config =
-  { slow :: Int
-  , timeout :: Maybe Int
+  { slow :: Milliseconds
+  , timeout :: Maybe Milliseconds
   , exit :: Boolean
   }
 
 defaultConfig :: Config
 defaultConfig =
-  { slow: 75
-  , timeout: Just 2000
+  { slow: Milliseconds 75.0
+  , timeout: Just $ Milliseconds 2000.0
   , exit: true
   }
 
 makeTimeout
-  :: Int
+  :: Milliseconds
   -> Aff Unit
-makeTimeout time = do
-  delay (Milliseconds $ toNumber time)
+makeTimeout ms@(Milliseconds ms') = do
+  delay ms
   makeAff \cb -> mempty <$ do
-    cb <<< Left $ error $ "test timed out after " <> show time <> "ms"
+    cb <<< Left $ error $ "test timed out after " <> show (Int.round ms') <> "ms"
 
 timeout
-  :: Int
+  :: Milliseconds
   -> Aff Unit
   -> Aff Unit
 timeout time t = do
@@ -115,11 +116,12 @@ _run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
       (Leaf name (Just (Item item))) -> do
         yield $ Event.Test (if isParallelizable then Parallel else Sequential) path name
         let example = item.example \a -> a unit
-        start <- lift $ liftEffect dateNow
+        start <- lift $ liftEffect now
         e <- lift $ attempt case config.timeout of
           Just t -> timeout t example
           _      -> example
-        duration <- lift $ (_ - start) <$> liftEffect dateNow
+        end <- liftEffect now
+        let duration = Milliseconds $ on (-) (unInstant >>> un Milliseconds) end start
         let res = either Failure (const $ Success (speedOf config.slow duration) duration) e
         yield $ Event.TestEnd path name res
         pure [ Leaf name $ Just res ]
diff --git a/src/Test/Spec/Speed.purs b/src/Test/Spec/Speed.purs
index 09d01f2..cdf6b8e 100644
--- a/src/Test/Spec/Speed.purs
+++ b/src/Test/Spec/Speed.purs
@@ -5,6 +5,7 @@ import Prelude
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Eq (genericEq)
 import Data.Generic.Rep.Show (genericShow)
+import Data.Time.Duration (Milliseconds(..))
 import Test.Spec.Style (Style)
 import Test.Spec.Style as Style
 
@@ -14,10 +15,10 @@ derive instance genericSpeed :: Generic Speed _
 instance showSpeed :: Show Speed where show = genericShow
 instance showEq :: Eq Speed where eq = genericEq
 
-speedOf :: Int -> Int -> Speed
-speedOf thresh ms | ms > thresh     = Slow
-speedOf thresh ms | ms > thresh / 2 = Medium
-speedOf _      _                    = Fast
+speedOf :: Milliseconds -> Milliseconds -> Speed
+speedOf thresh ms | ms > thresh = Slow
+speedOf (Milliseconds thresh) (Milliseconds ms) | ms > thresh / 2.0 = Medium
+speedOf _ _ = Fast
 
 toStyle :: Speed -> Style
 toStyle Fast   = Style.dim

From 239491b6cfd21f36df2f7983ebfb7e0f1ebb68bf Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Wed, 16 Jan 2019 12:04:31 +0400
Subject: [PATCH 29/39] update Reporter exports

---
 src/Test/Spec/Reporter.purs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Test/Spec/Reporter.purs b/src/Test/Spec/Reporter.purs
index e2116dc..eba2066 100644
--- a/src/Test/Spec/Reporter.purs
+++ b/src/Test/Spec/Reporter.purs
@@ -1,6 +1,6 @@
 module Test.Spec.Reporter (module Reexport) where
 
-import Test.Spec.Reporter.Base (defaultSummary, defaultReporter, defaultUpdate) as Reexport
+import Test.Spec.Reporter.Base (defaultSummary, defaultReporter, defaultUpdate, RunningItem(..)) as Reexport
 import Test.Spec.Reporter.Console (consoleReporter) as Reexport
 import Test.Spec.Reporter.Dot (dotReporter) as Reexport
 import Test.Spec.Reporter.Spec (specReporter) as Reexport

From 4bf23d737559e810c6b41480a100e84fa2bfd674 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Wed, 16 Jan 2019 12:04:44 +0400
Subject: [PATCH 30/39] use absurd  for handling void case

---
 src/Test/Spec/Reporter/Base.purs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Test/Spec/Reporter/Base.purs b/src/Test/Spec/Reporter/Base.purs
index d71df33..0985a80 100644
--- a/src/Test/Spec/Reporter/Base.purs
+++ b/src/Test/Spec/Reporter/Base.purs
@@ -66,7 +66,7 @@ printFailures xs' = evalStateT (go xs') {i: 0, crumbs: Nil}
         State.modify_ _{crumbs = n : crumbs}
         go xs
         State.modify_ _{crumbs = crumbs}
-      S.Node (Right _) xs -> go xs
+      S.Node (Right v) xs -> absurd v
       S.Leaf n (Just (Failure err)) -> do
         {i, crumbs} <- State.modify \s -> s{i = s.i +1}
         let label = intercalate " " (reverse $ n:crumbs)

From 2884c0cbe96c4a6b63dcd7459c9ec1802d56f397 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Wed, 16 Jan 2019 13:11:21 +0400
Subject: [PATCH 31/39] remove reduce run,run',runSpec,runSpec' to just runSpec
 and runSpecM

with `exit: false` and you can get test results
with `[]` as reporters you can get no reporting
so removed runSpec,runSpec' and renamed run,run' to runSpec and runSpecM
---
 src/Test/Spec/Runner.purs     | 67 +++++++++++++----------------------
 test/Main.purs                |  8 ++---
 test/Test/Spec/HoistSpec.purs | 12 +++----
 3 files changed, 32 insertions(+), 55 deletions(-)

diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index 5a780ad..0d0d006 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -1,10 +1,7 @@
 module Test.Spec.Runner
-  ( run
-  , run'
+  ( runSpecM
   , runSpec
-  , runSpec'
   , defaultConfig
-  , timeout
   , Config
   , TestEvents
   , Reporter
@@ -32,13 +29,13 @@ import Effect (Effect)
 import Effect.Aff (Aff, attempt, delay, forkAff, joinFiber, makeAff, throwError, try)
 import Effect.Aff.AVar as AV
 import Effect.Class (liftEffect)
-import Effect.Exception (Error, error)
+import Effect.Exception (error)
 import Effect.Now (now)
 import Pipes ((>->), yield)
 import Pipes.Core (Pipe, Producer, (//>))
 import Pipes.Core (runEffectRec) as P
 import Test.Spec (Item(..), Spec, SpecM, SpecTree, Tree(..))
-import Test.Spec.Console (logWriter, tellLn)
+import Test.Spec.Console as Console
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner.Event (Event, Execution(..))
 import Test.Spec.Runner.Event as Event
@@ -93,7 +90,7 @@ _run
    . Functor m
   => Config
   -> SpecM m Aff Unit Unit
-  -> m (Producer Event Aff (Array (Tree Void Result)))
+  -> m TestEvents
 _run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
   yield (Event.Start (countTests tests))
   let indexer index test = {test, path: [PathItem {name: Nothing, index}]}
@@ -101,7 +98,7 @@ _run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
   yield (Event.End r)
   pure r
   where
-    loop :: Array (TestWithPath ()) -> Producer Event Aff (Array (Tree Void Result))
+    loop :: Array (TestWithPath ()) -> TestEvents
     loop tests =
       let
         noteWithIsAllParallelizable = map \{test,path} -> { isParallelizable: isAllParallelizable test, test, path}
@@ -111,7 +108,7 @@ _run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
           then mergeProducers (runGroup <$> (NEA.toArray g))
           else for (NEA.toArray g) runGroup
 
-    runGroup :: TestWithPath (isParallelizable :: Boolean) -> Producer Event Aff (Array (Tree Void Result))
+    runGroup :: TestWithPath (isParallelizable :: Boolean) -> TestEvents
     runGroup {test, path, isParallelizable} = case test of
       (Leaf name (Just (Item item))) -> do
         yield $ Event.Test (if isParallelizable then Parallel else Sequential) path name
@@ -159,57 +156,41 @@ mergeProducers ps = do
           loop
   loop
 
-
--- | Run a spec, returning the results, without any reporting
-runSpec'
-  :: forall m
-   . Functor m
-  => Config
-  -> SpecM m Aff Unit Unit
-  -> m (Aff (Array (Tree Void Result)))
-runSpec' config spec = _run config spec <#> \runner -> P.runEffectRec $ runner //> const (pure unit)
-
--- | Run a spec with the default config, returning the results, without any
--- | reporting
-runSpec
-  :: Spec Unit
-  -> Aff (Array (Tree Void Result))
-runSpec = un Identity <<< runSpec' defaultConfig
-
 type TestEvents = Producer Event Aff (Array (Tree Void Result))
 
 type Reporter = Pipe Event Event Aff (Array (Tree Void Result))
 
--- | Run the spec with `config`, report results and (if configured as such)
--- | exit the program upon completion
-run'
+-- | Run the spec with `config`, returning the results, which
+-- | are also reported using specified Reporters, if any.
+-- | If configured as such, `exit` the program upon completion
+-- | with appropriate exit code.
+runSpecM
   :: forall m
    . Functor m
   => Config
   -> Array Reporter
   -> SpecM m Aff Unit Unit
-  -> m (Aff Unit)
-run' config reporters spec = _run config spec <#> \runner -> do
+  -> m (Aff (Array (Tree Void Result)))
+runSpecM config reporters spec = _run config spec <#> \runner -> do
   let
     drain = const (pure unit)
     events = foldl (>->) runner reporters
     reportedEvents = P.runEffectRec $ events //> drain
-  either onError onSuccess =<< try reportedEvents
-  where
-    onError :: Error -> Aff Unit
-    onError err = liftEffect do
-       logWriter $ tellLn $ styled Style.red (show err)
-       when config.exit (exit 1)
-
-    onSuccess :: Array (Tree Void Result) -> Aff Unit
-    onSuccess results = liftEffect $
-      when config.exit do
+  if config.exit
+    then try reportedEvents >>= case _ of
+      Left err -> do
+        liftEffect $ Console.write $ styled Style.red (show err <> "\n")
+        liftEffect $ exit 1
+        throwError err
+      Right results -> liftEffect do
         let code = if successful results then 0 else 1
         exit code
+        pure results
+    else reportedEvents
 
 -- | Run the spec with the default config
-run
+runSpec
   :: Array Reporter
   -> Spec Unit
   -> Aff Unit
-run reporters spec = un Identity $ run' defaultConfig reporters spec
+runSpec reporters spec = void $ un Identity $ runSpecM defaultConfig reporters spec
diff --git a/test/Main.purs b/test/Main.purs
index d29fd2d..a6fb34d 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -2,9 +2,6 @@ module Test.Main where
 
 import Prelude
 
-import Data.Identity (Identity(..))
-import Data.Maybe (Maybe(..))
-import Data.Newtype (un)
 import Effect (Effect)
 import Effect.Aff (launchAff_)
 import Test.Spec.AssertionSpec (assertionSpec)
@@ -12,14 +9,13 @@ import Test.Spec.HoistSpec (hoistSpecSpec)
 import Test.Spec.HookSpec (hookSpec)
 import Test.Spec.ParallelSpec (parallelSpec)
 import Test.Spec.Reporter (specReporter)
-import Test.Spec.Runner (defaultConfig, run')
+import Test.Spec.Runner (runSpec)
 import Test.Spec.RunnerSpec (runnerSpec)
 
 main :: Effect Unit
-main = launchAff_ $ un Identity $ run' (defaultConfig{timeout = Nothing}) [ specReporter ] do
+main = launchAff_ $ runSpec [ specReporter] do
   runnerSpec
   assertionSpec
   hookSpec
   hoistSpecSpec
   parallelSpec
-
diff --git a/test/Test/Spec/HoistSpec.purs b/test/Test/Spec/HoistSpec.purs
index f37b805..11e80b8 100644
--- a/test/Test/Spec/HoistSpec.purs
+++ b/test/Test/Spec/HoistSpec.purs
@@ -45,28 +45,28 @@ delaySpecExample
 delaySpecExample opts = describe "delay" do
   it "proc 1" do
     opts.log "start 1"
-    opts.delay $ Milliseconds $ 500.0 + 300.0 * 1.0
+    opts.delay $ Milliseconds $ 300.0 * 1.0
     opts.log "done 1"
   describe "some" do
     it "proc 2" do
       opts.log "start 2"
-      opts.delay $ Milliseconds $ 500.0 + 300.0 * 2.0
+      opts.delay $ Milliseconds $ 300.0 * 2.0
       opts.log "done 2"
     it "proc 3" do
       opts.log "start 3"
-      opts.delay $ Milliseconds $ 500.0 + 300.0 * 3.0
+      opts.delay $ Milliseconds $ 300.0 * 3.0
       opts.log "done 3"
     describe "nesting" do
       it "proc 4" do
         opts.log "start 4"
-        opts.delay $ Milliseconds $ 500.0 + 300.0 * 4.0
+        opts.delay $ Milliseconds $ 300.0 * 4.0
         opts.log "done 4"
     describe "nesting" do
       it "proc 5" do
         opts.log "start 5"
-        opts.delay $ Milliseconds $ 500.0 + 300.0 * 5.0
+        opts.delay $ Milliseconds $ 300.0 * 5.0
         opts.log "done 5"
       it "proc 6" do
         opts.log "start 6"
-        opts.delay $ Milliseconds $ 500.0 + 300.0 * 6.0
+        opts.delay $ Milliseconds $ 300.0 * 6.0
         opts.log "done 6"

From 21f2a983dad7c5763210373cacdca68e93202681 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Wed, 16 Jan 2019 14:57:06 +0400
Subject: [PATCH 32/39] remove extra ()

---
 src/Test/Spec/Tree.purs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Test/Spec/Tree.purs b/src/Test/Spec/Tree.purs
index f800e1a..f88d71a 100644
--- a/src/Test/Spec/Tree.purs
+++ b/src/Test/Spec/Tree.purs
@@ -92,7 +92,7 @@ countTests g = execState (for g go) 0
 isAllParallelizable :: forall c m a. Tree c (Item m a) -> Boolean
 isAllParallelizable = case _ of
   Node _ xs -> all isAllParallelizable xs
-  Leaf _ (x) -> x == Nothing || (x >>= un Item >>> _.isParallelizable) == Just true
+  Leaf _ x -> x == Nothing || (x >>= un Item >>> _.isParallelizable) == Just true
 
 
 -- | If there is at least one focused element, all paths which don't

From 4cbccc28c5c360b875f4e8fabc8b344c8435d8dd Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Wed, 16 Jan 2019 14:58:20 +0400
Subject: [PATCH 33/39] fix warning

---
 src/Test/Spec/Tree.purs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/Test/Spec/Tree.purs b/src/Test/Spec/Tree.purs
index f88d71a..3764d32 100644
--- a/src/Test/Spec/Tree.purs
+++ b/src/Test/Spec/Tree.purs
@@ -17,7 +17,7 @@ import Prelude
 
 import Control.Monad.State (execState)
 import Control.Monad.State as State
-import Data.Array (mapMaybe, snoc, unsnoc)
+import Data.Array (mapMaybe, snoc)
 import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Array.NonEmpty as NEA
 import Data.Bifunctor (class Bifunctor)
@@ -26,7 +26,6 @@ import Data.Foldable (class Foldable, all, foldMapDefaultL, foldl, foldr)
 import Data.Maybe (Maybe(..), maybe)
 import Data.Newtype (class Newtype, un)
 import Data.Traversable (for, for_)
-import Data.Tuple (Tuple(..))
 
 
 data Tree c a

From 14f5edc1ecfc310800c3c7f3269951f73e738ce6 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Wed, 16 Jan 2019 15:58:51 +0400
Subject: [PATCH 34/39] use newtype instead of type alias to get better type
 derivation

for example here all types are derived by compiler:
```
foo :: forall t19. Monad t19 => SpecT Aff Unit t19 Unit
foo = it "foo" $ delay $ Milliseconds 100.0

baz :: forall t17 t18 t19. Monad t19 => SpecT t18 t17 t19 Unit
baz = describe "baz" $ pure unit

fix :: forall t18 t19. Monad t19 => MonadThrow Error t18 => SpecT t18 Unit t19 Unit
fix = it "fiz" $ 1 `shouldEqual` 1
```
vs beofre you would get huge `WriterT ...` type.
---
 src/Test/Spec.purs             | 112 +++++++++++++++++++++------------
 src/Test/Spec/Runner.purs      |  16 ++---
 test/Test/Spec/Fixtures.purs   |  16 ++---
 test/Test/Spec/HoistSpec.purs  |   4 +-
 test/Test/Spec/RunnerSpec.purs |  24 +++----
 5 files changed, 102 insertions(+), 70 deletions(-)

diff --git a/src/Test/Spec.purs b/src/Test/Spec.purs
index 59e9947..9ed5d04 100644
--- a/src/Test/Spec.purs
+++ b/src/Test/Spec.purs
@@ -1,6 +1,6 @@
 module Test.Spec
   ( Spec
-  , SpecM
+  , SpecT(..)
   , module Reexport
   , SpecTree
   , mapSpecTree
@@ -42,10 +42,18 @@ module Test.Spec
 
 import Prelude
 
-import Control.Alt ((<|>))
-import Control.Monad.Error.Class (class MonadError)
+import Control.Alt (class Alt, (<|>))
+import Control.Alternative (class Alternative)
+import Control.Monad.Cont (class MonadCont, class MonadTrans)
+import Control.Monad.Error.Class (class MonadError, class MonadThrow)
 import Control.Monad.Fork.Class (class MonadBracket, bracket)
+import Control.Monad.Reader (class MonadAsk, class MonadReader)
+import Control.Monad.Rec.Class (class MonadRec)
+import Control.Monad.State (class MonadState)
 import Control.Monad.Writer (WriterT, mapWriterT, tell)
+import Control.MonadPlus (class MonadPlus)
+import Control.MonadZero (class MonadZero)
+import Control.Plus (class Plus)
 import Data.Array (any)
 import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Bifunctor (bimap)
@@ -53,7 +61,7 @@ import Data.Either (Either(..), either)
 import Data.Function (applyFlipped)
 import Data.Identity (Identity)
 import Data.Maybe (Maybe(..))
-import Data.Newtype (over, un)
+import Data.Newtype (class Newtype, over, un)
 import Effect.AVar (AVar)
 import Effect.AVar as AVarEff
 import Effect.Aff (Aff, error, throwError, try)
@@ -66,8 +74,30 @@ import Test.Spec.Tree (ActionWith, Item(..), Tree(..)) as Reexport
 import Test.Spec.Tree (ActionWith, Item(..), Tree(..), bimapTree, modifyAroundAction)
 
 
-type Spec a = SpecM Identity Aff Unit a
-type SpecM m g i a = WriterT (Array (SpecTree g i)) m a
+type Spec a = SpecT Aff Unit Identity a
+
+newtype SpecT g i m a = SpecT (WriterT (Array (SpecTree g i)) m a)
+
+derive instance newtypeSpecT :: Newtype (SpecT g i m a) _
+derive newtype instance functorSpecT :: Functor m => Functor (SpecT g i m)
+derive newtype instance applySpecT :: Apply m => Apply (SpecT g i m)
+derive newtype instance applicativeSpecT :: Applicative m => Applicative (SpecT g i m)
+derive newtype instance altSpecT :: Alt m => Alt (SpecT g i m)
+derive newtype instance plusSpecT :: Plus m => Plus (SpecT g i m)
+derive newtype instance alternativeSpecT :: (Alternative m) => Alternative (SpecT g i m)
+derive newtype instance bindSpecT :: Bind m => Bind (SpecT g i m)
+derive newtype instance monadSpecT :: Monad m => Monad (SpecT g i m)
+derive newtype instance monadRecSpecT :: MonadRec m => MonadRec (SpecT g i m)
+derive newtype instance monadZeroSpecT :: MonadZero m => MonadZero (SpecT g i m)
+derive newtype instance monadPlusSpecT :: MonadPlus m => MonadPlus (SpecT g i m)
+derive newtype instance monadTransSpecT :: MonadTrans (SpecT g i)
+derive newtype instance monadEffectWriter :: MonadEffect m => MonadEffect (SpecT g i m)
+derive newtype instance monadContSpecT :: MonadCont m => MonadCont (SpecT g i m)
+derive newtype instance monadThrowSpecT :: MonadThrow e m => MonadThrow e (SpecT g i m)
+derive newtype instance monadErrorSpecT :: MonadError e m => MonadError e (SpecT g i m)
+derive newtype instance monadAskSpecT :: MonadAsk r m => MonadAsk r (SpecT g i m)
+derive newtype instance monadReaderSpecT :: MonadReader r m => MonadReader r (SpecT g i m)
+derive newtype instance monadStateSpecT :: MonadState s m => MonadState s (SpecT g i m)
 
 type SpecTree m a = Tree (ActionWith m a) (Item m a)
 
@@ -75,13 +105,13 @@ mapSpecTree
   :: forall m g g' i a i'
    . Monad m
    => (SpecTree g i -> SpecTree g' i')
-   -> SpecM m g i a
-   -> SpecM m g' i' a
-mapSpecTree f = mapWriterT $ map $ map $ map f
+   -> SpecT g i m a
+   -> SpecT g' i' m a
+mapSpecTree f = over SpecT $ mapWriterT $ map $ map $ map f
 
 data ComputationType = CleanUpWithContext (Array String) | TestWithName (NonEmptyArray String)
 
-hoistSpec :: forall m i a b. Monad m => (ComputationType -> a ~> b) -> SpecM m a i ~> SpecM m b i
+hoistSpec :: forall m i a b. Monad m => (ComputationType -> a ~> b) -> SpecT a i m ~> SpecT b i m
 hoistSpec f = mapSpecTree $ bimapTree onCleanUp onTest
   where
     onCleanUp :: Array String -> (ActionWith a i) -> ActionWith b i
@@ -119,8 +149,8 @@ instance warn :: Warn (Text "Test.Spec.focus usage") => FocusWarning
 -- | `focus` focuses all spec items of the given spec.
 -- |
 -- | Applying `focus` to a spec with focused spec items has no effect.
-focus :: forall m g i a. FocusWarning => Monad m => SpecM m g i a -> SpecM m g i a
-focus = mapWriterT $ map $ map \xs ->
+focus :: forall m g i a. FocusWarning => Monad m => SpecT g i m a -> SpecT g i m a
+focus = over SpecT $ mapWriterT $ map $ map \xs ->
   if any (any $ un Item >>> _.isFocused) xs
     then xs
     else map (bimap identity (\(Item r) -> Item r {isFocused = true})) xs
@@ -131,9 +161,9 @@ describe
   :: forall m g i a
    . Monad m
   => String
-  -> SpecM m g i a
-  -> SpecM m g i a
-describe name = mapWriterT $ map $ map \group -> [Node (Left name) group]
+  -> SpecT g i m a
+  -> SpecT g i m a
+describe name = over SpecT $ mapWriterT $ map $ map \group -> [Node (Left name) group]
 
 
 -- | Combine a group of specs into a described hierarchy and mark it as the
@@ -144,24 +174,24 @@ describeOnly
    . FocusWarning
   => Monad m
   => String
-  -> SpecM m g i a
-  -> SpecM m g i a
+  -> SpecT g i m a
+  -> SpecT g i m a
 describeOnly = map focus <<< describe
 
 -- | marks all spec items of the given spec to be safe for parallel evaluation.
 parallel
   :: forall m g i a
    . Monad m
-  => SpecM m g i a
-  -> SpecM m g i a
+  => SpecT g i m a
+  -> SpecT g i m a
 parallel = mapSpecTree $ bimap identity (setParallelizable true)
 
 -- | marks all spec items of the given spec to be evaluated sequentially.
 sequential
   :: forall m g i a
    . Monad m
-  => SpecM m g i a
-  -> SpecM m g i a
+  => SpecT g i m a
+  -> SpecT g i m a
 sequential = mapSpecTree $ bimap identity (setParallelizable false)
 
 setParallelizable :: forall g a. Boolean -> Item g a -> Item g a
@@ -172,8 +202,8 @@ pending
   :: forall m g i
    . Monad m
   => String
-  -> SpecM m g i Unit
-pending name = tell [Leaf name Nothing]
+  -> SpecT g i m Unit
+pending name = SpecT $ tell [Leaf name Nothing]
 
 -- | Create a pending spec with a body that is ignored by
 -- | the runner. It can be useful for documenting what the
@@ -183,7 +213,7 @@ pending'
    . Monad m
   => String
   -> g Unit
-  -> SpecM m g i Unit
+  -> SpecT g i m Unit
 pending' name _ = pending name
 
 -- | Create a spec with a description.
@@ -193,8 +223,8 @@ it
   => Example t arg g
   => String
   -> t
-  -> SpecM m g arg Unit
-it name test = tell
+  -> SpecT g arg m Unit
+it name test = SpecT $ tell
   [ Leaf name $ Just $ Item
       { isParallelizable: Nothing
       , isFocused: false
@@ -211,7 +241,7 @@ itOnly
   => Example t arg g
   => String
   -> t
-  -> SpecM m g arg Unit
+  -> SpecT g arg m Unit
 itOnly = map focus <<< it
 
 
@@ -224,49 +254,49 @@ aroundWith
   :: forall m g i i' a
    . Monad m
   => (ActionWith g i -> ActionWith g i')
-  -> SpecM m g i a
-  -> SpecM m g i' a
+  -> SpecT g i m a
+  -> SpecT g i' m a
 aroundWith action = mapSpecTree $ bimap action (modifyAroundAction action)
 
 -- | Run a custom action before and/or after every spec item.
-around_ :: forall m g i a. Monad m => (g Unit -> g Unit) -> SpecM m g i a -> SpecM m g i a
+around_ :: forall m g i a. Monad m => (g Unit -> g Unit) -> SpecT g i m a -> SpecT g i m a
 around_ action = aroundWith $ \e a -> action (e a)
 
 -- | Run a custom action after every spec item.
-after :: forall m g e f i a. Monad m => MonadBracket e f g => ActionWith g i -> SpecM m g i a -> SpecM m g i a
+after :: forall m g e f i a. Monad m => MonadBracket e f g => ActionWith g i -> SpecT g i m a -> SpecT g i m a
 after action = aroundWith $ \e x -> e x `finally` action x
   where
   finally :: forall x. g x -> g Unit -> g x
   finally act fin = bracket (pure unit) (\_ _ -> fin) (const act)
 
 -- | Run a custom action after every spec item.
-after_ :: forall m g e f i a. Monad m => MonadBracket e f g => g Unit -> SpecM m g i a -> SpecM m g i a
+after_ :: forall m g e f i a. Monad m => MonadBracket e f g => g Unit -> SpecT g i m a -> SpecT g i m a
 after_ action = after $ \_ -> action
 
 -- | Run a custom action before and/or after every spec item.
-around :: forall m g i a. Monad m => (ActionWith g i -> g Unit) -> SpecM m g i a -> SpecM m g Unit a
+around :: forall m g i a. Monad m => (ActionWith g i -> g Unit) -> SpecT g i m a -> SpecT g Unit m a
 around action = aroundWith $ \e _ -> action e
 
 -- | Run a custom action before every spec item.
-before :: forall m g i a. Monad m => Monad g => g i -> SpecM m g i a -> SpecM m g Unit a
+before :: forall m g i a. Monad m => Monad g => g i -> SpecT g i m a -> SpecT g Unit m a
 before action = around (action >>= _)
 
 -- | Run a custom action before every spec item.
-before_ :: forall m g i a. Monad m => Monad g => g Unit -> SpecM m g i a -> SpecM m g i a
+before_ :: forall m g i a. Monad m => Monad g => g Unit -> SpecT g i m a -> SpecT g i m a
 before_ action = around_ (action *> _)
 
 -- | Run a custom action before every spec item.
-beforeWith :: forall m g i i' a. Monad m => Monad g => (i' -> g i) -> SpecM m g i a -> SpecM m g i' a
+beforeWith :: forall m g i i' a. Monad m => Monad g => (i' -> g i) -> SpecT g i m a -> SpecT g i' m a
 beforeWith action = aroundWith $ \e x -> action x >>= e
 
 -- | Run a custom action before the first spec item.
-beforeAll :: forall m g i a. MonadEffect m => MonadAff g => MonadError Error g => g i -> SpecM m g i a -> SpecM m g Unit a
+beforeAll :: forall m g i a. MonadEffect m => MonadAff g => MonadError Error g => g i -> SpecT g i m a -> SpecT g Unit m a
 beforeAll action spec = do
   var <- liftEffect $ AVarEff.new MEmpty
   before (memoize var action) spec
 
 -- | Run a custom action before the first spec item.
-beforeAll_ :: forall m g i a. MonadEffect m => MonadAff g => MonadError Error g => g Unit -> SpecM m g i a -> SpecM m g i a
+beforeAll_ :: forall m g i a. MonadEffect m => MonadAff g => MonadError Error g => g Unit -> SpecT g i m a -> SpecT g i m a
 beforeAll_ action spec = do
   var <- liftEffect $ AVarEff.new MEmpty
   before_ (memoize var action) spec
@@ -287,9 +317,9 @@ memoize var action = do
       either throwError pure res
 
 -- | Run a custom action after the last spec item.
-afterAll :: forall m g i a. Monad m => ActionWith g i -> SpecM m g i a -> SpecM m g i a
-afterAll action = mapWriterT $ map $ map \group -> [Node (Right action) group]
+afterAll :: forall m g i a. Monad m => ActionWith g i -> SpecT g i m a -> SpecT g i m a
+afterAll action = over SpecT $ mapWriterT $ map $ map \group -> [Node (Right action) group]
 
 -- | Run a custom action after the last spec item.
-afterAll_ :: forall m g i a. Monad m => g Unit -> SpecM m g i a -> SpecM m g i a
+afterAll_ :: forall m g i a. Monad m => g Unit -> SpecT g i m a -> SpecT g i m a
 afterAll_ action = afterAll $ const action
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index 0d0d006..224fb70 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -1,5 +1,5 @@
 module Test.Spec.Runner
-  ( runSpecM
+  ( runSpecT
   , runSpec
   , defaultConfig
   , Config
@@ -34,7 +34,7 @@ import Effect.Now (now)
 import Pipes ((>->), yield)
 import Pipes.Core (Pipe, Producer, (//>))
 import Pipes.Core (runEffectRec) as P
-import Test.Spec (Item(..), Spec, SpecM, SpecTree, Tree(..))
+import Test.Spec (Item(..), Spec, SpecT(..), SpecTree, Tree(..))
 import Test.Spec.Console as Console
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner.Event (Event, Execution(..))
@@ -89,9 +89,9 @@ _run
   :: forall m
    . Functor m
   => Config
-  -> SpecM m Aff Unit Unit
+  -> SpecT Aff Unit m Unit
   -> m TestEvents
-_run config specs = execWriterT specs <#> discardUnfocused >>> \tests -> do
+_run config (SpecT specs) = execWriterT specs <#> discardUnfocused >>> \tests -> do
   yield (Event.Start (countTests tests))
   let indexer index test = {test, path: [PathItem {name: Nothing, index}]}
   r <- loop $ mapWithIndex indexer tests
@@ -164,14 +164,14 @@ type Reporter = Pipe Event Event Aff (Array (Tree Void Result))
 -- | are also reported using specified Reporters, if any.
 -- | If configured as such, `exit` the program upon completion
 -- | with appropriate exit code.
-runSpecM
+runSpecT
   :: forall m
    . Functor m
   => Config
   -> Array Reporter
-  -> SpecM m Aff Unit Unit
+  -> SpecT Aff Unit m Unit
   -> m (Aff (Array (Tree Void Result)))
-runSpecM config reporters spec = _run config spec <#> \runner -> do
+runSpecT config reporters spec = _run config spec <#> \runner -> do
   let
     drain = const (pure unit)
     events = foldl (>->) runner reporters
@@ -193,4 +193,4 @@ runSpec
   :: Array Reporter
   -> Spec Unit
   -> Aff Unit
-runSpec reporters spec = void $ un Identity $ runSpecM defaultConfig reporters spec
+runSpec reporters spec = void $ un Identity $ runSpecT defaultConfig reporters spec
diff --git a/test/Test/Spec/Fixtures.purs b/test/Test/Spec/Fixtures.purs
index c68be93..bbc8b78 100644
--- a/test/Test/Spec/Fixtures.purs
+++ b/test/Test/Spec/Fixtures.purs
@@ -3,15 +3,17 @@ module Test.Spec.Fixtures where
 import Prelude
 
 import Data.Identity (Identity)
-import Test.Spec (SpecM, describe, describeOnly, it, itOnly)
+import Test.Spec (SpecT, describe, describeOnly, it, itOnly)
 
-successTest :: SpecM Identity Identity Unit Unit
+type Spec' a = SpecT Identity Unit Identity a
+
+successTest :: Spec' Unit
 successTest =
   describe "a" do
     describe "b" do
       it "works" $ pure unit
 
-sharedDescribeTest :: SpecM Identity Identity Unit Unit
+sharedDescribeTest :: Spec' Unit
 sharedDescribeTest =
   describe "a" do
     describe "b" do
@@ -19,7 +21,7 @@ sharedDescribeTest =
     describe "c" do
       it "also works" $ pure unit
 
-duplicatedDescribeTest :: SpecM Identity Identity Unit Unit
+duplicatedDescribeTest :: Spec' Unit
 duplicatedDescribeTest =
   describe "a" do
     describe "b" do
@@ -29,7 +31,7 @@ duplicatedDescribeTest =
       describe "c" do
         it "second" $ pure unit
 
-describeOnlyTest :: SpecM Identity Identity Unit Unit
+describeOnlyTest :: Spec' Unit
 describeOnlyTest =
   describeOnly "a" do
     describe "b" do
@@ -37,7 +39,7 @@ describeOnlyTest =
     describe "c" do
       it "also works" $ pure unit
 
-describeOnlyNestedTest :: SpecM Identity Identity Unit Unit
+describeOnlyNestedTest :: Spec' Unit
 describeOnlyNestedTest =
   describe "a" do
     describeOnly "b" do
@@ -45,7 +47,7 @@ describeOnlyNestedTest =
     describe "c" do
       it "also works" $ pure unit
 
-itOnlyTest :: SpecM Identity Identity Unit Unit
+itOnlyTest :: Spec' Unit
 itOnlyTest =
   describe "a" do
     describe "b" do
diff --git a/test/Test/Spec/HoistSpec.purs b/test/Test/Spec/HoistSpec.purs
index 11e80b8..8870d36 100644
--- a/test/Test/Spec/HoistSpec.purs
+++ b/test/Test/Spec/HoistSpec.purs
@@ -10,9 +10,9 @@ import Data.Traversable (intercalate)
 import Effect.Aff (Aff, delay)
 import Effect.Aff.Class (liftAff)
 import Effect.Class.Console (log)
-import Test.Spec (ComputationType(..), Spec, SpecM, describe, hoistSpec, it, parallel)
+import Test.Spec (ComputationType(..), Spec, SpecT, describe, hoistSpec, it, parallel)
 
-type Spec' t a = SpecM Identity t Unit a
+type Spec' t a = SpecT t Unit Identity a
 
 hoistSpecSpec :: Spec Unit
 hoistSpecSpec = describe "hoist" do
diff --git a/test/Test/Spec/RunnerSpec.purs b/test/Test/Spec/RunnerSpec.purs
index 0ad8392..78c4c30 100644
--- a/test/Test/Spec/RunnerSpec.purs
+++ b/test/Test/Spec/RunnerSpec.purs
@@ -9,7 +9,7 @@ import Data.Maybe (Maybe(..))
 import Data.Newtype (un)
 import Data.Time.Duration (Milliseconds(..))
 import Effect.Aff (delay)
-import Test.Spec (Item(..), Spec, Tree(..), describe, it)
+import Test.Spec (Item(..), Spec, SpecT(..), Tree(..), describe, it)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Spec.Fixtures (itOnlyTest, describeOnlyNestedTest, describeOnlyTest, sharedDescribeTest, successTest)
 import Test.Spec.Tree (discardUnfocused)
@@ -20,34 +20,34 @@ runnerSpec =
     describe "Spec" $
       describe "Runner" do
         it "collects \"it\" and \"pending\" in Describe groups" do
-          runSpecFocused successTest `shouldEqual` 
-            [ Node (Left "a") 
+          runSpecFocused successTest `shouldEqual`
+            [ Node (Left "a")
               [ Node (Left "b") [ Leaf "works" $ Just false ]
               ]
             ]
         it "collects \"it\" and \"pending\" with shared Describes" do
-          runSpecFocused sharedDescribeTest `shouldEqual` 
-            [ Node (Left "a") 
+          runSpecFocused sharedDescribeTest `shouldEqual`
+            [ Node (Left "a")
               [ Node (Left "b") [ Leaf "works" $ Just false ]
               , Node (Left "c") [ Leaf "also works" $ Just false ]
               ]
             ]
         it "filters using \"only\" modifier on \"describe\" block" do
-          runSpecFocused describeOnlyTest `shouldEqual` 
-            [ Node (Left "a") 
+          runSpecFocused describeOnlyTest `shouldEqual`
+            [ Node (Left "a")
               [ Node (Left "b") [ Leaf "works" $ Just true ]
               , Node (Left "c") [ Leaf "also works" $ Just true ]
               ]
             ]
         it "filters using \"only\" modifier on nested \"describe\" block" do
-          runSpecFocused describeOnlyNestedTest `shouldEqual` 
-            [ Node (Left "a") 
+          runSpecFocused describeOnlyNestedTest `shouldEqual`
+            [ Node (Left "a")
               [ Node (Left "b") [ Leaf "works" $ Just true ]
               ]
             ]
         it "filters using \"only\" modifier on \"it\" block" do
-          runSpecFocused itOnlyTest `shouldEqual` 
-            [ Node (Left "a") 
+          runSpecFocused itOnlyTest `shouldEqual`
+            [ Node (Left "a")
               [ Node (Left "b") [ Leaf "works" $ Just true ]
               ]
             ]
@@ -55,4 +55,4 @@ runnerSpec =
           res <- delay (Milliseconds 10.0) *> pure 1
           res `shouldEqual` 1
   where
-    runSpecFocused t = discardUnfocused (execWriter t) <#> bimap (const unit) (un Item >>> _.isFocused)
\ No newline at end of file
+    runSpecFocused t = discardUnfocused (execWriter $ un SpecT t) <#> bimap (const unit) (un Item >>> _.isFocused)

From 708bc0ed0770f7115e72453ca4045fc9c0379ce9 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Wed, 16 Jan 2019 16:19:41 +0400
Subject: [PATCH 35/39] some documentation updates

---
 docs/running.md       | 17 +++++++++--------
 docs/writing-specs.md | 19 +++++++++++++++++--
 example/Main.purs     |  7 ++++---
 3 files changed, 30 insertions(+), 13 deletions(-)

diff --git a/docs/running.md b/docs/running.md
index bba8039..b343a07 100644
--- a/docs/running.md
+++ b/docs/running.md
@@ -1,10 +1,9 @@
 # Running
 
 When you have a spec, you need a runner to actually run it and get the results.
-PureScript Spec comes with a NodeJS runner, `run`, which takes an array of
+PureScript Spec comes with a NodeJS runner, `runSpec`, which takes an array of
 *reporters* and a spec to run. What you get back is a test-running program of
-type `Effect ()`. The effect rows in `r` depend on what you do in your specs and
-what reporters you are using. The program can be run using
+type `Aff Unit`. The program can be run using
 [Pulp](https://github.com/bodil/pulp).
 
 ```bash
@@ -25,13 +24,13 @@ After that has finished, you can run the test program using NodeJS.
 NODE_PATH=output node -e "require('Test.Main').main();"
 ```
 
-**NOTE:** A test program using `Test.Spec.Runner.run` cannot be browserified
+**NOTE:** A test program using `Test.Spec.Runner.runSpec` cannot be browserified
 and run in the browser, it requires NodeJS. To run your tests in a browser,
 see [Browser Testing](#browser-testing) below.
 
 ## Reporters
 
-Reporters can be passed to the runner, e.g. `run [reporter1, ..., reporterN]
+Reporters can be passed to the runner, e.g. `runSpec [reporter1, ..., reporterN]
 spec`. Currently there are these reporters available:
 
 * `consoleReporter` in `Test.Spec.Reporter.Console`
@@ -42,11 +41,13 @@ spec`. Currently there are these reporters available:
 
 ## Passing Runner Configuration
 
-In addition to the regular `run` function, there is also `run'`, which takes a
-`Config` record.
+In addition to the regular `runSpec` function, there is also `runSpecT`, which also
+takes `Config` record. also instead of `Spec Unit` it takes `SpecT Aff Unit m Unit`
+and returns `m (Aff (Array (Tree Void Result)))`. if we specialize the `m` to `Identity`
+then code will look like this:
 
 ```purescript
-main = launchAff_ $ run' testConfig [consoleReporter] mySpec
+main = launchAff_ $ un Identity $ runSpecT testConfig [consoleReporter] mySpec
   where
     testConfig = { slow: 5000, timeout: Just 10000, exit: false }
 ```
diff --git a/docs/writing-specs.md b/docs/writing-specs.md
index 445595a..22ca615 100644
--- a/docs/writing-specs.md
+++ b/docs/writing-specs.md
@@ -87,10 +87,10 @@ import Effect.Aff (launchAff_, delay)
 import Test.Spec (pending, describe, it)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Spec.Reporter.Console (consoleReporter)
-import Test.Spec.Runner (run)
+import Test.Spec.Runner (runSpec)
 
 main :: Effect Unit
-main = launchAff_ $ run [consoleReporter] do
+main = launchAff_ $ runSpec [consoleReporter] do
   describe "purescript-spec" do
     describe "Attributes" do
       it "awesome" do
@@ -147,6 +147,21 @@ describe "Module" do
     it "does feature Y" ...
 ```
 
+There is also `focus` which can be used to select some specific group for execution
+
+```purescript
+describe "Module" do
+  describe "Sub Module A"
+    it "does feature X" ...
+  focus $ describe "Sub Module B" do -- all tests passed to focus will be executed
+    it "does feature Y" ...
+    it "does feature Z" ...
+    describe "Sub Module C" do
+      it "does feature P" ...
+```
+
+
+
 ## QuickCheck
 
 You can use [QuickCheck](https://github.com/purescript/purescript-quickcheck)
diff --git a/example/Main.purs b/example/Main.purs
index 25eff5b..e8bd4f4 100644
--- a/example/Main.purs
+++ b/example/Main.purs
@@ -1,16 +1,17 @@
 module Main where
 
 import Prelude
+
+import Data.Time.Duration (Milliseconds(..))
 import Effect (Effect)
 import Effect.Aff (delay, launchAff_)
-import Data.Time.Duration (Milliseconds(..))
 import Test.Spec (pending, describe, it)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Spec.Reporter.Console (consoleReporter)
-import Test.Spec.Runner (run)
+import Test.Spec.Runner (runSpec)
 
 main :: Effect Unit
-main = launchAff_ $ run [consoleReporter] do
+main = launchAff_ $ runSpec [consoleReporter] do
   describe "purescript-spec" do
     describe "Attributes" do
       it "awesome" do

From 375b9d7fe527e9942dddf58991eacc71cea4348d Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Thu, 7 Feb 2019 17:17:27 +0400
Subject: [PATCH 36/39] restore run with warning

---
 src/Test/Spec/Runner.purs | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index 224fb70..5e02564 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -1,5 +1,6 @@
 module Test.Spec.Runner
-  ( runSpecT
+  ( run
+  , runSpecT
   , runSpec
   , defaultConfig
   , Config
@@ -9,6 +10,7 @@ module Test.Spec.Runner
 
 import Prelude
 
+import Prim.TypeError (class Warn, Text)
 import Control.Alternative ((<|>))
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Writer (execWriterT)
@@ -188,6 +190,14 @@ runSpecT config reporters spec = _run config spec <#> \runner -> do
         pure results
     else reportedEvents
 
+-- | Run the spec with the default config
+run
+  :: Warn (Text "`Test.Spec.Runner.run` is Deprecated use runSpec instead")
+  => Array Reporter
+  -> Spec Unit
+  -> Aff Unit
+run reporters spec = void $ un Identity $ runSpecT defaultConfig reporters spec
+
 -- | Run the spec with the default config
 runSpec
   :: Array Reporter

From c3780f04c4fca720afd3ddc413cb418db1fe190e Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Thu, 7 Feb 2019 17:33:56 +0400
Subject: [PATCH 37/39] add collect

---
 src/Test/Spec.purs             | 10 +++++++---
 src/Test/Spec/Runner.purs      |  9 ++++-----
 test/Test/Spec/RunnerSpec.purs |  8 ++++----
 3 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/src/Test/Spec.purs b/src/Test/Spec.purs
index 9ed5d04..ae53d33 100644
--- a/src/Test/Spec.purs
+++ b/src/Test/Spec.purs
@@ -4,6 +4,7 @@ module Test.Spec
   , module Reexport
   , SpecTree
   , mapSpecTree
+  , collect
 
   , ComputationType(..)
   , hoistSpec
@@ -50,7 +51,7 @@ import Control.Monad.Fork.Class (class MonadBracket, bracket)
 import Control.Monad.Reader (class MonadAsk, class MonadReader)
 import Control.Monad.Rec.Class (class MonadRec)
 import Control.Monad.State (class MonadState)
-import Control.Monad.Writer (WriterT, mapWriterT, tell)
+import Control.Monad.Writer (WriterT, execWriter, execWriterT, mapWriterT, tell)
 import Control.MonadPlus (class MonadPlus)
 import Control.MonadZero (class MonadZero)
 import Control.Plus (class Plus)
@@ -71,7 +72,7 @@ import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Exception (Error)
 import Prim.TypeError (class Warn, Text)
 import Test.Spec.Tree (ActionWith, Item(..), Tree(..)) as Reexport
-import Test.Spec.Tree (ActionWith, Item(..), Tree(..), bimapTree, modifyAroundAction)
+import Test.Spec.Tree (ActionWith, Item(..), Tree(..), bimapTree, discardUnfocused, modifyAroundAction)
 
 
 type Spec a = SpecT Aff Unit Identity a
@@ -124,6 +125,10 @@ hoistSpec f = mapSpecTree $ bimapTree onCleanUp onTest
       in item { example = e }
 
 
+-- | Collects all tests, if something is focused, all unfocused tests will be discarded
+collect :: forall m g i a. Functor m => SpecT g i m a -> m (Array (SpecTree g i))
+collect = un SpecT >>> execWriterT >>> map discardUnfocused
+
 class Example t arg m | t -> arg, t -> m where
   evaluateExample :: t -> (ActionWith m arg -> m Unit) -> m Unit
 
@@ -136,7 +141,6 @@ else instance exampleMUnit :: Example (m Unit) Unit m where
   evaluateExample t around' = around' $ \_ -> t
 
 
-
 -- | Nullary class used to raise a custom warning for the focusing functions.
 class FocusWarning
 
diff --git a/src/Test/Spec/Runner.purs b/src/Test/Spec/Runner.purs
index 5e02564..d5a490c 100644
--- a/src/Test/Spec/Runner.purs
+++ b/src/Test/Spec/Runner.purs
@@ -10,10 +10,8 @@ module Test.Spec.Runner
 
 import Prelude
 
-import Prim.TypeError (class Warn, Text)
 import Control.Alternative ((<|>))
 import Control.Monad.Trans.Class (lift)
-import Control.Monad.Writer (execWriterT)
 import Control.Parallel (parTraverse, parallel, sequential)
 import Data.Array (groupBy, mapWithIndex)
 import Data.Array.NonEmpty as NEA
@@ -36,7 +34,8 @@ import Effect.Now (now)
 import Pipes ((>->), yield)
 import Pipes.Core (Pipe, Producer, (//>))
 import Pipes.Core (runEffectRec) as P
-import Test.Spec (Item(..), Spec, SpecT(..), SpecTree, Tree(..))
+import Prim.TypeError (class Warn, Text)
+import Test.Spec (Item(..), Spec, SpecT, SpecTree, Tree(..), collect)
 import Test.Spec.Console as Console
 import Test.Spec.Result (Result(..))
 import Test.Spec.Runner.Event (Event, Execution(..))
@@ -45,7 +44,7 @@ import Test.Spec.Speed (speedOf)
 import Test.Spec.Style (styled)
 import Test.Spec.Style as Style
 import Test.Spec.Summary (successful)
-import Test.Spec.Tree (Path, PathItem(..), countTests, discardUnfocused, isAllParallelizable)
+import Test.Spec.Tree (Path, PathItem(..), countTests, isAllParallelizable)
 
 foreign import exit :: Int -> Effect Unit
 
@@ -93,7 +92,7 @@ _run
   => Config
   -> SpecT Aff Unit m Unit
   -> m TestEvents
-_run config (SpecT specs) = execWriterT specs <#> discardUnfocused >>> \tests -> do
+_run config = collect >>> map \tests -> do
   yield (Event.Start (countTests tests))
   let indexer index test = {test, path: [PathItem {name: Nothing, index}]}
   r <- loop $ mapWithIndex indexer tests
diff --git a/test/Test/Spec/RunnerSpec.purs b/test/Test/Spec/RunnerSpec.purs
index 78c4c30..735f02e 100644
--- a/test/Test/Spec/RunnerSpec.purs
+++ b/test/Test/Spec/RunnerSpec.purs
@@ -2,17 +2,16 @@ module Test.Spec.RunnerSpec where
 
 import Prelude
 
-import Control.Monad.Writer (execWriter)
 import Data.Bifunctor (bimap)
 import Data.Either (Either(..))
+import Data.Identity (Identity(..))
 import Data.Maybe (Maybe(..))
 import Data.Newtype (un)
 import Data.Time.Duration (Milliseconds(..))
 import Effect.Aff (delay)
-import Test.Spec (Item(..), Spec, SpecT(..), Tree(..), describe, it)
+import Test.Spec (Item(..), Spec, SpecT, Tree(..), collect, describe, it)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Spec.Fixtures (itOnlyTest, describeOnlyNestedTest, describeOnlyTest, sharedDescribeTest, successTest)
-import Test.Spec.Tree (discardUnfocused)
 
 runnerSpec :: Spec Unit
 runnerSpec =
@@ -55,4 +54,5 @@ runnerSpec =
           res <- delay (Milliseconds 10.0) *> pure 1
           res `shouldEqual` 1
   where
-    runSpecFocused t = discardUnfocused (execWriter $ un SpecT t) <#> bimap (const unit) (un Item >>> _.isFocused)
+    runSpecFocused :: SpecT Identity Unit Identity Unit -> Array (Tree Unit Boolean)
+    runSpecFocused t = un Identity (collect t) <#> (bimap (const unit) (un Item >>> _.isFocused))

From 0d50c9c8a3916832818ca8c724d6749f9a2831bd Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Thu, 7 Feb 2019 17:48:16 +0400
Subject: [PATCH 38/39] allow chaning of `m` in hoistSpec and mapSpecTree

---
 src/Test/Spec.purs            | 21 +++++++++++----------
 test/Test/Spec/HoistSpec.purs |  2 +-
 2 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/src/Test/Spec.purs b/src/Test/Spec.purs
index ae53d33..b07fd8b 100644
--- a/src/Test/Spec.purs
+++ b/src/Test/Spec.purs
@@ -103,17 +103,18 @@ derive newtype instance monadStateSpecT :: MonadState s m => MonadState s (SpecT
 type SpecTree m a = Tree (ActionWith m a) (Item m a)
 
 mapSpecTree
-  :: forall m g g' i a i'
-   . Monad m
-   => (SpecTree g i -> SpecTree g' i')
+  :: forall m m' g g' i a i'
+   . Functor m'
+   => (m ~> m')
+   -> (SpecTree g i -> SpecTree g' i')
    -> SpecT g i m a
-   -> SpecT g' i' m a
-mapSpecTree f = over SpecT $ mapWriterT $ map $ map $ map f
+   -> SpecT g' i' m' a
+mapSpecTree g f = over SpecT $ mapWriterT $ g >>> map (map $ map f)
 
 data ComputationType = CleanUpWithContext (Array String) | TestWithName (NonEmptyArray String)
 
-hoistSpec :: forall m i a b. Monad m => (ComputationType -> a ~> b) -> SpecT a i m ~> SpecT b i m
-hoistSpec f = mapSpecTree $ bimapTree onCleanUp onTest
+hoistSpec :: forall m' m i a b. Monad m' => (m ~> m') -> (ComputationType -> a ~> b) -> SpecT a i m ~> SpecT b i m'
+hoistSpec onM f = mapSpecTree onM $ bimapTree onCleanUp onTest
   where
     onCleanUp :: Array String -> (ActionWith a i) -> ActionWith b i
     onCleanUp name around' = \i -> f (CleanUpWithContext name) (around' i)
@@ -188,7 +189,7 @@ parallel
    . Monad m
   => SpecT g i m a
   -> SpecT g i m a
-parallel = mapSpecTree $ bimap identity (setParallelizable true)
+parallel = mapSpecTree identity $ bimap identity (setParallelizable true)
 
 -- | marks all spec items of the given spec to be evaluated sequentially.
 sequential
@@ -196,7 +197,7 @@ sequential
    . Monad m
   => SpecT g i m a
   -> SpecT g i m a
-sequential = mapSpecTree $ bimap identity (setParallelizable false)
+sequential = mapSpecTree identity $ bimap identity (setParallelizable false)
 
 setParallelizable :: forall g a. Boolean -> Item g a -> Item g a
 setParallelizable value = over Item \i -> i{isParallelizable = i.isParallelizable <|> Just value}
@@ -260,7 +261,7 @@ aroundWith
   => (ActionWith g i -> ActionWith g i')
   -> SpecT g i m a
   -> SpecT g i' m a
-aroundWith action = mapSpecTree $ bimap action (modifyAroundAction action)
+aroundWith action = mapSpecTree identity $ bimap action (modifyAroundAction action)
 
 -- | Run a custom action before and/or after every spec item.
 around_ :: forall m g i a. Monad m => (g Unit -> g Unit) -> SpecT g i m a -> SpecT g i m a
diff --git a/test/Test/Spec/HoistSpec.purs b/test/Test/Spec/HoistSpec.purs
index 8870d36..1d34c1b 100644
--- a/test/Test/Spec/HoistSpec.purs
+++ b/test/Test/Spec/HoistSpec.purs
@@ -28,7 +28,7 @@ hoistSpecSpecReaderT = go $ parallel do
     }
   where
     go :: Spec' (ReaderT (String -> Aff Unit) Aff) ~> Spec
-    go = hoistSpec \cType m ->
+    go = hoistSpec identity \cType m ->
       let
         prefix = case cType of
           CleanUpWithContext n -> intercalate " > " n <> " (afterAll) "

From 85c503f868f7f2c1099062c1348758eb75173626 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Mon, 18 Feb 2019 17:16:02 +0400
Subject: [PATCH 39/39] fix warning

---
 src/Test/Spec.purs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Test/Spec.purs b/src/Test/Spec.purs
index b07fd8b..d1975d1 100644
--- a/src/Test/Spec.purs
+++ b/src/Test/Spec.purs
@@ -51,7 +51,7 @@ import Control.Monad.Fork.Class (class MonadBracket, bracket)
 import Control.Monad.Reader (class MonadAsk, class MonadReader)
 import Control.Monad.Rec.Class (class MonadRec)
 import Control.Monad.State (class MonadState)
-import Control.Monad.Writer (WriterT, execWriter, execWriterT, mapWriterT, tell)
+import Control.Monad.Writer (WriterT, execWriterT, mapWriterT, tell)
 import Control.MonadPlus (class MonadPlus)
 import Control.MonadZero (class MonadZero)
 import Control.Plus (class Plus)