From 82ecd61f5c699cf3af6c4eadf47a1c52b1d696c6 Mon Sep 17 00:00:00 2001
From: Aspen Smith <grfn@gws.fyi>
Date: Sun, 11 Feb 2024 22:00:40 -0500
Subject: chore(users): grfn -> aspen

Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9
Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809
Autosubmit: aspen <root@gws.fyi>
Reviewed-by: sterni <sternenseemann@systemli.org>
Tested-by: BuildkiteCI
Reviewed-by: lukegb <lukegb@tvl.fyi>
---
 .../aspen/xanthous/src/Xanthous/Game/Arbitrary.hs  | 53 ++++++++++++++++++++++
 1 file changed, 53 insertions(+)
 create mode 100644 users/aspen/xanthous/src/Xanthous/Game/Arbitrary.hs

(limited to 'users/aspen/xanthous/src/Xanthous/Game/Arbitrary.hs')

diff --git a/users/aspen/xanthous/src/Xanthous/Game/Arbitrary.hs b/users/aspen/xanthous/src/Xanthous/Game/Arbitrary.hs
new file mode 100644
index 000000000000..679bfe54597f
--- /dev/null
+++ b/users/aspen/xanthous/src/Xanthous/Game/Arbitrary.hs
@@ -0,0 +1,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
-- 
cgit 1.4.1