7startups/tests/tests.hs at Step3 · bartavelle/7startups · GitHub

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
{-# LANGUAGE OverloadedStrings #-}
module Main where

import Startups.Base
import Startups.Cards
import Startups.CardList
import Startups.GameTypes
import Startups.Utils
import Backends.Pure

import Control.Lens
import Data.List (foldl')
import Test.Hspec
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Map.Strict as M
import System.Random
import Test.QuickCheck
import Data.Monoid
import Control.Monad
import Data.Maybe (fromJust)

getCard :: T.Text -> Card
getCard n = case filter (\c -> c ^? cName == Just n) allcards of
                (c:_) -> c
                [] -> error (T.unpack n <> " could not be found")

-- | Some game state that is good enough for testing things
testState :: GameState
testState = GameState (M.fromList players) [] (mkStdGen 5)
    where
        players = [ ("pim", pim), ("pam", pam), ("poum", poum), ("bob", bob )]
        ppim = CompanyProfile Facebook A
        ppam = CompanyProfile Apple B
        ppoum = CompanyProfile Google A
        pbob = CompanyProfile Twitter A
        pim  = PlayerState ppim Project pimcards 1 ("pam", "bob") []
        pam  = PlayerState ppam Project pamcards 3 ("poum", "pim") []
        poum = PlayerState ppoum Project poumcards 6 ("bob", "pam") []
        bob  = PlayerState pbob Project bobcards 5 ("pim", "poum") []
        pimcards = map (getResourceCard ppim) [Project .. Stage1] <> map getCard [ "Cloud Servers"
                                                                                 , "Marketroid"
                                                                                 , "Company Nerf Battles"
                                                                                 ]
        pamcards = map (getResourceCard ppam) [Project] <> map getCard [ "High Speed Internet"
                                                                       , "Free Food"
                                                                       , "Enterprise Programmer"
                                                                       , "Rock Star Evangelist"
                                                                       ]
        poumcards = map (getResourceCard ppoum) [Project .. Stage1] <> map getCard [ "Garage"
                                                                                   , "Business Angel"
                                                                                   , "Admin Network"
                                                                                   ]
        bobcards = map (getResourceCard pbob) [Project] <> map getCard [ "Accountant"
                                                                       , "Operations Guru"
                                                                       , "Financial Developer"
                                                                       , "Standing Desks"
                                                                       ]

main :: IO ()
main = hspec $ do
    describe "Cards" $ do
        it "are all distinct" $ let extra = foldl' findExtra ([], S.empty) allcards
                                    findExtra (curlst, cardset) card | card `S.member` cardset = (card : curlst, cardset)
                                                                     | otherwise = (curlst, S.insert card cardset)
                                in  fst extra `shouldBe` []

        let nbc age nbplayers = it ("are the correct number for " ++ show age ++ " and " ++ show (getPlayerCount nbplayers) ++ " players") (cardsCount age nbplayers `shouldBe` expectedCount age nbplayers)
            expectedCount age nbplayers = fromIntegral $ nbplayers * 7 - if age == Age3 then nbplayers + 2 else 0
            cardsCount    age nbplayers = length (filter (\c -> c ^? cAge == Just age && c ^? cMinplayers <= Just nbplayers) allcards)
        mapM_ (uncurry nbc) [ (age, nbp) | age <- [Age1,Age2,Age3], nbp <- [3 .. 7] ]
    describe "availableResources" $
        forM_ [("pam", ["AVD$$$"]), ("pim", ["YMF$"]), ("poum", ["D$$$$$$"]), ("bob", ["YF$$$$$DM", "YF$$$$$FO", "YF$$$$$DO", "YF$$$$$FM"])] $ \(pid, reslist) ->
            let getResCost (Cost rescost _) = rescost
                expected = S.fromList (map getResCost reslist)
                actual = S.fromList $ availableResources OwnRes (fromJust (testState ^? playermap . ix pid))
            in  it ("Is correct for " <> T.unpack pid) $ actual `shouldBe` expected
    describe "random games" $ do
        let gs = do
                seed <- arbitrary
                nbplayers <- Test.QuickCheck.elements [3 .. 7]
                return (seed, nbplayers :: Int)
        it "end well" $ forAll gs $ \(seed, nbplayers) -> case pureGame (mkStdGen seed) (map (T.pack . show) [1 .. nbplayers]) of
                                                              (_, Right _) -> True
                                                              _ -> False