|
1 |
| -import Test.HUnit (Assertion, (@=?), runTestTT, Test(..), Counts(..)) |
2 |
| -import System.Exit (ExitCode(..), exitWith) |
3 |
| -import Data.List (foldl', sort) |
4 |
| -import qualified Data.Set as Set |
5 |
| -import Counting (Color(..), territories, territoryFor) |
| 1 | +import Data.Bifunctor (first) |
| 2 | +import Data.MultiSet (fromOccurList, toOccurList) |
| 3 | +import Data.Set (toAscList) |
| 4 | +import Data.Tuple (swap) |
| 5 | +import Test.Hspec (Spec, describe, it, shouldBe, shouldMatchList) |
| 6 | +import Test.Hspec.Runner (configFastFail, defaultConfig, hspecWith) |
6 | 7 |
|
7 |
| -exitProperly :: IO Counts -> IO () |
8 |
| -exitProperly m = do |
9 |
| - counts <- m |
10 |
| - exitWith $ if failures counts /= 0 || errors counts /= 0 then ExitFailure 1 else ExitSuccess |
11 |
| - |
12 |
| -testCase :: String -> Assertion -> Test |
13 |
| -testCase label assertion = TestLabel label (TestCase assertion) |
| 8 | +import Counting (Color(Black,White), territories, territoryFor) |
14 | 9 |
|
15 | 10 | main :: IO ()
|
16 |
| -main = exitProperly $ runTestTT $ TestList |
17 |
| - [ TestList countingTests ] |
18 |
| - |
19 |
| -type Coord = (Int, Int) |
20 |
| - |
21 |
| --- Helper for invoking 'territories' and getting an easy to compare result. |
22 |
| -terrs :: [[Char]] -> [([Coord], Maybe Color)] |
23 |
| -terrs = sort . map worker . territories |
24 |
| - where |
25 |
| - worker (s, o) = (Set.toAscList s, o) |
26 |
| - |
27 |
| --- Helper for invoking 'territoryFor' and getting an easy to compare |
28 |
| --- result. |
29 |
| -terrFor :: [[Char]] -> Coord -> Maybe ([Coord], Maybe Color) |
30 |
| -terrFor b c = case territoryFor b c of |
31 |
| - Nothing -> Nothing |
32 |
| - Just (s, o) -> Just (Set.toAscList s, o) |
33 |
| - |
34 |
| --- | The score for black, white and none respectively. |
35 |
| -data Score = Score { |
36 |
| - scoreBlack :: !Int, |
37 |
| - scoreWhite :: !Int, |
38 |
| - scoreNone :: !Int |
39 |
| -} deriving (Eq, Show) |
40 |
| - |
41 |
| --- Board to points: black, white, none. |
42 |
| -score :: [[Char]] -> Score |
43 |
| -score = foldl' worker (Score 0 0 0) . territories |
44 |
| - where |
45 |
| - worker sc (s, Just Black) = sc { scoreBlack = scoreBlack sc + Set.size s } |
46 |
| - worker sc (s, Just White) = sc { scoreWhite = scoreWhite sc + Set.size s } |
47 |
| - worker sc (s, Nothing) = sc { scoreNone = scoreNone sc + Set.size s } |
48 |
| - |
49 |
| -board5x5 :: [[Char]] |
50 |
| -board5x5 = |
51 |
| - [" B ", |
52 |
| - " B B ", |
53 |
| - "B W B", |
54 |
| - " W W ", |
55 |
| - " W "] |
56 |
| - |
57 |
| -board9x9 :: [[Char]] |
58 |
| -board9x9 = |
59 |
| - [" B B ", |
60 |
| - "B B B", |
61 |
| - "WBBBWBBBW", |
62 |
| - "W W W W W", |
63 |
| - " ", |
64 |
| - " W W W W ", |
65 |
| - "B B B B", |
66 |
| - " W BBB W ", |
67 |
| - " B B "] |
68 |
| - |
69 |
| -countingTests :: [Test] |
70 |
| -countingTests = |
71 |
| - [ testCase "minimal board, no territories" $ |
72 |
| - [] @=? terrs ["B"], |
73 |
| - testCase "one territory, covering the whole board" $ |
74 |
| - [([(1,1)], Nothing)] @=? terrs [" "], |
75 |
| - testCase "two territories, rectangular board" $ |
76 |
| - [([(1,1), (1,2)], Just Black), |
77 |
| - ([(4,1), (4,2)], Just White)] |
78 |
| - @=? terrs [" BW ", " BW "], |
79 |
| - testCase "5x5 score" $ |
80 |
| - Score 6 1 9 @=? score board5x5, |
81 |
| - testCase "5x5 territory for black" $ |
82 |
| - Just ([(1,1), (1,2), (2,1)], Just Black) |
83 |
| - @=? terrFor board5x5 (1,2), |
84 |
| - testCase "5x5 territory for white" $ |
85 |
| - Just ([(3,4)], Just White) |
86 |
| - @=? terrFor board5x5 (3,4), |
87 |
| - testCase "5x5 open territory" $ |
88 |
| - Just ([(1,4), (1,5), (2,5)], Nothing) |
89 |
| - @=? terrFor board5x5 (2,5), |
90 |
| - testCase "5x5 non-territory (stone)" $ |
91 |
| - Nothing @=? terrFor board5x5 (2,2), |
92 |
| - testCase "5x5 non-territory (too low coordinate)" $ |
93 |
| - Nothing @=? terrFor board5x5 (0,2), |
94 |
| - testCase "5x5 non-territory (too high coordinate)" $ |
95 |
| - Nothing @=? terrFor board5x5 (2,6), |
96 |
| - testCase "9x9 score" $ |
97 |
| - Score 14 0 33 @=? score board9x9 |
98 |
| - ] |
| 11 | +main = hspecWith defaultConfig {configFastFail = True} specs |
| 12 | + |
| 13 | +specs :: Spec |
| 14 | +specs = describe "go-counting" $ do |
| 15 | + |
| 16 | + -- As of 2016-07-27, there was no reference file |
| 17 | + -- for the test cases in `exercism/x-common`. |
| 18 | + |
| 19 | + let board5x5 = [ " B " |
| 20 | + , " B B " |
| 21 | + , "B W B" |
| 22 | + , " W W " |
| 23 | + , " W " ] |
| 24 | + |
| 25 | + board9x9 = [ " B B " |
| 26 | + , "B B B" |
| 27 | + , "WBBBWBBBW" |
| 28 | + , "W W W W W" |
| 29 | + , " " |
| 30 | + , " W W W W " |
| 31 | + , "B B B B" |
| 32 | + , " W BBB W " |
| 33 | + , " B B " ] |
| 34 | + |
| 35 | + shouldHaveTerritories = shouldMatchList |
| 36 | + . map (first toAscList) |
| 37 | + . territories |
| 38 | + |
| 39 | + shouldScore = shouldMatchList |
| 40 | + . toOccurList |
| 41 | + . fromOccurList |
| 42 | + . map (swap . first length) |
| 43 | + . territories |
| 44 | + |
| 45 | + territoryIn xss = fmap (first toAscList) . territoryFor xss |
| 46 | + |
| 47 | + it "minimal board, no territories" $ |
| 48 | + [ "B" ] `shouldHaveTerritories` [] |
| 49 | + |
| 50 | + it "one territory, covering the whole board" $ |
| 51 | + [ " " ] `shouldHaveTerritories` [([ (1, 1) ], Nothing)] |
| 52 | + |
| 53 | + it "two territories, rectangular board" $ |
| 54 | + [ " BW " |
| 55 | + , " BW " ] `shouldHaveTerritories` [ ([ (1, 1) |
| 56 | + , (1, 2) ], Just Black) |
| 57 | + , ([ (4, 1) |
| 58 | + , (4, 2) ], Just White) ] |
| 59 | + |
| 60 | + it "5x5 score" $ |
| 61 | + board5x5 `shouldScore` [ (Nothing , 9) |
| 62 | + , (Just Black, 6) |
| 63 | + , (Just White, 1) ] |
| 64 | + |
| 65 | + it "5x5 territory for black" $ |
| 66 | + territoryIn board5x5 (1, 2) `shouldBe` Just ([ (1, 1) |
| 67 | + , (1, 2) |
| 68 | + , (2, 1) ], Just Black) |
| 69 | + |
| 70 | + it "5x5 territory for white" $ |
| 71 | + territoryIn board5x5 (3, 4) `shouldBe` Just ([ (3, 4) ], Just White) |
| 72 | + |
| 73 | + it "5x5 open territory" $ |
| 74 | + territoryIn board5x5 (2, 5) `shouldBe` Just ([ (1, 4) |
| 75 | + , (1, 5) |
| 76 | + , (2, 5) ], Nothing) |
| 77 | + |
| 78 | + it "5x5 non-territory (stone)" $ |
| 79 | + territoryIn board5x5 (2, 2) `shouldBe` Nothing |
| 80 | + |
| 81 | + it "5x5 non-territory (too low coordinate)" $ |
| 82 | + territoryIn board5x5 (0, 2) `shouldBe` Nothing |
| 83 | + |
| 84 | + it "5x5 non-territory (too high coordinate)" $ |
| 85 | + territoryIn board5x5 (2, 6) `shouldBe` Nothing |
| 86 | + |
| 87 | + it "9x9 score" $ |
| 88 | + board9x9 `shouldScore` [ (Nothing , 33) |
| 89 | + , (Just Black, 14) ] |
0 commit comments