1 files changed, 18 insertions, 5 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs b/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs
index f23cf25b4392..98dd4dd83331 100644
--- a/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs
+++ b/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs
@@ -11,6 +11,7 @@ module Xanthous.Entities.Creature
 
     -- ** Creature functions
   , newWithType
+  , newOnLevelWithType
   , damage
   , isDead
   , visionRadius
@@ -30,7 +31,6 @@ module Xanthous.Entities.Creature
 import           Xanthous.Prelude
 --------------------------------------------------------------------------------
 import           Test.QuickCheck
-import           Test.QuickCheck.Arbitrary.Generic
 import           Data.Aeson.Generic.DerivingVia
 import           Data.Aeson (ToJSON, FromJSON)
 import           Control.Monad.Random (MonadRandom)
@@ -43,20 +43,21 @@ import           Xanthous.Game.State
 import           Xanthous.Data
 import           Xanthous.Data.Entities
 import           Xanthous.Entities.Creature.Hippocampus
+import           Xanthous.Util.QuickCheck (GenericArbitrary(..))
 --------------------------------------------------------------------------------
 
 data Creature = Creature
-  { _creatureType :: !CreatureType
-  , _hitpoints    :: !Hitpoints
-  , _hippocampus  :: !Hippocampus
+  { _creatureType   :: !CreatureType
+  , _hitpoints      :: !Hitpoints
+  , _hippocampus    :: !Hippocampus
   }
   deriving stock (Eq, Show, Ord, Generic)
   deriving anyclass (NFData, CoArbitrary, Function)
   deriving Draw via DrawRawCharPriority "_creatureType" 1000 Creature
+  deriving Arbitrary via GenericArbitrary Creature
   deriving (ToJSON, FromJSON)
        via WithOptions '[ FieldLabelModifier '[Drop 1] ]
                        Creature
-instance Arbitrary Creature where arbitrary = genericArbitrary
 makeLenses ''Creature
 
 instance HasVisionRadius Creature where
@@ -75,6 +76,18 @@ instance Entity Creature where
 
 --------------------------------------------------------------------------------
 
+newOnLevelWithType
+  :: MonadRandom m
+  => Word -- ^ Level number, starting at 0
+  -> CreatureType
+  -> m (Maybe Creature)
+newOnLevelWithType levelNumber cType
+  | maybe True (canGenerate levelNumber) $ cType ^. generateParams
+  = Just <$> newWithType cType
+  | otherwise
+  = pure Nothing
+
+
 newWithType :: MonadRandom m => CreatureType -> m Creature
 newWithType _creatureType =
   let _hitpoints = _creatureType ^. maxHitpoints