packages feed

fused-effects-random (empty) → 1.0.0.0

raw patch · 5 files changed

+213/−0 lines, 5 filesdep +MonadRandomdep +basedep +fused-effectssetup-changed

Dependencies added: MonadRandom, base, fused-effects, random, transformers

Files

+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# 1.0.0.0++- Port to `fused-effects` 1.++# 0.0.0.0++- Initial port from `fused-effects`.
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2018-2019, Nicolas Wu, Tom Schrijvers, Rob Rix, and Patrick Thomson+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 the copyright holder nor the names of its+  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 HOLDER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fused-effects-random.cabal view
@@ -0,0 +1,50 @@+cabal-version:       2.2++name:                fused-effects-random+version:             1.0.0.0+synopsis:            Random number generation for fused-effects.+description:         Random number generation as an effect using fused-effects.+homepage:            https://github.com/fused-effects/fused-effects-random+bug-reports:         https://github.com/fused-effects/fused-effects-random/issues+license:             BSD-3-Clause+license-file:        LICENSE+author:              Rob Rix+maintainer:          robrix@github.com+copyright:           2019 Rob Rix+category:            Control+build-type:          Simple+extra-source-files:+  CHANGELOG.md++common common+  default-language:    Haskell2010+  ghc-options:+    -Weverything+    -Wno-all-missed-specialisations+    -Wno-implicit-prelude+    -Wno-missed-specialisations+    -Wno-missing-import-lists+    -Wno-missing-local-signatures+    -Wno-monomorphism-restriction+    -Wno-name-shadowing+    -Wno-safe+    -Wno-unsafe+  if (impl(ghc >= 8.6))+    ghc-options:+      -Wno-star-is-type++library+  import:              common+  exposed-modules:+    Control.Effect.Random+  build-depends:       base >=4.10 && <4.15+                     , fused-effects ^>= 1+                     , MonadRandom ^>= 0.5.1.1+                     , random ^>= 1.1+                     , transformers >= 0.4 && <0.6+  hs-source-dirs:      src+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/fused-effects/fused-effects-random
+ src/Control/Effect/Random.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances #-}+module Control.Effect.Random+( -- * Random effect+  Random(..)+, getRandom+, getRandomR+, interleave+  -- * Random carrier+, runRandom+, evalRandom+, execRandom+, evalRandomIO+, RandomC(..)+  -- * Re-exports+, Has+, run+) where++import Control.Algebra+import Control.Applicative (Alternative(..))+import Control.Carrier.State.Strict+import Control.Monad (MonadPlus(..))+import Control.Monad.Fail+import Control.Monad.Fix+import qualified Control.Monad.Random.Class as R+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Trans.Class+import qualified System.Random as R (Random(..), RandomGen(..), StdGen, newStdGen)++data Random m k+  = forall a . R.Random a => Random (a -> m k)+  | forall a . R.Random a => RandomR (a, a) (a -> m k)+  | forall a . Interleave (m a) (a -> m k)++deriving instance Functor m => Functor (Random m)++instance HFunctor Random where+  hmap f (Random       k) = Random           (f . k)+  hmap f (RandomR r    k) = RandomR r        (f . k)+  hmap f (Interleave m k) = Interleave (f m) (f . k)+  {-# INLINE hmap #-}++instance Effect Random where+  thread state handler (Random       k) = Random                            (handler . (<$ state) . k)+  thread state handler (RandomR r    k) = RandomR r                         (handler . (<$ state) . k)+  thread state handler (Interleave m k) = Interleave (handler (m <$ state)) (handler . fmap k)+  {-# INLINE thread #-}+++getRandom :: (Has Random sig m, R.Random a) => m a+getRandom = send (Random pure)++getRandomR :: (Has Random sig m, R.Random a) => (a, a) -> m a+getRandomR interval = send (RandomR interval pure)++interleave :: (Has Random sig m) => m a -> m a+interleave m = send (Interleave m pure)+++-- | Run a random computation starting from a given generator.+--+--   prop> run (runRandom (PureGen a) (pure b)) === (PureGen a, b)+runRandom :: g -> RandomC g m a -> m (g, a)+runRandom g = runState g . runRandomC++-- | Run a random computation starting from a given generator and discarding the final generator.+--+--   prop> run (evalRandom (PureGen a) (pure b)) === b+evalRandom :: Functor m => g -> RandomC g m a -> m a+evalRandom g = fmap snd . runRandom g++-- | Run a random computation starting from a given generator and discarding the final result.+--+--   prop> run (execRandom (PureGen a) (pure b)) === PureGen a+execRandom :: Functor m => g -> RandomC g m a -> m g+execRandom g = fmap fst . runRandom g++-- | Run a random computation in 'IO', splitting the global standard generator to get a new one for the computation.+evalRandomIO :: MonadIO m => RandomC R.StdGen m a -> m a+evalRandomIO m = liftIO R.newStdGen >>= flip evalRandom m++newtype RandomC g m a = RandomC { runRandomC :: StateC g m a }+  deriving (Alternative, Applicative, Functor, Monad, MonadFail, MonadFix, MonadIO, MonadPlus, MonadTrans)++instance (Algebra sig m, Effect sig, R.RandomGen g) => R.MonadRandom (RandomC g m) where+  getRandom = getRandom+  {-# INLINE getRandom #-}+  getRandomR = getRandomR+  {-# INLINE getRandomR #-}+  getRandomRs interval = (:) <$> R.getRandomR interval <*> R.getRandomRs interval+  {-# INLINE getRandomRs #-}+  getRandoms = (:) <$> R.getRandom <*> R.getRandoms+  {-# INLINE getRandoms #-}++instance (Algebra sig m, Effect sig, R.RandomGen g) => R.MonadInterleave (RandomC g m) where+  interleave = interleave+  {-# INLINE interleave #-}++instance (Algebra sig m, Effect sig, R.RandomGen g) => Algebra (Random :+: sig) (RandomC g m) where+  alg (L (Random       k)) = RandomC $ do+    (a, g') <- gets R.random+    put (g' :: g)+    runRandomC (k a)+  alg (L (RandomR r    k)) = RandomC $ do+    (a, g') <- gets (R.randomR r)+    put (g' :: g)+    runRandomC (k a)+  alg (L (Interleave m k)) = RandomC $ do+    (g1, g2) <- gets R.split+    put (g1 :: g)+    a <- runRandomC m+    put g2+    runRandomC (k a)+  alg (R other)            = RandomC (alg (R (handleCoercible other)))+  {-# INLINE alg #-}+++-- $setup+-- >>> :seti -XFlexibleContexts+-- >>> import System.Random+-- >>> import Test.QuickCheck+-- >>> import Control.Effect.Pure+-- >>> import Control.Effect.NonDet+-- >>> newtype PureGen = PureGen Int deriving (Eq, Show)+-- >>> instance RandomGen PureGen where next (PureGen i) = (i, PureGen i) ; split g = (g, g)