2 files changed, 36 insertions, 9 deletions
diff --git a/users/glittershark/xanthous/test/Spec.hs b/users/glittershark/xanthous/test/Spec.hs
index b7004b4f8948..f15c393ac917 100644
--- a/users/glittershark/xanthous/test/Spec.hs
+++ b/users/glittershark/xanthous/test/Spec.hs
@@ -1,11 +1,11 @@
 --------------------------------------------------------------------------------
 import           Test.Prelude
 --------------------------------------------------------------------------------
+import qualified Xanthous.Data.EntitiesSpec
 import qualified Xanthous.Data.EntityCharSpec
-import qualified Xanthous.Data.EntityMapSpec
 import qualified Xanthous.Data.EntityMap.GraphicsSpec
+import qualified Xanthous.Data.EntityMapSpec
 import qualified Xanthous.Data.LevelsSpec
-import qualified Xanthous.Data.EntitiesSpec
 import qualified Xanthous.Data.NestedMapSpec
 import qualified Xanthous.DataSpec
 import qualified Xanthous.Entities.RawsSpec
@@ -14,8 +14,9 @@ import qualified Xanthous.Generators.UtilSpec
 import qualified Xanthous.MessageSpec
 import qualified Xanthous.Messages.TemplateSpec
 import qualified Xanthous.OrphansSpec
-import qualified Xanthous.Util.GraphicsSpec
+import qualified Xanthous.RandomSpec
 import qualified Xanthous.Util.GraphSpec
+import qualified Xanthous.Util.GraphicsSpec
 import qualified Xanthous.Util.InflectionSpec
 import qualified Xanthous.UtilSpec
 --------------------------------------------------------------------------------
@@ -25,21 +26,22 @@ main = defaultMain test
 
 test :: TestTree
 test = testGroup "Xanthous"
-  [ Xanthous.Data.EntityCharSpec.test
-  , Xanthous.Data.EntityMapSpec.test
+  [ Xanthous.Data.EntitiesSpec.test
   , Xanthous.Data.EntityMap.GraphicsSpec.test
-  , Xanthous.Data.EntitiesSpec.test
+  , Xanthous.Data.EntityMapSpec.test
   , Xanthous.Data.LevelsSpec.test
   , Xanthous.Data.NestedMapSpec.test
+  , Xanthous.DataSpec.test
   , Xanthous.Entities.RawsSpec.test
   , Xanthous.GameSpec.test
   , Xanthous.Generators.UtilSpec.test
   , Xanthous.MessageSpec.test
   , Xanthous.Messages.TemplateSpec.test
   , Xanthous.OrphansSpec.test
-  , Xanthous.DataSpec.test
-  , Xanthous.UtilSpec.test
-  , Xanthous.Util.GraphicsSpec.test
+  , Xanthous.RandomSpec.test
   , Xanthous.Util.GraphSpec.test
+  , Xanthous.Util.GraphicsSpec.test
   , Xanthous.Util.InflectionSpec.test
+  , Xanthous.UtilSpec.test
+  , Xanthous.Data.EntityCharSpec.test
   ]
diff --git a/users/glittershark/xanthous/test/Xanthous/RandomSpec.hs b/users/glittershark/xanthous/test/Xanthous/RandomSpec.hs
new file mode 100644
index 000000000000..187336f08650
--- /dev/null
+++ b/users/glittershark/xanthous/test/Xanthous/RandomSpec.hs
@@ -0,0 +1,25 @@
+--------------------------------------------------------------------------------
+module Xanthous.RandomSpec (main, test) where
+--------------------------------------------------------------------------------
+import Test.Prelude
+--------------------------------------------------------------------------------
+import Control.Monad.Random
+--------------------------------------------------------------------------------
+import Xanthous.Random
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = defaultMain test
+
+test :: TestTree
+test = testGroup "Xanthous.Random"
+  [ testGroup "chooseSubset"
+    [ testProperty "chooses a subset"
+      $ \(l :: [Int]) (Positive (r :: Double)) -> randomTest $ do
+        ss <- chooseSubset r l
+        pure $ all (`elem` l) ss
+
+    ]
+  ]
+  where
+    randomTest prop = evalRandT prop . mkStdGen =<< arbitrary