RandomSpec.hs

{-# LANGUAGE AllowAmbiguousTypes #-}

module Control.Monad.Freer.RandomSpec where
 
import Control.Monad.Freer.Random

import Control.Monad.Freer
import Test.Hspec
import qualified System.Random as R

spec :: Spec
spec = do
  describe "random" $ do
    
    it "should return a random number" $ do         
      (a :: Int, b) <- runM $ runRandom @'[Int] getTwoRandoms
      a `shouldNotBe` b

  describe "known random" $ do
    
    it "should give known random" $ do
      let (a :: Int, b) = run . silentRandom . knownRandom knownInt $ getTwoRandoms 
      a `shouldBe` b
      a `shouldBe` knownInt
      
    it "should not affect other randoms" $ do
      (a :: Int, b :: Int, c :: Double, d :: Double) <- runM . runRandom @'[Double] . knownRandom  knownInt $ do
        (a, b) <- getTwoRandoms
        (c, d) <- getTwoRandoms
        return (a, b, c, d)
      a `shouldBe` knownInt
      b `shouldBe` knownInt 
      c `shouldNotBe` d 
 
    it "can provide two known randoms" $ do
      let (a, b, c, d) = run . silentRandom . knownRandom knownInt . knownRandom knownDouble $ do
            (a, b) <- getTwoRandoms
            (c, d) <- getTwoRandoms
            return (a, b, c, d)
      a `shouldBe` knownInt
      b `shouldBe` knownInt
      c `shouldBe` knownDouble
      d `shouldBe` knownDouble

  describe "random with seed" $ do
    it "should be reproducible" $ do
      let (a :: Int, b) = run $ runRandomWithSeed @'[Int] 0 getTwoRandoms
      let (c, d) = run $ runRandomWithSeed @'[Int] 0 getTwoRandoms
      a `shouldNotBe` b
      c `shouldNotBe` d
      a `shouldBe` c
      b `shouldBe` d
      
        
getTwoRandoms :: forall a rs effs . (R.Random a, FindInList a rs) => Eff (Random rs ': effs) (a, a) 
getTwoRandoms = (,) <$> random <*> random

knownInt :: Int
knownInt = 3

knownDouble :: Double
knownDouble = pi