1
exercism fetch haskell dominoes

test/Tests.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Monad     (forM_, unless)
import Data.Foldable     (for_)
import Data.Function     (on)
import Test.Hspec        (Spec, describe, expectationFailure, it, shouldBe, shouldMatchList)
import Test.Hspec.Runner (configFastFail, defaultConfig, hspecWith)
import Text.Printf       (printf)

import Dominoes (chain)

main :: IO ()
main = hspecWith defaultConfig {configFastFail = True} specs

specs :: Spec
specs = describe "chain" $ for_ cases test
  where

    test Case{..} = it description assertion
      where
        assertion = if expected
                      then shouldBeChain $ chain input
                      else chain input `shouldBe` Nothing

        shouldBeChain Nothing = expectationFailure "should have had a chain, but didn't"
        shouldBeChain (Just output) = do
          output `shouldMatchDominoesOf` input
          consecutivesShouldMatch output
          endsShouldMatch output

        shouldMatchDominoesOf = shouldMatchList `on` map sortDomino

        consecutivesShouldMatch l = forM_ (indexedPairs l) $ \(d1, d2, i) ->
          shouldBeConsecutive l ("domino " ++ show i, d1) ("domino " ++ show (i + 1), d2)

        endsShouldMatch [] = return ()
        endsShouldMatch l@(d1:_) =
          shouldBeConsecutive l (" last domino", last l) ("first domino", d1)

        indexedPairs :: [a] -> [(a, a, Int)]
        indexedPairs l = zip3 l (drop 1 l) [1..]

        sortDomino (a, b) = if a > b then (b, a) else (a, b)

        shouldBeConsecutive l (name1, d1@(_, d1r)) (name2, d2@(d2l, _)) =
          unless (d1r == d2l) $
            expectationFailure $
              printf "In chain %s:\n\t   right end of %s (%s)\n\tand left end of %s (%s)\n\tdidn't match!" (show l) name1 (show d1) name2 (show d2)

data Case = Case { description :: String
                 , input       :: [(Int, Int)]
                 , expected    :: Bool
                 }

cases :: [Case]
cases = [ Case { description = "empty input = empty output"
               , input       = []
               , expected    = True
               }
        , Case { description = "singleton input = singleton output"
               , input       = [(1, 1)]
               , expected    = True
               }
        , Case { description = "singleton that can't be chained"
               , input       = [(1, 2)]
               , expected    = False
               }
        , Case { description = "three elements"
               , input       = [(1, 2), (3, 1), (2, 3)]
               , expected    = True
               }
        , Case { description = "can reverse dominoes"
               , input       = [(1, 2), (1, 3), (2, 3)]
               , expected    = True
               }
        , Case { description = "can't be chained"
               , input       = [(1, 2), (4, 1), (2, 3)]
               , expected    = False
               }
        , Case { description = "disconnected - simple"
               , input       = [(1, 1), (2, 2)]
               , expected    = False
               }
        , Case { description = "disconnected - double loop"
               , input       = [(1, 2), (2, 1), (3, 4), (4, 3)]
               , expected    = False
               }
        , Case { description = "disconnected - single isolated"
               , input       = [(1, 2), (2, 3), (3, 1), (4, 4)]
               , expected    = False
               }
        , Case { description = "need backtrack"
               , input       = [(1, 2), (2, 3), (3, 1), (2, 4), (2, 4)]
               , expected    = True
               }
        , Case { description = "separate loops"
               , input       = [(1, 2), (2, 3), (3, 1), (1, 1), (2, 2), (3, 3)]
               , expected    = True
               }
        , Case { description = "nine elements"
               , input       = [(1, 2), (5, 3), (3, 1), (1, 2), (2, 4), (1, 6), (2, 3), (3, 4), (5, 6)]
               , expected    = True
               }
        ]