zipper: Rewrite tests to use hspec with fail-fast.

exercises/zipper/package.yaml

@@ -16,4 +16,4 @@ tests:
     source-dirs: test
     dependencies:
       - zipper
-      - HUnit
+      - hspec

exercises/zipper/src/Zipper.hs

@@ -1,62 +1,44 @@
-module Zipper (
-    BinTree(..),
-    Zipper,
-
-    fromTree,
-    toTree,
-
-    value,
-    left,
-    right,
-    up,
-
-    setValue,
-    setLeft,
-    setRight
-) where
-
--- | A binary tree.
-data BinTree a = BT { 
-    btValue :: a                 -- ^ Value
-  , btLeft  :: Maybe (BinTree a) -- ^ Left child
-  , btRight :: Maybe (BinTree a) -- ^ Right child
-} deriving (Eq, Show)
-
--- | A zipper for a binary tree.
-data Zipper a -- Complete this definition
-
--- | Get a zipper focussed on the root node.
+module Zipper
+ ( BinTree(BT)
+ , fromTree
+ , left
+ , right
+ , setLeft
+ , setRight
+ , setValue
+ , toTree
+ , up
+ , value
+ ) where
+
+data BinTree a = BT { btValue :: a
+                    , btLeft  :: Maybe (BinTree a)
+                    , btRight :: Maybe (BinTree a)
+                    } deriving (Eq, Show)
+
 fromTree :: BinTree a -> Zipper a
 fromTree = undefined
 
--- | Get the complete tree from a zipper.
 toTree :: Zipper a -> BinTree a
 toTree = undefined
 
--- | Get the value of the focus node.
 value :: Zipper a -> a
-value = undefined 
+value = undefined
 
--- | Get the left child of the focus node, if any.
 left :: Zipper a -> Maybe (Zipper a)
 left = undefined
 
--- | Get the right child of the focus node, if any.
 right :: Zipper a -> Maybe (Zipper a)
 right = undefined
 
--- | Get the parent of the focus node, if any.
 up :: Zipper a -> Maybe (Zipper a)
 up = undefined
 
--- | Set the value of the focus node.
 setValue :: a -> Zipper a -> Zipper a
 setValue = undefined
 
--- | Replace a left child tree.
 setLeft :: Maybe (BinTree a) -> Zipper a -> Zipper a
-setLeft = undefined 
+setLeft = undefined
 
--- | Replace a right child tree.
 setRight :: Maybe (BinTree a) -> Zipper a -> Zipper a
 setRight = undefined

exercises/zipper/test/Tests.hs

@@ -1,52 +1,64 @@
-import Test.HUnit (Assertion, (@=?), runTestTT, Test(..), Counts(..))
-import System.Exit (ExitCode(..), exitWith)
-import Data.Maybe (fromJust)
+import Data.Maybe        (fromJust)
+import Test.Hspec        (Spec, describe, it, shouldBe)
+import Test.Hspec.Runner (configFastFail, defaultConfig, hspecWith)
+
 import Zipper
+ ( BinTree(BT)
+ , fromTree
+ , left
+ , right
+ , setLeft
+ , setRight
+ , setValue
+ , toTree
+ , up
+ , value
+ )
 
-exitProperly :: IO Counts -> IO ()
-exitProperly m = do
-  counts <- m
-  exitWith $ if failures counts /= 0 || errors counts /= 0 then ExitFailure 1 else ExitSuccess
+main :: IO ()
+main = hspecWith defaultConfig {configFastFail = True} specs
 
-testCase :: String -> Assertion -> Test
-testCase label assertion = TestLabel label (TestCase assertion)
+specs :: Spec
+specs = describe "zipper" $ do
 
-main :: IO ()
-main = exitProperly $ runTestTT $ TestList
-       [ TestList zipperTests ]
-
-empty :: Maybe (BinTree a)
-empty = Nothing
-
-bt :: Int -> Maybe (BinTree Int) -> Maybe (BinTree Int) -> Maybe (BinTree Int)
-bt v l r = Just (BT v l r)
-
-leaf :: Int -> Maybe (BinTree Int)
-leaf v = bt v Nothing Nothing
-
-t1, t2, t3, t4 :: BinTree Int
-t1 = BT 1 (bt 2 empty    (leaf 3)) (leaf 4)
-t2 = BT 1 (bt 5 empty    (leaf 3)) (leaf 4)
-t3 = BT 1 (bt 2 (leaf 5) (leaf 3)) (leaf 4)
-t4 = BT 1 (leaf 2)                 (leaf 4)
-
-zipperTests :: [Test]
-zipperTests =
-  [ testCase "data is retained" $
-    t1 @=? toTree (fromTree t1)
-  , testCase "left, right and value" $
-    3 @=? (value . fromJust . right . fromJust . left . fromTree $ t1)
-  , testCase "dead end" $
-    Nothing @=? (left . fromJust . left . fromTree $ t1)
-  , testCase "tree from deep focus" $
-    t1 @=? (toTree . fromJust . right . fromJust . left . fromTree $ t1)
-  , testCase "setValue" $
-    t2 @=? (toTree . setValue 5 . fromJust . left . fromTree $ t1)
-  , testCase "setLeft with Just" $
-    t3 @=? (toTree . setLeft (Just (BT 5 Nothing Nothing)) . fromJust . left . fromTree $ t1)
-  , testCase "setRight with Nothing" $
-    t4 @=? (toTree . setRight Nothing . fromJust . left . fromTree $ t1)
-  , testCase "different paths to same zipper" $
-    (right . fromTree $ t1) @=?
-    (right . fromJust . up . fromJust . left . fromTree $ t1)
-  ]
+    -- As of 2016-09-27, there was no reference file
+    -- for the test cases in `exercism/x-common`.
+
+    let leaf v     = node v Nothing Nothing
+        node v l r = Just (BT v l r :: BinTree Int)
+        t1         = BT 1 (node 2 Nothing  $ leaf 3) $ leaf 4
+        t2         = BT 1 (node 5 Nothing  $ leaf 3) $ leaf 4
+        t3         = BT 1 (node 2 (leaf 5) $ leaf 3) $ leaf 4
+        t4         = BT 1 (leaf 2                  ) $ leaf 4
+
+    it "data is retained" $
+      toTree (fromTree t1)
+      `shouldBe` t1
+
+    it "left, right and value" $
+      (value . fromJust . right . fromJust . left . fromTree) t1
+      `shouldBe` 3
+
+    it "dead end" $
+      (left . fromJust . left . fromTree) t1
+      `shouldBe` Nothing
+
+    it "tree from deep focus" $
+      (toTree . fromJust . right . fromJust . left . fromTree) t1
+      `shouldBe` t1
+
+    it "setValue" $
+      (toTree . setValue 5 . fromJust . left . fromTree) t1
+      `shouldBe` t2
+
+    it "setLeft with Just" $
+      (toTree . setLeft (leaf 5) . fromJust . left . fromTree) t1
+      `shouldBe` t3
+
+    it "setRight with Nothing" $
+      (toTree . setRight Nothing . fromJust . left . fromTree) t1
+      `shouldBe` t4
+
+    it "different paths to same zipper" $
+      (right . fromJust . up . fromJust . left . fromTree) t1
+      `shouldBe` (right . fromTree) t1