module Tests.LetterBagTest where import Test.QuickCheck (Property, quickCheck) import Test.QuickCheck.Monadic as Q (assert, monadicIO, pick, pre, run) import Wordify.Rules.LetterBag import Wordify.Rules.LetterBag.Internal import Wordify.Rules.Tile import Tests.Utils import System.IO (hPutStr, hFlush, hPutStrLn, hClose) import Test.HUnit.Base as H import Wordify.Rules.ScrabbleError import Data.Map import Data.Maybe import qualified Data.List as L import Tests.Instances bagFromTilesProperty :: [Tile] -> Property bagFromTilesProperty inputTiles = monadicIO $ do bag <- run $ bagFromTiles inputTiles let LetterBag resultingTiles numTiles generator validLetters = bag Q.assert $ numTiles == (length inputTiles) && resultingTiles == inputTiles shuffleProperty :: LetterBag -> Bool shuffleProperty bag = let shuffled = shuffleBag bag in if (bagSize bag < 10) then sameTiles bag shuffled else bagIsShuffled bag shuffled && sameTiles bag shuffled where sameTiles originalBag shuffledBag = bagSize originalBag == (length $ (tiles originalBag) `L.intersect` (tiles shuffledBag)) bagIsShuffled originalBag shuffledBag = not $ originalBag == shuffledBag shuffleTwiceProperty :: LetterBag -> Bool shuffleTwiceProperty bag = if (bagSize bag < 10) then True else not $ bag1 == bag2 && bagSize bag1 == bagSize bag2 where bag1 = shuffleBag bag bag2 = shuffleBag bag1 takeLettersProperty :: LetterBag -> Int -> Bool takeLettersProperty letterBag numTake = if (originalBagSize < numTake) then takeLetters letterBag numTake == Nothing else takeLetters letterBag numTake == Just (expectedTiles, expectedBag) where LetterBag originalBagTiles originalBagSize gen validLetters = letterBag expectedTiles = L.take numTake originalBagTiles expectedBag = LetterBag (L.drop numTake originalBagTiles) (originalBagSize - numTake) gen validLetters exchangeLettersProperty :: LetterBag -> [Tile] -> Bool exchangeLettersProperty letterBag toExchange = let exchangeResult = exchangeLetters letterBag toExchange in case exchangeResult of Nothing -> originalNumTiles == 0 Just (given, LetterBag newTiles newNumTiles newGenerator validLetters) -> (originalNumTiles == newNumTiles) && length given == length toExchange && forAll (\tile -> (getCount tile newTileCounts) == (getCount tile originalTileCounts) + (getCount tile exchangedCounts) - (getCount tile givenCounts) ) allTiles where allTiles = given ++ newTiles ++ originalTiles givenCounts = countMap given newTileCounts = countMap newTiles originalTileCounts = countMap originalTiles exchangedCounts = countMap toExchange countMap xs = fromListWith (+) [(x, 1) | x <- xs] getCount key m = findWithDefault 0 key m forAll condition list = L.null $ L.filter (not . condition) list where LetterBag originalTiles originalNumTiles generator validLetters = letterBag makeBagInvalidlyFormattedBag :: Assertion makeBagInvalidlyFormattedBag = withTempFile $ \ filePath handle -> do let invalidStr = "A 2 2 3 4" -- Erroneous extra number hPutStrLn handle invalidStr hFlush handle hClose handle letterBag <- makeBag filePath case letterBag of Left (MalformedLetterBagFile _) -> return () x -> H.assertFailure $ "Input with invalidly formatted bag unexpectedly succeeded: " ++ show x makeBagTestSuccess :: Assertion makeBagTestSuccess = withTempFile $ \ filePath handle -> do let letters = ['A' .. ] let values = [1 .. 5] let distributions = [1 .. 5] let inputLines = unlines $ zipWith3 (\letter value distribution -> L.intersperse ' ' $ letter : (show value) ++ (show distribution)) letters values distributions hPutStrLn handle "_ 2" -- 2 Blank tiles hPutStr handle inputLines hFlush handle hClose handle letterBag <- makeBag filePath case letterBag of Left _ -> H.assertFailure "makeBag returned an error" Right (LetterBag tiles numTiles generator validLetters) -> do let expectedLetters = zipWith3 (\letter value distribution -> replicate distribution $ Letter letter value ) letters values distributions let expectedBlanks = replicate 2 $ Blank Nothing let expectedTiles = concat $ expectedBlanks : expectedLetters H.assertBool "Letter bag contains expected letters" $ expectedTiles `L.intersect` tiles == expectedTiles H.assertBool "Letter bag contains expected number of letters" $ (length expectedTiles) == (length tiles) makeBagInvalidPath :: Assertion makeBagInvalidPath = do letterBag <- makeBag "this is an invalid file path" case letterBag of Left (LetterBagFileNotOpenable _) -> return () _ -> H.assertFailure "Unexpected success" return ()