freer-simple-random (empty) → 0.1.0.0

raw patch · 8 files changed

+273/−0 lines, 8 filesdep +basedep +containersdep +freer-simplesetup-changed

Dependencies added: base, containers, freer-simple, freer-simple-random, hspec, random

Files

ChangeLog.md +3/−0
LICENSE +21/−0
README.md +1/−0
Setup.hs +2/−0
freer-simple-random.cabal +59/−0
src/Control/Monad/Freer/Random.hs +124/−0
test/Control/Monad/Freer/RandomSpec.hs +62/−0
test/Spec.hs +1/−0

+ ChangeLog.md view

@@ -0,0 +1,3 @@+# Changelog for freer-simple-random++## Unreleased changes

+ LICENSE view

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018 Co—Star Astrology, Ben Weitzman++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ README.md view

@@ -0,0 +1,1 @@+# freer-simple-random

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ freer-simple-random.cabal view

@@ -0,0 +1,59 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: d04c208e5903df12659399a5efdc671f2a0c0bb3917cd0b6b625f002a4c8885f++name:           freer-simple-random+version:        0.1.0.0+synopsis:       Random number generators using freer-simple+description:    Please see the README on Gitlab at <https://gitlab.com/costar-astrology/freer-simple-contrib/tree/master/freer-simple-random>+category:       Control, Random+author:         Ben Weitzman+maintainer:     ben@costarastrology.com+copyright:      2018 Ben Weitzman+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://gitlab.com/costar-astrology/freer-simple-contrib/tree/master/freer-simple-random++library+  exposed-modules:+      Control.Monad.Freer.Random+  other-modules:+      Paths_freer_simple_random+  hs-source-dirs:+      src+  default-extensions: GADTs FlexibleContexts TypeOperators DataKinds StandaloneDeriving DeriveDataTypeable MultiParamTypeClasses FlexibleInstances UndecidableInstances TypeApplications ScopedTypeVariables TypeFamilies RankNTypes DeriveAnyClass OverloadedStrings FunctionalDependencies ConstraintKinds EmptyCase BangPatterns+  build-depends:+      base >=4.7 && <5+    , containers >=0.5 && <0.6+    , freer-simple >=1.1 && <1.2+    , random >=1.1 && <1.2+  default-language: Haskell2010++test-suite freer-simple-random-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Control.Monad.Freer.RandomSpec+      Paths_freer_simple_random+  hs-source-dirs:+      test+  default-extensions: GADTs FlexibleContexts TypeOperators DataKinds StandaloneDeriving DeriveDataTypeable MultiParamTypeClasses FlexibleInstances UndecidableInstances TypeApplications ScopedTypeVariables TypeFamilies RankNTypes DeriveAnyClass OverloadedStrings FunctionalDependencies ConstraintKinds EmptyCase BangPatterns+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , containers >=0.5 && <0.6+    , freer-simple >=1.1 && <1.2+    , freer-simple-random+    , hspec+    , random >=1.1 && <1.2+  default-language: Haskell2010

+ src/Control/Monad/Freer/Random.hs view

@@ -0,0 +1,124 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++{-|+Module      : Control.Monad.Freer.Random+Description : Effect for generating random values+Copyright   : (c) Ben Weitzman 2018+License     : MIT+Maintainer  : ben@costarastrolgoy.com+Stability   : experimental+Portability : POSIX+-}+module Control.Monad.Freer.Random+  (Random+  ,random+  ,randomR+  ,runRandom+  ,knownRandom+  ,runRandomWithSeed+  ,silentRandom+  ,FindInList+  )+where++import Control.Monad.Freer+import Control.Monad.Freer.Internal+import qualified System.Random as R+import Data.Typeable ((:~:)(..))+import Data.Maybe+import Data.Set (Set)+import qualified Data.Set as S++data Elem a as where+  Here :: Elem a (a ': as)+  There :: Elem a as -> Elem a (b ': as)++-- | Find a type inside of a type level list. Used to write code that generates multiple types of random values+-- that are polymorphic over the set of all random values that are generated.+--+-- @+-- getARandomNumber :: ('FindInList' 'Int' typs) => 'Eff' ('Random' typs ': r) 'Int'+-- getARandomNumber = random+--+-- getARandomBool :: ('FindInList' 'Bool' typs) => 'Eff' ('Random' typs ': r) 'Bool'+-- getARandomBool = random+--+-- getABoolAndInt :: ('FindInList' 'Bool' typs, 'FindInList' 'Int' typs) => 'Eff' ('Random' typs ': r) 'Int'+-- getABoolAndInt = do+--   rInt <- getARandomNumber+--   rBool <- getARandomBool+--   if rBool+--     then return rInt+--     else return $ rInt + 1+-- @+class FindInList a as where+  find :: Elem a as++instance {-# OVERLAPPING #-} FindInList a (a ': as) where+  find = Here++instance FindInList a as => FindInList a (b ': as) where+  find = There find++-- | The 'Random' effect generates a random value for you. It is parametrized by the set of values (@typs@)+-- that it generates. The 'Random' effect needs to come at the head of the effect list in order to make type+-- in order to make type inference of the set of types possible.+data Random typs a where+  Random :: (R.Random a) => Elem a typs -> Random typs a+  RandomR :: (R.Random a) => Elem a typs -> (a, a) -> Random typs a++-- | Generate a single random value+random :: forall a typs r p. (R.Random a, FindInList a typs) => Eff (Random typs ': r) a+random = send $ Random (find @a @typs)++-- | Generate a single random value in a range+randomR :: forall a typs r p. (R.Random a, FindInList a typs) =>  (a, a) -> Eff (Random typs ': r) a+randomR range = send $ RandomR (find @a @typs) range++-- | Use the 'IO' effect to handle generation of random values+runRandom :: forall t r a . Member IO r => Eff (Random t ': r) a -> Eff r a+runRandom = interpret $ \r -> case r of+  Random _ -> send R.randomIO+  RandomR _ range -> send $ R.randomRIO range++-- | Eliminate a 'Random' effect that doesn't generate any values+silentRandom :: Eff (Random '[] ': r) v -> Eff r v+silentRandom = interpret $ \r -> case r of ++-- | Use a single given value as the "random" value. The given value is always used, even if it's+-- outside the range given to 'randomR'  +knownRandom :: forall typ a r v . a -> Eff (Random (a ': typ) ': r) v -> Eff (Random typ ': r) v+knownRandom known = reinterpret $ \r -> case r of+  Random Here -> return known+  Random (There q) -> send $ Random q+  RandomR Here _ -> return known+  RandomR (There q) _ -> send $ Random q++-- | Use a seed + a PRNG to handle generation of random values. +runRandomWithSeed :: forall typ r v . Int -> Eff (Random typ ': r) v -> Eff r v+runRandomWithSeed seed = handleRelayS (R.mkStdGen seed) (\gen val -> return val) handler+  where+    handler :: R.StdGen -> Random typ a -> (R.StdGen -> a -> Eff r b) -> Eff r b+    handler gen (Random _) next =+      let r = R.random gen+      in next (snd r) (fst r)+    handler gen (RandomR _ range) next = +      let r = R.randomR range gen +      in next (snd r) (fst r)++-- | Pick a random value from a list+pickRandom :: (FindInList Int typ) => [a] -> Eff (Random typ ': r) (Maybe a)+pickRandom vals = do+  let max' = length vals+  idx <- randomR (0, max' - 1)+  return . listToMaybe $ drop idx vals++-- | Shuffle a set of values into a sequence+shuffle :: (FindInList Int typ) => Set a -> Eff (Random typ ': r) [a]+shuffle s+  | S.null s = return []+  | otherwise = do+      idx <- randomR (0, S.size s - 1)+      let val = S.elemAt idx s+      rest <- shuffle $ S.deleteAt idx s+      return $ val : rest

+ test/Control/Monad/Freer/RandomSpec.hs view

@@ -0,0 +1,62 @@+{-# 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

+ test/Spec.hs view

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}