1 files changed, 21 insertions, 1 deletions
diff --git a/users/grfn/xanthous/test/Xanthous/RandomSpec.hs b/users/grfn/xanthous/test/Xanthous/RandomSpec.hs
index 187336f08650..c88bd9562928 100644
--- a/users/grfn/xanthous/test/Xanthous/RandomSpec.hs
+++ b/users/grfn/xanthous/test/Xanthous/RandomSpec.hs
@@ -5,7 +5,10 @@ import Test.Prelude
 --------------------------------------------------------------------------------
 import Control.Monad.Random
 --------------------------------------------------------------------------------
-import Xanthous.Random
+import           Xanthous.Random
+import           Xanthous.Orphans ()
+import qualified Data.Interval as Interval
+import           Data.Interval (Interval, Extended (Finite), (<=..<=))
 --------------------------------------------------------------------------------
 
 main :: IO ()
@@ -18,6 +21,23 @@ test = testGroup "Xanthous.Random"
       $ \(l :: [Int]) (Positive (r :: Double)) -> randomTest $ do
         ss <- chooseSubset r l
         pure $ all (`elem` l) ss
+    ]
+  , testGroup "chooseRange"
+    [ testProperty "chooses in the range"
+      $ \(rng :: Interval Int) ->
+        not (Interval.null rng)
+        ==> randomTest ( do
+                chooseRange rng >>= \case
+                  Just r -> pure
+                           . counterexample (show r)
+                           $ r `Interval.member` rng
+                  Nothing -> pure $ property Discard
+            )
+    , testProperty "nonEmpty range is never empty"
+      $ \ (lower :: Int) (NonZero diff) -> randomTest $ do
+        let upper = lower + diff
+        r <- chooseRange (Finite lower <=..<= Finite upper)
+        pure $ isJust r
 
     ]
   ]