MonadRandom-0.5.1/0000755000000000000000000000000013047245021012100 5ustar0000000000000000MonadRandom-0.5.1/Setup.hs0000644000000000000000000000005613047245021013535 0ustar0000000000000000import Distribution.Simple main = defaultMain MonadRandom-0.5.1/LICENSE0000644000000000000000000000320113047245021013101 0ustar0000000000000000Copyright (c) 2016, Brent Yorgey All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Brent Yorgey nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Previous versions of this package were distributed under the simple permissive license used on the Haskell Wiki; see OLD-LICENSE for details. MonadRandom-0.5.1/MonadRandom.cabal0000644000000000000000000000241113047245021015261 0ustar0000000000000000name: MonadRandom version: 0.5.1 synopsis: Random-number generation monad. description: Support for computations which consume random values. license: BSD3 license-file: LICENSE author: Cale Gibbard and others maintainer: Brent Yorgey bug-reports: https://github.com/byorgey/MonadRandom/issues category: Control build-type: Simple cabal-version: >=1.10 extra-source-files: CHANGES.markdown tested-with: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.1 source-repository head type: git location: git://github.com/byorgey/MonadRandom.git library exposed-modules: Control.Monad.Random, Control.Monad.Random.Class, Control.Monad.Random.Lazy, Control.Monad.Random.Strict, Control.Monad.Trans.Random, Control.Monad.Trans.Random.Lazy, Control.Monad.Trans.Random.Strict build-depends: base >=2 && <5, transformers >=0.3 && <0.6, transformers-compat >=0.4 && <0.6, mtl >=2.1 && <2.3, primitive >=0.6 && <0.7, fail >=4.9 , random ghc-options: -Wall default-language: Haskell2010 MonadRandom-0.5.1/CHANGES.markdown0000644000000000000000000001301313047245021014712 0ustar00000000000000000.5.1 (9 February 2017) ----------------------- Re-export `System.Random` from `Control.Monad.Random.{Lazy,Strict}` and hence also from `Control.Monad.Random`. 0.5 (3 January 2017) -------------------- This release has quite a few small additions as well as a big module reorganization. However, thanks to module re-exports, most existing code using the library should continue to work with no changes; the major version bump reflects the large reorganization and my inability to 100% guarantee that existing user code will not break. The biggest changes that may be of interest to users of the library include new lazy vs strict variants of the `Rand` monad; a new `MonadInterleave` class which is a big improvement over `MonadSplit`; new `PrimMonad` instances; and new random selection functions like `weighted`, `weightedMay`, `uniformMay`, *etc.*. See the list below for full details. Although there was some discussion of generalizing `MonadRandom` to work for a wider range of underlying generators (see [#26](https://github.com/byorgey/MonadRandom/issues/26), [#31](https://github.com/byorgey/MonadRandom/issues/31), and [comments on this blog post](https://byorgey.wordpress.com/2016/11/16/monadrandom-0-5-and-mwc-random-feedback-wanted/)), I decided to punt on that for now. It seems rather complicated and there are [already good alternatives](http://hackage.haskell.org/package/random%2Dfu) so I decided to keep things simple for this release. I'm still open to proposals for generalizing future releases. Changes in 0.5 include: - Refactor to reflect structure of `mtl` and `transformers` libraries. - Add lazy and strict variants of `RandT`. - Add `MonadRandom` and `MonadSplit` instances for `ListT`. - Add (but do not export) `unRandT` field to `RandT`. - Add `MonadCont`, `MonadError`, `MonadRWS`, `PrimMonad`, and `MonadFail` instances for `RandT`. - Add `evalRandTIO` operation. - Move `fromList` and `uniform` operations to `Control.Monad.Random.Class`. - `fromList` now raises an error when the total weight of elements is zero. - Generalize the type of `uniform` to work over any `Foldable`. - Add new operations `weighted`, `weightedMay`, `fromListMay`, and `uniformMay`. `weighted` is like `fromList` but generalized to work over any `Foldable`. The `May` variants return a `Maybe` result instead of raising an error. - New `MonadInterleave` class for random monads which can interleave random generation using `split`. In some ways this is similar to `MonadSplit` but much more useful. - Improved documentation. 0.4.2.3 (21 April 2016) ----------------------- - Mark `Control.Monad.Random` as `Trustworthy`. 0.4.2.2 (18 January 2016) ------------------------- - Allow `transformers-0.5`. 0.4.2.1 (16 January 2016) ------------------------- - Allow `transformers-compat-0.5`. 0.4.2 (16 January 2016) ----------------------- - Add `MonadPlus` and `Alternative` instances for `RandT`. 0.4.1 (20 November 2015) ------------------------ - Remove unnecessary `Monad m` constraint from `liftRandT` and `runRandT`. This should again technically require a major version bump, but I'm not doing it this time in the interest of not being super annoying. If this breaks something for you, just yell, and I will deprecate this version and do a proper 0.5 release. 0.4 (12 May 2015) ----------------- - Remove unnecessary `RandomGen g` constraints from `liftRandT`, `liftRand`, `evalRandT`, `evalRand`, `runRandT`, `runRand`. A major version bump is required by the PVP since the types of all the above methods have changed, but this release is again very unlikely to break any client code. 0.3.0.2 (30 March 2015) ----------------------- - Add `transformers-compat` to allow building with newer `mtl` 0.3.0.1 (24 November 2014) -------------------------- - Improve documentation: ranges are exclusive at the upper bound 0.3 (4 September 2014) ---------------------- - Eta-reduce definition of `Rand` - Remove unnecessary `Random a` constraint from types of `liftRand` and `liftRandT`. Note that a major version bump is required by the PVP since the types of `liftRand` and `liftRandT` have changed, but this release is highly unlikely to break any client code. 0.2.0.1 (24 August 2014) ------------------------ - Allow building with both `transformers-0.3` and `0.4`. 0.2 (20 August 2014) -------------------- - change `Rand` from a `newtype` to a type synonym - `MonadRandom` and `MonadSplit` instances for - `ExceptT` - strict variants of `StateT` and `WriterT` - both lazy and strict variants of `RWST` - remove unneeded `RandomGen` constraint from `MonadState RandT` instance 0.1.13 (9 February 2014) ------------------------ - add simple `uniform` function for creating a uniform distribution over a list of values 0.1.12 (30 September 2013) -------------------------- - add `liftRandT` and `liftRand` functions, for lifting explicit generator-passing functions into `RandT` and `Rand`, respectively. 0.1.11 (1 August 2013) ---------------------- - add `MonadRandom` and `MonadSplit` instances for `IdentityT` - derive `MonadReader` and `MonadWriter` instances instead of declaring them explicitly (thanks again to James Koppel) 0.1.10 (16 July 2013) --------------------- - add `MonadRandom` and `MonadSplit` instances for `ContT` (thanks to James Koppel for the patch) 0.1.9 (26 April 2013) --------------------- - add `MonadRandom` and `MonadSplit` instances for `MaybeT` MonadRandom-0.5.1/Control/0000755000000000000000000000000013047245021013520 5ustar0000000000000000MonadRandom-0.5.1/Control/Monad/0000755000000000000000000000000013047245021014556 5ustar0000000000000000MonadRandom-0.5.1/Control/Monad/Random.hs0000644000000000000000000000102613047245021016331 0ustar0000000000000000{-# LANGUAGE Safe #-} {- | Module : Control.Monad.Random Copyright : (c) Brent Yorgey 2016 License : BSD3 (see LICENSE) Maintainer : byorgey@gmail.com Stability : experimental Portability : non-portable (multi-param classes, functional dependencies, undecidable instances) This module is provided for backwards compatibility, and simply re-exports "Control.Monad.Random.Lazy". -} module Control.Monad.Random ( module Control.Monad.Random.Lazy, ) where import Control.Monad.Random.Lazy MonadRandom-0.5.1/Control/Monad/Trans/0000755000000000000000000000000013047245021015645 5ustar0000000000000000MonadRandom-0.5.1/Control/Monad/Trans/Random.hs0000644000000000000000000000120213047245021017414 0ustar0000000000000000{-# LANGUAGE Safe #-} {- | Module : Control.Monad.Trans.Random Copyright : (c) Brent Yorgey 2016 License : BSD3 (see LICENSE) Maintainer : byorgey@gmail.com Stability : experimental Portability : non-portable (multi-param classes, functional dependencies, undecidable instances) Random monads, passing a random number generator through a computation. This version is lazy; for a strict version, see "Control.Monad.Trans.Random.Strict", which has the same interface. -} module Control.Monad.Trans.Random ( module Control.Monad.Trans.Random.Lazy, ) where import Control.Monad.Trans.Random.Lazy MonadRandom-0.5.1/Control/Monad/Trans/Random/0000755000000000000000000000000013047245021017065 5ustar0000000000000000MonadRandom-0.5.1/Control/Monad/Trans/Random/Lazy.hs0000644000000000000000000002246213047245021020346 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {- | Module : Control.Monad.Trans.Random.Lazy Copyright : (c) Brent Yorgey 2016 License : BSD3 (see LICENSE) Maintainer : byorgey@gmail.com Stability : experimental Portability : non-portable (multi-param classes, functional dependencies, undecidable instances) Lazy random monads, passing a random number generator through a computation. See below for examples. For a strict version with the same interface, see "Control.Monad.Trans.Random.Strict". -} module Control.Monad.Trans.Random.Lazy ( -- * The Rand monad transformer Rand, liftRand, runRand, evalRand, execRand, mapRand, withRand, evalRandIO, -- * The RandT monad transformer RandT, liftRandT, runRandT, evalRandT, execRandT, mapRandT, withRandT, -- * Lifting other operations liftCallCC, liftCallCC', liftCatch, liftListen, liftPass, evalRandTIO, -- * Examples -- ** Random monads -- $examples ) where import Control.Applicative import Control.Arrow (first) import Control.Monad import Control.Monad.Cont.Class import Control.Monad.Error.Class import qualified Control.Monad.Fail as Fail import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.Primitive import Control.Monad.Random.Class import Control.Monad.RWS.Class import Control.Monad.Signatures import Control.Monad.Trans.Class import qualified Control.Monad.Trans.State.Lazy as LazyState import Data.Functor.Identity import System.Random -- | A random monad parameterized by the type @g@ of the generator to carry. -- -- The 'return' function leaves the generator unchanged, while '>>=' uses the -- final generator of the first computation as the initial generator of the -- second. type Rand g = RandT g Identity -- | Construct a random monad computation from a function. -- (The inverse of 'runRand'.) liftRand :: (g -> (a, g)) -- ^ pure random transformer -> Rand g a -- ^ equivalent generator-passing computation liftRand = RandT . state -- | Unwrap a random monad computation as a function. -- (The inverse of 'liftRand'.) runRand :: Rand g a -- ^ generator-passing computation to execute -> g -- ^ initial generator -> (a, g) -- ^ return value and final generator runRand t = runIdentity . runRandT t -- | Evaluate a random computation with the given initial generator and return -- the final value, discarding the final generator. -- -- * @'evalRand' m s = fst ('runRand' m s)@ evalRand :: Rand g a -- ^ generator-passing computation to execute -> g -- ^ initial generator -> a -- ^ return value of the random computation evalRand t = runIdentity . evalRandT t -- | Evaluate a random computation with the given initial generator and return -- the final generator, discarding the final value. -- -- * @'execRand' m s = snd ('runRand' m s)@ execRand :: Rand g a -- ^ generator-passing computation to execute -> g -- ^ initial generator -> g -- ^ final generator execRand t = runIdentity . execRandT t -- | Map both the return value and final generator of a computation using the -- given function. -- -- * @'runRand' ('mapRand' f m) = f . 'runRand' m@ mapRand :: ((a, g) -> (b, g)) -> Rand g a -> Rand g b mapRand f = mapRandT (liftM f) -- | @'withRand' f m@ executes action @m@ on a generator modified by applying @f@. -- -- * @'withRand' f m = 'modify' f >> m@ withRand :: (g -> g) -> Rand g a -> Rand g a withRand = withRandT -- | A random transformer monad parameterized by: -- -- * @g@ - The generator. -- -- * @m@ - The inner monad. -- -- The 'return' function leaves the generator unchanged, while '>>=' uses the -- final generator of the first computation as the initial generator of the -- second. newtype RandT g m a = RandT { unRandT :: LazyState.StateT g m a } deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadTrans, MonadIO, MonadFix, MonadReader r, MonadWriter w) -- | Construct a random monad computation from an impure function. -- (The inverse of 'runRandT'.) liftRandT :: (g -> m (a, g)) -- ^ impure random transformer -> RandT g m a -- ^ equivalent generator-passing computation liftRandT = RandT . LazyState.StateT -- | Unwrap a random monad computation as an impure function. -- (The inverse of 'liftRandT'.) runRandT :: RandT g m a -- ^ generator-passing computation to execute -> g -- ^ initial generator -> m (a, g) -- ^ return value and final generator runRandT = LazyState.runStateT . unRandT -- | Evaluate a random computation with the given initial generator and return -- the final value, discarding the final generator. -- -- * @'evalRandT' m g = liftM fst ('runRandT' m g)@ evalRandT :: (Monad m) => RandT g m a -> g -> m a evalRandT = LazyState.evalStateT . unRandT -- | Evaluate a random computation with the given initial generator and return -- the final generator, discarding the final value. -- -- * @'execRandT' m g = liftM snd ('runRandT' m g)@ execRandT :: (Monad m) => RandT g m a -> g -> m g execRandT = LazyState.execStateT . unRandT -- | Map both the return value and final generator of a computation using the -- given function. -- -- * @'runRandT' ('mapRandT' f m) = f . 'runRandT' m@ mapRandT :: (m (a, g) -> n (b, g)) -> RandT g m a -> RandT g n b mapRandT f = RandT . LazyState.mapStateT f . unRandT -- | @'withRandT' f m@ executes action @m@ on a generator modified by applying @f@. -- -- * @'withRandT' f m = 'modify' f >> m@ withRandT :: (g -> g) -> RandT g m a -> RandT g m a withRandT f = RandT . LazyState.withStateT f . unRandT instance (MonadCont m) => MonadCont (RandT g m) where callCC = liftCallCC' callCC instance (MonadError e m) => MonadError e (RandT g m) where throwError = lift . throwError catchError = liftCatch catchError instance (MonadReader r m, MonadWriter w m, MonadState s m) => MonadRWS r w s (RandT g m) instance (RandomGen g, Monad m) => MonadRandom (RandT g m) where getRandomR lohi = RandT . state $ randomR lohi getRandom = RandT . state $ random getRandomRs lohi = RandT . state $ first (randomRs lohi) . split getRandoms = RandT . state $ first randoms . split instance (RandomGen g, Monad m) => MonadSplit g (RandT g m) where getSplit = RandT . state $ split instance (Monad m, RandomGen g) => MonadInterleave (RandT g m) where interleave (RandT m) = liftRandT $ \g -> case split g of (gl, gr) -> liftM (\p -> (fst p, gr)) $ LazyState.runStateT m gl instance (MonadState s m) => MonadState s (RandT g m) where get = lift get put = lift . put instance PrimMonad m => PrimMonad (RandT s m) where type PrimState (RandT s m) = PrimState m primitive = lift . primitive instance Fail.MonadFail m => Fail.MonadFail (RandT g m) where fail = lift . Fail.fail -- | Uniform lifting of a @callCC@ operation to the new monad. -- This version rolls back to the original state on entering the -- continuation. liftCallCC :: CallCC m (a, g) (b, g) -> CallCC (RandT g m) a b liftCallCC callCC_ f = RandT $ LazyState.liftCallCC callCC_ $ \c -> unRandT (f (RandT . c)) -- | In-situ lifting of a @callCC@ operation to the new monad. -- This version uses the current state on entering the continuation. -- It does not satisfy the uniformity property (see "Control.Monad.Signatures"). liftCallCC' :: CallCC m (a, g) (b, g) -> CallCC (RandT g m) a b liftCallCC' callCC_ f = RandT $ LazyState.liftCallCC' callCC_ $ \c -> unRandT (f (RandT . c)) -- | Lift a @catchE@ operation to the new monad. liftCatch :: Catch e m (a, g) -> Catch e (RandT g m) a liftCatch catchE_ m f = RandT $ LazyState.liftCatch catchE_ (unRandT m) (unRandT . f) -- | Lift a @listen@ operation to the new monad. liftListen :: (Monad m) => Listen w m (a, g) -> Listen w (RandT g m) a liftListen listen_ m = RandT $ LazyState.liftListen listen_ (unRandT m) -- | Lift a @pass@ operation to the new monad. liftPass :: (Monad m) => Pass w m (a, g) -> Pass w (RandT g m) a liftPass pass_ m = RandT $ LazyState.liftPass pass_ (unRandT m) -- | Evaluate a random computation in the `IO` monad, splitting the global -- standard generator to get a new one for the computation. evalRandIO :: Rand StdGen a -> IO a evalRandIO t = liftM (evalRand t) newStdGen -- | Evaluate a random computation that is embedded in the `IO` monad, -- splitting the global standard generator to get a new one for the -- computation. evalRandTIO :: (MonadIO m) => RandT StdGen m a -> m a evalRandTIO t = liftIO newStdGen >>= evalRandT t {- $examples The @die@ function simulates the roll of a die, picking a number between 1 and 6, inclusive, and returning it in the 'Rand' monad transformer. Notice that this code will work with any random number generator @g@. > die :: (RandomGen g) => Rand g Int > die = getRandomR (1, 6) The @dice@ function uses @replicate@ and @sequence@ to simulate the roll of @n@ dice. > dice :: (RandomGen g) => Int -> Rand g [Int] > dice n = sequence (replicate n die) To extract a value from the 'Rand' monad transformer, we can use 'evalRandIO'. > main = do > values <- evalRandIO (dice 2) > putStrLn (show values) -} MonadRandom-0.5.1/Control/Monad/Trans/Random/Strict.hs0000644000000000000000000002274513047245021020703 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {- | Module : Control.Monad.Trans.Random.Strict Copyright : (c) Brent Yorgey 2016 License : BSD3 (see LICENSE) Maintainer : byorgey@gmail.com Stability : experimental Portability : non-portable (multi-param classes, functional dependencies, undecidable instances) Strict random monads, passing a random number generator through a computation. See below for examples. In this version, sequencing of computations is strict (but computations are not strict in the state unless you force it with seq or the like). For a lazy version with the same interface, see "Control.Monad.Trans.Random.Lazy". -} module Control.Monad.Trans.Random.Strict ( -- * The Rand monad transformer Rand, liftRand, runRand, evalRand, execRand, mapRand, withRand, evalRandIO, -- * The RandT monad transformer RandT, liftRandT, runRandT, evalRandT, execRandT, mapRandT, withRandT, evalRandTIO, -- * Lifting other operations liftCallCC, liftCallCC', liftCatch, liftListen, liftPass, -- * Examples -- ** Random monads -- $examples ) where import Control.Applicative import Control.Arrow (first) import Control.Monad import Control.Monad.Cont.Class import Control.Monad.Error.Class import qualified Control.Monad.Fail as Fail import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.Primitive import Control.Monad.Random.Class import Control.Monad.RWS.Class import Control.Monad.Signatures import Control.Monad.Trans.Class import qualified Control.Monad.Trans.State.Strict as StrictState import Data.Functor.Identity import System.Random -- | A random monad parameterized by the type @g@ of the generator to carry. -- -- The 'return' function leaves the generator unchanged, while '>>=' uses the -- final generator of the first computation as the initial generator of the -- second. type Rand g = RandT g Identity -- | Construct a random monad computation from a function. -- (The inverse of 'runRand'.) liftRand :: (g -> (a, g)) -- ^ pure random transformer -> Rand g a -- ^ equivalent generator-passing computation liftRand = RandT . state -- | Unwrap a random monad computation as a function. -- (The inverse of 'liftRand'.) runRand :: Rand g a -- ^ generator-passing computation to execute -> g -- ^ initial generator -> (a, g) -- ^ return value and final generator runRand t = runIdentity . runRandT t -- | Evaluate a random computation with the given initial generator and return -- the final value, discarding the final generator. -- -- * @'evalRand' m s = fst ('runRand' m s)@ evalRand :: Rand g a -- ^ generator-passing computation to execute -> g -- ^ initial generator -> a -- ^ return value of the random computation evalRand t = runIdentity . evalRandT t -- | Evaluate a random computation with the given initial generator and return -- the final generator, discarding the final value. -- -- * @'execRand' m s = snd ('runRand' m s)@ execRand :: Rand g a -- ^ generator-passing computation to execute -> g -- ^ initial generator -> g -- ^ final generator execRand t = runIdentity . execRandT t -- | Map both the return value and final generator of a computation using the -- given function. -- -- * @'runRand' ('mapRand' f m) = f . 'runRand' m@ mapRand :: ((a, g) -> (b, g)) -> Rand g a -> Rand g b mapRand f = mapRandT (liftM f) -- | @'withRand' f m@ executes action @m@ on a generator modified by applying @f@. -- -- * @'withRand' f m = 'modify' f >> m@ withRand :: (g -> g) -> Rand g a -> Rand g a withRand = withRandT -- | A random transformer monad parameterized by: -- -- * @g@ - The generator. -- -- * @m@ - The inner monad. -- -- The 'return' function leaves the generator unchanged, while '>>=' uses the -- final generator of the first computation as the initial generator of the -- second. newtype RandT g m a = RandT { unRandT :: StrictState.StateT g m a } deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadTrans, MonadIO, MonadFix, MonadReader r, MonadWriter w) -- | Construct a random monad computation from an impure function. -- (The inverse of 'runRandT'.) liftRandT :: (g -> m (a, g)) -- ^ impure random transformer -> RandT g m a -- ^ equivalent generator-passing computation liftRandT = RandT . StrictState.StateT -- | Unwrap a random monad computation as an impure function. -- (The inverse of 'liftRandT'.) runRandT :: RandT g m a -- ^ generator-passing computation to execute -> g -- ^ initial generator -> m (a, g) -- ^ return value and final generator runRandT = StrictState.runStateT . unRandT -- | Evaluate a random computation with the given initial generator and return -- the final value, discarding the final generator. -- -- * @'evalRandT' m g = liftM fst ('runRandT' m g)@ evalRandT :: (Monad m) => RandT g m a -> g -> m a evalRandT = StrictState.evalStateT . unRandT -- | Evaluate a random computation with the given initial generator and return -- the final generator, discarding the final value. -- -- * @'execRandT' m g = liftM snd ('runRandT' m g)@ execRandT :: (Monad m) => RandT g m a -> g -> m g execRandT = StrictState.execStateT . unRandT -- | Map both the return value and final generator of a computation using the -- given function. -- -- * @'runRandT' ('mapRandT' f m) = f . 'runRandT' m@ mapRandT :: (m (a, g) -> n (b, g)) -> RandT g m a -> RandT g n b mapRandT f = RandT . StrictState.mapStateT f . unRandT -- | @'withRandT' f m@ executes action @m@ on a generator modified by applying @f@. -- -- * @'withRandT' f m = 'modify' f >> m@ withRandT :: (g -> g) -> RandT g m a -> RandT g m a withRandT f = RandT . StrictState.withStateT f . unRandT instance (MonadCont m) => MonadCont (RandT g m) where callCC = liftCallCC' callCC instance (MonadError e m) => MonadError e (RandT g m) where throwError = lift . throwError catchError = liftCatch catchError instance (MonadReader r m, MonadWriter w m, MonadState s m) => MonadRWS r w s (RandT g m) instance (RandomGen g, Monad m) => MonadRandom (RandT g m) where getRandomR lohi = RandT . state $ randomR lohi getRandom = RandT . state $ random getRandomRs lohi = RandT . state $ first (randomRs lohi) . split getRandoms = RandT . state $ first randoms . split instance (RandomGen g, Monad m) => MonadSplit g (RandT g m) where getSplit = RandT . state $ split instance (Monad m, RandomGen g) => MonadInterleave (RandT g m) where interleave (RandT m) = liftRandT $ \g -> case split g of (gl, gr) -> liftM (\p -> (fst p, gr)) $ StrictState.runStateT m gl instance (MonadState s m) => MonadState s (RandT g m) where get = lift get put = lift . put instance PrimMonad m => PrimMonad (RandT s m) where type PrimState (RandT s m) = PrimState m primitive = lift . primitive instance Fail.MonadFail m => Fail.MonadFail (RandT g m) where fail = lift . Fail.fail -- | Uniform lifting of a @callCC@ operation to the new monad. -- This version rolls back to the original state on entering the -- continuation. liftCallCC :: CallCC m (a, g) (b, g) -> CallCC (RandT g m) a b liftCallCC callCC_ f = RandT $ StrictState.liftCallCC callCC_ $ \c -> unRandT (f (RandT . c)) -- | In-situ lifting of a @callCC@ operation to the new monad. -- This version uses the current state on entering the continuation. -- It does not satisfy the uniformity property (see "Control.Monad.Signatures"). liftCallCC' :: CallCC m (a, g) (b, g) -> CallCC (RandT g m) a b liftCallCC' callCC_ f = RandT $ StrictState.liftCallCC' callCC_ $ \c -> unRandT (f (RandT . c)) -- | Lift a @catchE@ operation to the new monad. liftCatch :: Catch e m (a, g) -> Catch e (RandT g m) a liftCatch catchE_ m f = RandT $ StrictState.liftCatch catchE_ (unRandT m) (unRandT . f) -- | Lift a @listen@ operation to the new monad. liftListen :: (Monad m) => Listen w m (a, g) -> Listen w (RandT g m) a liftListen listen_ m = RandT $ StrictState.liftListen listen_ (unRandT m) -- | Lift a @pass@ operation to the new monad. liftPass :: (Monad m) => Pass w m (a, g) -> Pass w (RandT g m) a liftPass pass_ m = RandT $ StrictState.liftPass pass_ (unRandT m) -- | Evaluate a random computation in the `IO` monad, splitting the global -- standard generator to get a new one for the computation. evalRandIO :: Rand StdGen a -> IO a evalRandIO t = liftM (evalRand t) newStdGen -- | Evaluate a random computation that is embedded in the `IO` monad, -- splitting the global standard generator to get a new one for the -- computation. evalRandTIO :: (MonadIO m) => RandT StdGen m a -> m a evalRandTIO t = liftIO newStdGen >>= evalRandT t {- $examples The @die@ function simulates the roll of a die, picking a number between 1 and 6, inclusive, and returning it in the 'Rand' monad transformer. Notice that this code will work with any random number generator @g@. > die :: (RandomGen g) => Rand g Int > die = getRandomR (1, 6) The @dice@ function uses @replicate@ and @sequence@ to simulate the roll of @n@ dice. > dice :: (RandomGen g) => Int -> Rand g [Int] > dice n = sequence (replicate n die) To extract a value from the 'Rand' monad transformer, we can use 'evalRandIO'. > main = do > values <- evalRandIO (dice 2) > putStrLn (show values) -} MonadRandom-0.5.1/Control/Monad/Random/0000755000000000000000000000000013047245021015776 5ustar0000000000000000MonadRandom-0.5.1/Control/Monad/Random/Class.hs0000644000000000000000000003553513047245021017412 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Safe #-} {-# LANGUAGE UndecidableInstances #-} {- | Module : Control.Monad.Random.Class Copyright : (c) Brent Yorgey 2016 License : BSD3 (see LICENSE) Maintainer : byorgey@gmail.com The 'MonadRandom', 'MonadSplit', and 'MonadInterleave' classes. * 'MonadRandom' abstracts over monads with the capability of generating random values. * 'MonadSplit' abstracts over random monads with the ability to get a split generator state. It is not very useful but kept here for backwards compatibility. * 'MonadInterleave' abstracts over random monads supporting an 'interleave' operation, which allows sequencing computations which do not depend on each other's random generator state, by splitting the generator between them. This module also defines convenience functions for sampling from a given collection of values, either uniformly or according to given weights. -} module Control.Monad.Random.Class ( -- * MonadRandom MonadRandom(..), -- * MonadSplit MonadSplit(..), -- * MonadInterleave MonadInterleave(..), -- * Sampling functions fromList, fromListMay, uniform, uniformMay, weighted, weightedMay ) where import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.Cont import Control.Monad.Trans.Error import Control.Monad.Trans.Except import Control.Monad.Trans.Identity import Control.Monad.Trans.List import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS import qualified Control.Monad.Trans.RWS.Strict as StrictRWS import qualified Control.Monad.Trans.State.Lazy as LazyState import qualified Control.Monad.Trans.State.Strict as StrictState import qualified Control.Monad.Trans.Writer.Lazy as LazyWriter import qualified Control.Monad.Trans.Writer.Strict as StrictWriter import System.Random import qualified Data.Foldable as F #if MIN_VERSION_base(4,8,0) #else import Data.Monoid (Monoid) #endif ------------------------------------------------------------ -- MonadRandom ------------------------------------------------------------ -- | With a source of random number supply in hand, the 'MonadRandom' class -- allows the programmer to extract random values of a variety of types. class (Monad m) => MonadRandom m where -- | Takes a range /(lo,hi)/ and a random number generator -- /g/, and returns a computation that returns a random value uniformly -- distributed in the closed interval /[lo,hi]/, together with a new -- generator. It is unspecified what happens if /lo>hi/. For continuous -- types there is no requirement that the values /lo/ and /hi/ are ever -- produced, but they may be, depending on the implementation and the -- interval. -- -- See 'System.Random.randomR' for details. getRandomR :: (Random a) => (a, a) -> m a -- | The same as 'getRandomR', but using a default range determined by the type: -- -- * For bounded types (instances of 'Bounded', such as 'Char'), -- the range is normally the whole type. -- -- * For fractional types, the range is normally the semi-closed interval -- @[0,1)@. -- -- * For 'Integer', the range is (arbitrarily) the range of 'Int'. -- -- See 'System.Random.random' for details. getRandom :: (Random a) => m a -- | Plural variant of 'getRandomR', producing an infinite list of -- random values instead of returning a new generator. -- -- See 'System.Random.randomRs' for details. getRandomRs :: (Random a) => (a, a) -> m [a] -- | Plural variant of 'getRandom', producing an infinite list of -- random values instead of returning a new generator. -- -- See 'System.Random.randoms' for details. getRandoms :: (Random a) => m [a] instance MonadRandom IO where getRandomR = randomRIO getRandom = randomIO getRandomRs lohi = liftM (randomRs lohi) newStdGen getRandoms = liftM randoms newStdGen instance (MonadRandom m) => MonadRandom (ContT r m) where getRandomR = lift . getRandomR getRandom = lift getRandom getRandomRs = lift . getRandomRs getRandoms = lift getRandoms instance (Error e, MonadRandom m) => MonadRandom (ErrorT e m) where getRandomR = lift . getRandomR getRandom = lift getRandom getRandomRs = lift . getRandomRs getRandoms = lift getRandoms instance (MonadRandom m) => MonadRandom (ExceptT e m) where getRandomR = lift . getRandomR getRandom = lift getRandom getRandomRs = lift . getRandomRs getRandoms = lift getRandoms instance (MonadRandom m) => MonadRandom (IdentityT m) where getRandomR = lift . getRandomR getRandom = lift getRandom getRandomRs = lift . getRandomRs getRandoms = lift getRandoms instance (MonadRandom m) => MonadRandom (ListT m) where getRandomR = lift . getRandomR getRandom = lift getRandom getRandomRs = lift . getRandomRs getRandoms = lift getRandoms instance (MonadRandom m) => MonadRandom (MaybeT m) where getRandomR = lift . getRandomR getRandom = lift getRandom getRandomRs = lift . getRandomRs getRandoms = lift getRandoms instance (Monoid w, MonadRandom m) => MonadRandom (LazyRWS.RWST r w s m) where getRandomR = lift . getRandomR getRandom = lift getRandom getRandomRs = lift . getRandomRs getRandoms = lift getRandoms instance (Monoid w, MonadRandom m) => MonadRandom (StrictRWS.RWST r w s m) where getRandomR = lift . getRandomR getRandom = lift getRandom getRandomRs = lift . getRandomRs getRandoms = lift getRandoms instance (MonadRandom m) => MonadRandom (ReaderT r m) where getRandomR = lift . getRandomR getRandom = lift getRandom getRandomRs = lift . getRandomRs getRandoms = lift getRandoms instance (MonadRandom m) => MonadRandom (LazyState.StateT s m) where getRandomR = lift . getRandomR getRandom = lift getRandom getRandomRs = lift . getRandomRs getRandoms = lift getRandoms instance (MonadRandom m) => MonadRandom (StrictState.StateT s m) where getRandomR = lift . getRandomR getRandom = lift getRandom getRandomRs = lift . getRandomRs getRandoms = lift getRandoms instance (MonadRandom m, Monoid w) => MonadRandom (LazyWriter.WriterT w m) where getRandomR = lift . getRandomR getRandom = lift getRandom getRandomRs = lift . getRandomRs getRandoms = lift getRandoms instance (MonadRandom m, Monoid w) => MonadRandom (StrictWriter.WriterT w m) where getRandomR = lift . getRandomR getRandom = lift getRandom getRandomRs = lift . getRandomRs getRandoms = lift getRandoms ------------------------------------------------------------ -- MonadSplit ------------------------------------------------------------ -- | The class 'MonadSplit' proivides a way to specify a random number -- generator that can be split into two new generators. -- -- This class is not very useful in practice: typically, one cannot -- actually do anything with a generator. It remains here to avoid -- breaking existing code unnecessarily. For a more practically -- useful interface, see 'MonadInterleave'. class (Monad m) => MonadSplit g m | m -> g where -- | The 'getSplit' operation allows one to obtain two distinct random number -- generators. -- -- See 'System.Random.split' for details. getSplit :: m g instance MonadSplit StdGen IO where getSplit = newStdGen instance (MonadSplit g m) => MonadSplit g (ContT r m) where getSplit = lift getSplit instance (Error e, MonadSplit g m) => MonadSplit g (ErrorT e m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (ExceptT e m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (IdentityT m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (ListT m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (MaybeT m) where getSplit = lift getSplit instance (Monoid w, MonadSplit g m) => MonadSplit g (LazyRWS.RWST r w s m) where getSplit = lift getSplit instance (Monoid w, MonadSplit g m) => MonadSplit g (StrictRWS.RWST r w s m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (ReaderT r m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (LazyState.StateT s m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (StrictState.StateT s m) where getSplit = lift getSplit instance (Monoid w, MonadSplit g m) => MonadSplit g (LazyWriter.WriterT w m) where getSplit = lift getSplit instance (Monoid w, MonadSplit g m) => MonadSplit g (StrictWriter.WriterT w m) where getSplit = lift getSplit ------------------------------------------------------------ -- MonadInterleave ------------------------------------------------------------ -- | The class 'MonadInterleave' proivides a convenient interface atop -- a 'split' operation on a random generator. class MonadRandom m => MonadInterleave m where -- | If @x :: m a@ is a computation in some random monad, then -- @interleave x@ works by splitting the generator, running @x@ -- using one half, and using the other half as the final generator -- state of @interleave x@ (replacing whatever the final generator -- state otherwise would have been). This means that computation -- needing random values which comes after @interleave x@ does not -- necessarily depend on the computation of @x@. For example: -- -- > >>> evalRandIO $ snd <$> ((,) <$> undefined <*> getRandom) -- > *** Exception: Prelude.undefined -- > >>> evalRandIO $ snd <$> ((,) <$> interleave undefined <*> getRandom) -- > 6192322188769041625 -- -- This can be used, for example, to allow random computations to -- run in parallel, or to create lazy infinite structures of -- random values. In the example below, the infinite tree -- @randTree@ cannot be evaluated lazily: even though it is cut -- off at two levels deep by @hew 2@, the random value in the -- right subtree still depends on generation of all the random -- values in the (infinite) left subtree, even though they are -- ultimately unneeded. Inserting a call to @interleave@, as in -- @randTreeI@, solves the problem: the generator splits at each -- @Node@, so random values in the left and right subtrees are -- generated independently. -- -- > data Tree = Leaf | Node Int Tree Tree deriving Show -- > -- > hew :: Int -> Tree -> Tree -- > hew 0 _ = Leaf -- > hew _ Leaf = Leaf -- > hew n (Node x l r) = Node x (hew (n-1) l) (hew (n-1) r) -- > -- > randTree :: Rand StdGen Tree -- > randTree = Node <$> getRandom <*> randTree <*> randTree -- > -- > randTreeI :: Rand StdGen Tree -- > randTreeI = interleave $ Node <$> getRandom <*> randTreeI <*> randTreeI -- -- > >>> hew 2 <$> evalRandIO randTree -- > Node 2168685089479838995 (Node (-1040559818952481847) Leaf Leaf) (Node ^CInterrupted. -- > >>> hew 2 <$> evalRandIO randTreeI -- > Node 8243316398511136358 (Node 4139784028141790719 Leaf Leaf) (Node 4473998613878251948 Leaf Leaf) interleave :: m a -> m a instance (MonadInterleave m) => MonadInterleave (ContT r m) where interleave = mapContT interleave instance (Error e, MonadInterleave m) => MonadInterleave (ErrorT e m) where interleave = mapErrorT interleave instance (MonadInterleave m) => MonadInterleave (ExceptT e m) where interleave = mapExceptT interleave instance (MonadInterleave m) => MonadInterleave (IdentityT m) where interleave = mapIdentityT interleave instance (MonadInterleave m) => MonadInterleave (ListT m) where interleave = mapListT interleave instance (MonadInterleave m) => MonadInterleave (MaybeT m) where interleave = mapMaybeT interleave instance (Monoid w, MonadInterleave m) => MonadInterleave (LazyRWS.RWST r w s m) where interleave = LazyRWS.mapRWST interleave instance (Monoid w, MonadInterleave m) => MonadInterleave (StrictRWS.RWST r w s m) where interleave = StrictRWS.mapRWST interleave instance (MonadInterleave m) => MonadInterleave (ReaderT r m) where interleave = mapReaderT interleave instance (MonadInterleave m) => MonadInterleave (LazyState.StateT s m) where interleave = LazyState.mapStateT interleave instance (MonadInterleave m) => MonadInterleave (StrictState.StateT s m) where interleave = StrictState.mapStateT interleave instance (Monoid w, MonadInterleave m) => MonadInterleave (LazyWriter.WriterT w m) where interleave = LazyWriter.mapWriterT interleave instance (Monoid w, MonadInterleave m) => MonadInterleave (StrictWriter.WriterT w m) where interleave = StrictWriter.mapWriterT interleave ------------------------------------------------------------ -- Convenience samplers ------------------------------------------------------------ -- | Sample a random value from a weighted nonempty collection of -- elements. Crashes with a call to @error@ if the collection is -- empty or the total weight is zero. weighted :: (F.Foldable t, MonadRandom m) => t (a, Rational) -> m a weighted t = do ma <- weightedMay t case ma of Nothing -> error "Control.Monad.Random.Class.weighted: empty collection, or total weight = 0" Just a -> return a -- | Sample a random value from a weighted collection of elements. -- Returns @Nothing@ if the collection is empty or the total weight is -- zero. weightedMay :: (F.Foldable t, MonadRandom m) => t (a, Rational) -> m (Maybe a) weightedMay = fromListMay . F.toList -- | Sample a random value from a weighted list. The list must be -- non-empty and the total weight must be non-zero. fromList :: (MonadRandom m) => [(a, Rational)] -> m a fromList ws = do ma <- fromListMay ws case ma of Nothing -> error "Control.Monad.Random.Class.fromList: empty list, or total weight = 0" Just a -> return a -- | Sample a random value from a weighted list. Return @Nothing@ if -- the list is empty or the total weight is zero. fromListMay :: (MonadRandom m) => [(a, Rational)] -> m (Maybe a) fromListMay xs = do let s = fromRational (sum (map snd xs)) :: Double cums = scanl1 (\ ~(_,q) ~(y,s') -> (y, s'+q)) xs case s of 0 -> return Nothing _ -> do p <- liftM toRational $ getRandomR (0, s) return . Just . fst . head . dropWhile ((< p) . snd) $ cums -- | Sample a value uniformly from a nonempty collection of elements. uniform :: (F.Foldable t, MonadRandom m) => t a -> m a uniform t = do ma <- uniformMay t case ma of Nothing -> error "Control.Monad.Random.Class.uniform: empty collection" Just a -> return a -- | Sample a value uniformly from a collection of elements. Return -- @Nothing@ if the collection is empty. uniformMay :: (F.Foldable t, MonadRandom m) => t a -> m (Maybe a) uniformMay = fromListMay . map (flip (,) 1) . F.toList MonadRandom-0.5.1/Control/Monad/Random/Lazy.hs0000644000000000000000000000326113047245021017253 0ustar0000000000000000{-# LANGUAGE Safe #-} {- | Module : Control.Monad.Random.Lazy Copyright : (c) Brent Yorgey 2016 License : BSD3 (see LICENSE) Maintainer : byorgey@gmail.com Stability : experimental Portability : non-portable (multi-param classes, functional dependencies, undecidable instances) Random monads that are lazy in the generator state. For a strict version, see "Control.Monad.Random.Strict", which has the same interface. -} module Control.Monad.Random.Lazy ( -- * The Rand monad Rand, liftRand, runRand, evalRand, execRand, mapRand, withRand, evalRandIO, -- * The RandT monad transformer RandT, liftRandT, runRandT, evalRandT, execRandT, mapRandT, withRandT, evalRandTIO, -- * Some convenience re-exports module System.Random, module Control.Monad.Random.Class, module Control.Monad, module Control.Monad.Fix, module Control.Monad.Trans, ) where import System.Random import Control.Monad.Random.Class import Control.Monad.Trans import Control.Monad.Trans.Random.Lazy (Rand, RandT, evalRand, evalRandIO, evalRandT, evalRandTIO, execRand, execRandT, liftRand, liftRandT, mapRand, mapRandT, runRand, runRandT, withRand, withRandT) import Control.Monad import Control.Monad.Fix MonadRandom-0.5.1/Control/Monad/Random/Strict.hs0000644000000000000000000000331413047245021017603 0ustar0000000000000000{-# LANGUAGE Safe #-} {- | Module : Control.Monad.Random.Strict Copyright : (c) Brent Yorgey 2016 License : BSD3 (see LICENSE) Maintainer : byorgey@gmail.com Stability : experimental Portability : non-portable (multi-param classes, functional dependencies, undecidable instances) Random monads that are strict in the generator state. For a lazy version, see "Control.Monad.Random.Lazy", which has the same interface. -} module Control.Monad.Random.Strict ( -- * The Rand monad transformer Rand, liftRand, runRand, evalRand, execRand, mapRand, withRand, evalRandIO, -- * The RandT monad transformer RandT, liftRandT, runRandT, evalRandT, execRandT, mapRandT, withRandT, evalRandTIO, -- * Some convenience re-exports module System.Random, module Control.Monad.Random.Class, module Control.Monad, module Control.Monad.Fix, module Control.Monad.Trans, ) where import System.Random import Control.Monad.Random.Class import Control.Monad.Trans import Control.Monad.Trans.Random.Strict (Rand, RandT, evalRand, evalRandIO, evalRandT, evalRandTIO, execRand, execRandT, liftRand, liftRandT, mapRand, mapRandT, runRand, runRandT, withRand, withRandT) import Control.Monad import Control.Monad.Fix