-- This file is part of Goatee. -- -- Copyright 2014-2021 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.RoundTripTest (tests) where import Data.Function (on) import Game.Goatee.Common import Game.Goatee.Lib.Parser import Game.Goatee.Lib.Property import Game.Goatee.Lib.Renderer import Game.Goatee.Lib.Renderer.Tree import Game.Goatee.Lib.TestUtils import Game.Goatee.Lib.Tree import Game.Goatee.Lib.Types import Test.HUnit ((~:), (@?=), Assertion, Test (TestList), assertFailure) testCollection' :: Collection -> Assertion testCollection' collection = case runRender $ renderCollection collection of Left message -> assertFailure $ "Failed to render: " ++ message Right serialized -> case parseString serialized of Left error -> assertFailure $ "Failed to parse: " ++ error ++ "\n\nEntire SGF: " ++ serialized Right collection' -> do on (@?=) CollectionWithDeepEquality collection' collection case runRender $ renderCollection collection' of Left message -> assertFailure $ "Second render failed: " ++ message Right serializedAgain -> serializedAgain @?= serialized -- | Returns an assertion that the given node round-trips okay. testNode' :: Node -> Assertion testNode' = testCollection' . Collection . (:[]) -- | Returns a test with the given string name that round-trips a single node. testNode :: String -> Node -> Test testNode label node = label ~: testNode' node tests = "Game.Goatee.Lib.RoundTripTest" ~: TestList [ singleNodeGameTests , propertyValueTests ] singleNodeGameTests = "games with single nodes" ~: TestList [ testNode "empty game" $ node [] , testNode "some default properties" $ node [FF 4, GM 1, ST defaultVariationMode] ] propertyValueTests = "property value types" ~: TestList [ "color values" ~: TestList [ testNode "black" $ node [PL Black] , testNode "white" $ node [PL White] ] , "double values" ~: TestList [ testNode "1" $ node [DM Double1] , testNode "2" $ node [DM Double2] ] , "label list values" ~: TestList [ testNode "one value" $ node [LB [((5,2), toSimpleText "Hi.")]] , testNode "multiple value" $ node [LB [((5, 2), toSimpleText "Hi."), ((0, 1), toSimpleText "Bye.")]] ] , testNode "none value" $ node [KO] , "point-valued values" ~: TestList $ for [0..boardSizeMax-1] (\row -> testNode ("row " ++ show row) $ node [B $ Just (0, row)]) ++ for [0..boardSizeMax-1] (\col -> testNode ("row " ++ show col) $ node [B $ Just (col, 0)]) , "real values" ~: TestList [ testNode "0" $ node [TM $ read "0"] , testNode "0.0" $ node [TM $ read "0.0"] , testNode "1500" $ node [TM $ read "1500"] , testNode "150" $ node [TM $ read "150"] , testNode "15" $ node [TM $ read "15"] , testNode "1.5" $ node [TM $ read "1.5"] , testNode "0.15" $ node [TM $ read "0.15"] , testNode "0.015" $ node [TM $ read "0.015"] , testNode "0.0015" $ node [TM $ read "0.0015"] , testNode "60.5" $ node [TM $ read "60.5"] , testNode "10.1" $ node [TM $ read "10.1"] ] ] -- TODO Many more round-trip tests.