tvl-depot/test/Xanthous/Data/EntityMapSpec.hs
Griffin Smith f37d0f75c0 Implement saving+loading the game
Implement ToJSON and FromJSON for all of the various pieces of the game
state, and add a pair of functions saveGame/loadGame implementing a
prism to save the game as zlib-compressed JSON. To test this, there's
now Arbitrary, CoArbitrary, and Function instances for all the parts of
the game state - to get around circular imports with the concrete
entities this unfortunately is happening via orphan instances, plus an
hs-boot file to break a circular import that was just a little too hard
to remove by moving things around. Ugh.
2019-11-29 14:33:52 -05:00

40 lines
1.5 KiB
Haskell

{-# LANGUAGE ApplicativeDo #-}
--------------------------------------------------------------------------------
module Xanthous.Data.EntityMapSpec where
--------------------------------------------------------------------------------
import Test.Prelude
--------------------------------------------------------------------------------
import qualified Data.Aeson as JSON
--------------------------------------------------------------------------------
import Xanthous.Data.EntityMap
--------------------------------------------------------------------------------
main :: IO ()
main = defaultMain test
test :: TestTree
test = localOption (QuickCheckTests 20)
$ testGroup "Xanthous.Data.EntityMap"
[ testBatch $ monoid @(EntityMap Int) mempty
, testGroup "Deduplicate"
[ testGroup "Semigroup laws"
[ testProperty "associative" $ \(a :: Deduplicate (EntityMap Int)) b c ->
a <> (b <> c) === (a <> b) <> c
]
]
, testGroup "Eq laws"
[ testProperty "reflexivity" $ \(em :: EntityMap Int) ->
em == em
, testProperty "symmetric" $ \(em :: EntityMap Int) em ->
(em == em) == (em == em)
, testProperty "transitive" $ \(em :: EntityMap Int) em em ->
if (em == em && em == em)
then (em == em)
else True
]
, testGroup "JSON encoding/decoding"
[ testProperty "Preserves IDs" $ \(em :: EntityMap Int) ->
let Just em' = JSON.decode $ JSON.encode em
in toEIDsAndPositioned em' === toEIDsAndPositioned em
]
]