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/Data.hs | 31 +++++++++++++++++++++++++++++++
 1 file changed, 31 insertions(+)

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

diff --git a/users/grfn/xanthous/src/Xanthous/Data.hs b/users/grfn/xanthous/src/Xanthous/Data.hs
index 89d0993b4e59..ba6f98558ad8 100644
--- a/users/grfn/xanthous/src/Xanthous/Data.hs
+++ b/users/grfn/xanthous/src/Xanthous/Data.hs
@@ -6,6 +6,8 @@
 {-# LANGUAGE TemplateHaskell        #-}
 {-# LANGUAGE NoTypeSynonymInstances #-}
 {-# LANGUAGE DuplicateRecordFields  #-}
+{-# LANGUAGE QuantifiedConstraints  #-}
+{-# LANGUAGE UndecidableInstances   #-}
 --------------------------------------------------------------------------------
 -- | Common data types for Xanthous
 --------------------------------------------------------------------------------
@@ -117,6 +119,8 @@ import           Xanthous.Util (EqEqProp(..), EqProp, between)
 import           Xanthous.Util.QuickCheck (GenericArbitrary(..))
 import           Xanthous.Orphans ()
 import           Xanthous.Util.Graphics
+import Data.Random (Distribution)
+import Data.Coerce
 --------------------------------------------------------------------------------
 
 -- | opposite ∘ opposite ≡ id
@@ -495,6 +499,11 @@ newtype Per a b = Rate Double
   deriving (Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON)
        via Double
   deriving (Semigroup, Monoid) via Product Double
+deriving via Double
+  instance ( Distribution d Double
+           , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy)
+           )
+  => Distribution d (Per a b)
 
 invertRate :: a `Per` b -> b `Per` a
 invertRate (Rate p) = Rate $ 1 / p
@@ -529,6 +538,12 @@ newtype Square a = Square a
            )
        via a
 
+deriving via (a :: Type)
+  instance ( Distribution d a
+           , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy)
+           )
+  => Distribution d (Square a)
+
 newtype Cubic a = Cubic a
   deriving stock (Show, Eq, Generic)
   deriving anyclass (NFData, CoArbitrary, Function)
@@ -537,6 +552,12 @@ newtype Cubic a = Cubic a
            )
        via a
 
+deriving via (a :: Type)
+  instance ( Distribution d a
+           , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy)
+           )
+  => Distribution d (Cubic a)
+
 --------------------------------------------------------------------------------
 
 newtype Ticks = Ticks Word
@@ -546,6 +567,11 @@ newtype Ticks = Ticks Word
   deriving (Semigroup, Monoid) via (Sum Word)
   deriving Scalar via ScalarIntegral Ticks
   deriving Arbitrary via GenericArbitrary Ticks
+deriving via Word
+  instance ( Distribution d Word
+           , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy)
+           )
+  => Distribution d Ticks
 
 newtype Tiles = Tiles Double
   deriving stock (Show, Eq, Generic)
@@ -553,6 +579,11 @@ newtype Tiles = Tiles Double
   deriving (Num, Ord, Enum, Real, ToJSON, FromJSON, Scalar) via Double
   deriving (Semigroup, Monoid) via (Sum Double)
   deriving Arbitrary via GenericArbitrary Tiles
+deriving via Double
+  instance ( Distribution d Double
+           , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy)
+           )
+  => Distribution d Tiles
 
 type TicksPerTile = Ticks `Per` Tiles
 type TilesPerTick = Tiles `Per` Ticks
-- 
cgit 1.4.1