blob: 679bfe54597ff4885b08a63aafdb8e95bfb53fcb (
plain) (
blame)
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
|
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RecordWildCards #-}
--------------------------------------------------------------------------------
module Xanthous.Game.Arbitrary where
--------------------------------------------------------------------------------
import Xanthous.Prelude hiding (foldMap)
--------------------------------------------------------------------------------
import Test.QuickCheck
import System.Random
import Data.Foldable (foldMap)
--------------------------------------------------------------------------------
import Xanthous.Data.Levels
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Entities.Entities ()
import Xanthous.Entities.Character
import Xanthous.Game.State
import Xanthous.Orphans ()
import Xanthous.Util.QuickCheck (GenericArbitrary(..))
--------------------------------------------------------------------------------
deriving via GenericArbitrary GameLevel instance Arbitrary GameLevel
instance Arbitrary GameState where
arbitrary = do
chr <- arbitrary @Character
_upStaircasePosition <- arbitrary
_messageHistory <- arbitrary
levs <- arbitrary @(Levels GameLevel)
_levelRevealedPositions <-
fmap setFromList
. sublistOf
. foldMap (EntityMap.positions . _levelEntities)
$ levs
let (_characterEntityID, _levelEntities) =
EntityMap.insertAtReturningID _upStaircasePosition (SomeEntity chr)
$ levs ^. current . levelEntities
_levels = levs & current .~ GameLevel {..}
_randomGen <- mkStdGen <$> arbitrary
let _promptState = NoPrompt -- TODO
_activePanel <- arbitrary
_debugState <- arbitrary
let _autocommand = NoAutocommand
_memo <- arbitrary
_savefile <- arbitrary
pure $ GameState {..}
instance CoArbitrary GameLevel
instance Function GameLevel
instance CoArbitrary GameState
instance Function GameState
|
