From d8bd8e7eea5dcef4901bee14b8fe3027fd8605ac Mon Sep 17 00:00:00 2001
From: Griffin Smith <grfn@gws.fyi>
Date: Sat, 19 Jun 2021 11:49:20 -0400
Subject: feat(xanthous) Generate random volume+density for items

Generate random volumes and densities for items based on the ranges for
those two quantities in the raw when building instances of items.

Since this is the first time creating an item is impure, this also lifts
entity generation into a (random) monadic context

Change-Id: I2de4880e8144f7ff9e1304eb32806ed1d7affa18
Reviewed-on: https://cl.tvl.fyi/c/depot/+/3226
Reviewed-by: grfn <grfn@gws.fyi>
Tested-by: BuildkiteCI
---
 users/grfn/xanthous/src/Xanthous/Random.hs | 34 ++++++++++++++++++++++++++++--
 1 file changed, 32 insertions(+), 2 deletions(-)

(limited to 'users/grfn/xanthous/src/Xanthous/Random.hs')

diff --git a/users/grfn/xanthous/src/Xanthous/Random.hs b/users/grfn/xanthous/src/Xanthous/Random.hs
index 72bdb63d2c..329b321b8b 100644
--- a/users/grfn/xanthous/src/Xanthous/Random.hs
+++ b/users/grfn/xanthous/src/Xanthous/Random.hs
@@ -13,6 +13,7 @@ module Xanthous.Random
   , chance
   , chooseSubset
   , chooseRange
+  , FiniteInterval(..)
   ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude
@@ -28,7 +29,7 @@ import           Data.Random.Distribution.Uniform.Exclusive
 import           Data.Random.Sample
 import qualified Data.Random.Source as DRS
 import           Data.Interval ( Interval, lowerBound', Extended (Finite)
-                               , upperBound', Boundary (Closed)
+                               , upperBound', Boundary (Closed), lowerBound, upperBound
                                )
 --------------------------------------------------------------------------------
 
@@ -128,7 +129,9 @@ chooseRange
   :: ( MonadRandom m
     , Distribution Uniform n
     , Enum n
-    , Bounded n, Show n, Ord n)
+    , Bounded n
+    , Ord n
+    )
   => Interval n
   -> m (Maybe n)
 chooseRange int = traverse sample distribution
@@ -149,6 +152,33 @@ chooseRange int = traverse sample distribution
       | lowerR <= upperR = Just $ Uniform lowerR upperR
       | otherwise = Nothing
 
+instance ( Distribution Uniform n
+         , Enum n
+         , Bounded n
+         , Ord n
+         )
+         => Choose (Interval n) where
+  type RandomResult (Interval n) = n
+  choose = fmap (fromMaybe $ error "Invalid interval") . chooseRange
+
+newtype FiniteInterval a
+  = FiniteInterval { unwrapFiniteInterval :: (Interval a) }
+
+instance ( Distribution Uniform n
+         , Ord n
+         )
+         => Choose (FiniteInterval n) where
+  type RandomResult (FiniteInterval n) = n
+  -- TODO broken with open/closed right now
+  choose
+    = sample
+    . uncurry Uniform
+    . over both getFinite
+    . (lowerBound &&& upperBound)
+    . unwrapFiniteInterval
+    where
+      getFinite (Finite x) = x
+      getFinite _ = error "Infinite value"
 
 --------------------------------------------------------------------------------
 
-- 
cgit 1.4.1