-- This file is part of Goatee. -- -- Copyright 2014 Bryan Gardiner -- -- Goatee is free software: you can redistribute it and/or modify -- it under the terms of the GNU Affero General Public License as published by -- the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- -- Goatee is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU Affero General Public License for more details. -- -- You should have received a copy of the GNU Affero General Public License -- along with Goatee. If not, see . module Game.Goatee.Lib.TreeTest (tests) where import Data.Version (showVersion) import Game.Goatee.App (applicationName) import Game.Goatee.Common import Game.Goatee.Lib.Property import Game.Goatee.Lib.TestInstances () import Game.Goatee.Lib.TestUtils import Game.Goatee.Lib.Tree import Game.Goatee.Lib.Types import Game.Goatee.Test.Common import Paths_goatee (version) import Test.HUnit ((~:), (@=?), (@?=), Test (TestList)) tests = "Game.Goatee.Lib.Tree" ~: TestList [ emptyNodeTests , rootNodeTests , findPropertyTests , addPropertyTests , addChildTests , addChildAtTests , deleteChildAtTests ] emptyNodeTests = "emptyNode" ~: TestList [ "has no properties" ~: [] @=? nodeProperties emptyNode , "has no children" ~: [] @=? nodeChildren emptyNode ] rootNodeTests = "rootNode" ~: TestList [ "sets SZ correctly" ~: do assertElem (SZ 9 9) $ nodeProperties $ rootNode $ Just (9, 9) assertElem (SZ 19 19) $ nodeProperties $ rootNode $ Just (19, 19) assertElem (SZ 9 5) $ nodeProperties $ rootNode $ Just (9, 5) , "sets AP correctly" ~: do let ap = AP (toSimpleText applicationName) (toSimpleText $ showVersion version) assertElem ap $ nodeProperties $ rootNode Nothing assertElem ap $ nodeProperties $ rootNode $ Just (9, 9) ] findPropertyTests = "findProperty" ~: TestList [ "returns Nothing for an empty node" ~: Nothing @=? findProperty propertyB (mk []) , "returns Nothing if no properties match" ~: Nothing @=? findProperty propertyB (mk [FF 4, GM 1, ST defaultVariationMode, SZ 9 9]) , "finds present properties" ~: do Just (B (Just (2,3))) @=? findProperty propertyB (mk [B (Just (2,3))]) Just (W Nothing) @=? findProperty propertyW (mk [B Nothing, W Nothing]) Just IT @=? findProperty propertyIT (mk [IT, GW Double2]) Just (GW Double2) @=? findProperty propertyGW (mk [IT, GW Double2]) , "doesn't find absent properties" ~: do Nothing @=? findProperty propertyW (mk [B Nothing]) Nothing @=? findProperty propertyW (mk [FF 4, GM 1, ST defaultVariationMode, SZ 9 9]) ] where mk properties = emptyNode { nodeProperties = properties } addPropertyTests = "addProperty" ~: TestList [ "adds properties in order" ~: do let prop1 = B (Just (6,6)) prop2 = RE GameResultVoid prop3 = C (toText "Game over.") node1 = addProperty prop1 emptyNode node2 = addProperty prop2 node1 node3 = addProperty prop3 node2 node1 @?= emptyNode { nodeProperties = [prop1] } node2 @?= emptyNode { nodeProperties = [prop1, prop2] } node3 @?= emptyNode { nodeProperties = [prop1, prop2, prop3] } ] addChildTests = "addChild" ~: TestList [ "adds children in order" ~: do let node1 = emptyNode { nodeProperties = [B (Just (0,0))] } node2 = emptyNode { nodeProperties = [W (Just (1,1))] } node3 = emptyNode { nodeProperties = [B (Just (2,2))] } node4 = emptyNode { nodeProperties = [W Nothing] } node2' = addChild node3 node2 node1' = addChild node2' node1 node1'' = addChild node4 node1' node1'' @?= mk [B (Just (0,0))] [mk [W (Just (1,1))] [mk [B (Just (2,2))] []], mk [W Nothing] []] ] where mk properties children = emptyNode { nodeProperties = properties , nodeChildren = children } addChildAtTests = "addChildAt" ~: TestList [ "adds to a childless node" ~: let parent = node [B Nothing] child = node [W Nothing] in node1 [B Nothing] (node [W Nothing]) @=? addChildAt 0 child parent , "adds as a first child" ~: do let expected = base { nodeChildren = newNode : baseChildren } expected @=? addChildAt 0 newNode base expected @=? addChildAt (-1) newNode base expected @=? addChildAt (-2) newNode base , "adds as a middle child" ~: do base { nodeChildren = listInsertAt 1 newNode baseChildren } @=? addChildAt 1 newNode base base { nodeChildren = listInsertAt 2 newNode baseChildren } @=? addChildAt 2 newNode base , "adds as a last child" ~: do let expected = base { nodeChildren = baseChildren ++ [newNode] } expected @=? addChildAt baseChildCount newNode base expected @=? addChildAt (baseChildCount + 1) newNode base expected @=? addChildAt (baseChildCount + 2) newNode base ] where base = node' [B $ Just (0,0)] baseChildren baseChildren = [node [W Nothing], node [W $ Just (1,1)], node [W $ Just (9,9)]] baseChildCount = length $ nodeChildren base newNode = node [B $ Just (1,1)] deleteChildAtTests = "deleteChildAt" ~: TestList [ "deletes nothing from an empty list" ~: do emptyNode @=? deleteChildAt (-1) emptyNode emptyNode @=? deleteChildAt 0 emptyNode emptyNode @=? deleteChildAt 1 emptyNode , "deletes an only child" ~: node [B Nothing] @=? deleteChildAt 0 (node1 [B Nothing] $ node [W Nothing]) , "deletes a first child" ~: base { nodeChildren = listDeleteAt 0 baseChildren } @=? deleteChildAt 0 base , "deletes middle children" ~: do base { nodeChildren = listDeleteAt 1 baseChildren } @=? deleteChildAt 1 base base { nodeChildren = listDeleteAt 2 baseChildren } @=? deleteChildAt 2 base , "delete a last child" ~: base { nodeChildren = init baseChildren } @=? deleteChildAt (baseChildCount - 1) base , "has no effect for invalid indices" ~: do base @=? deleteChildAt (-1) base base @=? deleteChildAt (-2) base base @=? deleteChildAt baseChildCount base base @=? deleteChildAt (baseChildCount + 1) base base @=? deleteChildAt (baseChildCount + 2) base ] where base = node' [B $ Just (0,0)] baseChildren baseChildren = [node [W Nothing], node [W $ Just (1,1)], node [W $ Just (2,2)], node [W $ Just (9,9)]] baseChildCount = length $ nodeChildren base -- TODO Test validateNode.