polysemy-RandomFu (empty) → 0.1.0.0
raw patch · 7 files changed
+348/−0 lines, 7 filesdep +basedep +hspecdep +polysemy
Dependencies added: base, hspec, polysemy, polysemy-RandomFu, polysemy-plugin, polysemy-zoo, random-fu, random-source, text
Files
- ChangeLog.md +7/−0
- LICENSE +30/−0
- Readme.md +34/−0
- polysemy-RandomFu.cabal +69/−0
- src/Polysemy/RandomFu.hs +139/−0
- test/Main.hs +1/−0
- test/RandomFuSpec.hs +68/−0
+ ChangeLog.md view
@@ -0,0 +1,7 @@+# Changelog for polysemy-RandomFu++## 0.1.0.0 (2019-06-14)+- Initial Release with RandomFu effect/intepreters++## Unreleased changes+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Sandy Maguire (c) 2019++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 Sandy Maguire 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.
+ Readme.md view
@@ -0,0 +1,34 @@+# polysemy-RandomFu++## Summary+- Polysemy effect and intepreters to use the random-fu library in a polysemy effect union (like an mtl stack).+- Includes an MTL "absorber" (see https://github.com/isovector/polysemy-zoo/blob/master/src/Polysemy/MTL.hs) for+to random-fu ```MonadRandom``` typeclass.++## Example (from the tests)+```haskell+import Polysemy+import Polysemy.RandomFu++import qualified Data.Random as R+import qualified Data.Random.Source.PureMT as R++getRandomInts :: Member RandomFu r => Int -> Sem r [Int]+getRandomInts nDraws =+ sampleRVar $ M.replicateM nDraws (R.uniform 0 (100 :: Int))+ +main :: IO ()+main = do+ seed <- R.newPureMT+ putStrLn . show $ runM . runRandomIOPureMT (R.pureMT seed) $ getRandomInts 5+```+should print a list of 5 pseudo-random integers. +They will be different each time you run because the ```newPureMT``` function +returns a different seed each time it's called. If you replace that seed in +the ```R.pureMT``` argument to ```runRandomIOPureMT``` with a fixed number+then you will get the *same* pseudo-random sequences each time. This can be+useful for testing.++## Notes+- See the tests (in https://github.com/adamConnerSax/Polysemy-Extra/blob/master/polysemy-RandomFu/test/RandomFuSpec.hs) +for more details about how to use this effect
+ polysemy-RandomFu.cabal view
@@ -0,0 +1,69 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 8b08324c19e2b90da9f91c6c9e4b0ec7b189d02891867db140555b58e4c9e461++name: polysemy-RandomFu+version: 0.1.0.0+synopsis: Experimental, RandomFu effect and interpreters for polysemy+description: Please see the README on GitHub at <https://github.com/adamConnerSax/polysemy-Extra/tree/master/polysemy-RandomFu#polysemy-randomfu>+category: Polysemy+homepage: https://github.com/adamConnerSax/polysemy-Extra#readme+bug-reports: https://github.com/adamConnerSax/polysemy-Extra/issues+author: Adam Conner-Sax+maintainer: adam_conner_sax@yahoo.com+copyright: 2019 Adam Conner-Sax+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ Readme.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/adamConnerSax/polysemy-Extra+ subdir: polysemy-RandomFu++library+ exposed-modules:+ Polysemy.RandomFu+ other-modules:+ Paths_polysemy_RandomFu+ hs-source-dirs:+ src+ default-extensions: DataKinds DeriveFunctor FlexibleContexts GADTs LambdaCase PolyKinds RankNTypes ScopedTypeVariables StandaloneDeriving TypeApplications TypeOperators TypeFamilies UnicodeSyntax+ ghc-options: -fplugin=Polysemy.Plugin+ build-depends:+ base >=4.7 && <5+ , polysemy >=0.3+ , polysemy-plugin+ , polysemy-zoo >=0.2+ , random-fu+ , random-source+ default-language: Haskell2010++test-suite polysemy-RandomFu-test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ RandomFuSpec+ Paths_polysemy_RandomFu+ hs-source-dirs:+ test+ default-extensions: DataKinds DeriveFunctor FlexibleContexts GADTs LambdaCase PolyKinds RankNTypes ScopedTypeVariables StandaloneDeriving TypeApplications TypeOperators TypeFamilies UnicodeSyntax+ ghc-options: -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , hspec+ , polysemy >=0.3+ , polysemy-RandomFu+ , polysemy-plugin+ , polysemy-zoo+ , random-fu+ , random-source+ , text+ default-language: Haskell2010
+ src/Polysemy/RandomFu.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}+{-|+Module : Polysemy.RandomFu+Description : Polysemy random-fu effect++Polysemy "random-fu" effect.+This can be run in a few ways:+1. Directly in 'IO'+2. Using any 'Data.Random.RandomSource' from "random-fu"+3. In 'IO', using a given 'Data.Random.Source.PureMT' source.+('IO' is used to put the source in an 'IORef')++This module also contains the type-class instances to enable "absorbing"+MonadRandom, ala Polysemy.MTL. See the tests for MTL or RandomFu for+examples of that in use.+-}++module Polysemy.RandomFu+ (+ -- * Effect+ RandomFu (..)++ -- * Actions+ , sampleRVar+ , getRandomPrim+ , sampleDist++ -- * Interpretations+ , runRandomSource+ , runRandomIO+ , runRandomIOPureMT++ -- * Constraint absorber+ , absorbMonadRandom+ )+where++import Polysemy+import Polysemy.MTL++import Data.IORef ( newIORef )+import qualified Data.Random as R+import qualified Data.Random.Source as R+import qualified Data.Random.Internal.Source as R+import qualified Data.Random.Source.PureMT as R+import Control.Monad.IO.Class ( MonadIO(..) )+++------------------------------------------------------------------------------+{- | An effect capable of sampling from a "random-fu" RVar or generating a+single random-variate of any type, @t@ with a+@Data.Random.Prim t@ constructor, currently one of @Word8@, @Word16@,+@Word32@, @Word64@, @Double@ or N-byte integer.+-}+data RandomFu m r where+ SampleRVar :: R.RVar t -> RandomFu m t+ GetRandomPrim :: R.Prim t -> RandomFu m t++makeSem ''RandomFu++------------------------------------------------------------------------------+-- | use the 'RandomFu` effect to sample from a "random-fu" @Distribution@.+sampleDist+ :: (Member RandomFu r, R.Distribution d t) => d t -> Sem r t+sampleDist = sampleRVar . R.rvar+{-# INLINEABLE sampleDist #-}++------------------------------------------------------------------------------+-- | Run a 'Random' effect using a given 'R.RandomSource'+runRandomSource+ :: forall s r a+ . R.RandomSource (Sem r) s+ => s+ -> Sem (RandomFu ': r) a+ -> Sem r a+runRandomSource source = interpret $ \case+ SampleRVar rv -> R.runRVar (R.sample rv) source+ GetRandomPrim pt -> R.runRVar (R.getRandomPrim pt) source+{-# INLINEABLE runRandomSource #-}++------------------------------------------------------------------------------+-- | Run a 'Random` effect by using the default "random-fu" 'IO' source+runRandomIO+ :: forall r a+ . MonadIO (Sem r)+ => Sem (RandomFu ': r) a+ -> Sem r a+runRandomIO = interpret $ \case+ SampleRVar rv -> liftIO $ R.sample rv+ GetRandomPrim pt -> liftIO $ R.getRandomPrim pt+{-# INLINEABLE runRandomIO #-}++------------------------------------------------------------------------------+-- | Run in 'IO', using the given 'R.PureMT' source, stored in an 'IORef'+runRandomIOPureMT+ :: MonadIO (Sem r)+ => R.PureMT+ -> Sem (RandomFu ': r) a+ -> Sem r a+runRandomIOPureMT source re =+ liftIO (newIORef source) >>= flip runRandomSource re+{-# INLINEABLE runRandomIOPureMT #-}++------------------------------------------------------------------------------+-- | "Absorb" an 'R.MonadRandom' constraint.+-- That is, use a @Member RandomFu r@ constraint to satisfy the @MonadRandom@+-- constraint in a @(forall m. MonadRandom m => m a), returning a @Sem r a@.+-- See 'Polysemy.MTL' for details.+absorbMonadRandom+ :: Member RandomFu r => (R.MonadRandom (Sem r) => Sem r a) -> Sem r a+absorbMonadRandom = absorb @R.MonadRandom+{-# INLINEABLE absorbMonadRandom #-}++type instance CanonicalEffect R.MonadRandom = RandomFu++instance ReifiableConstraint1 (R.MonadRandom) where+ data Dict1 R.MonadRandom m = MonadRandom+ {+ getRandomPrim_ :: forall t. R.Prim t -> m t+ }+ reifiedInstance = Sub Dict+++$(R.monadRandom [d|+ instance ( Monad m+ , Reifies s' (Dict1 R.MonadRandom m)+ ) => R.MonadRandom (ConstrainedAction R.MonadRandom m s') where+ getRandomPrim t = ConstrainedAction+ $ getRandomPrim_ (reflect $ Proxy @s') t+ {-# INLINEABLE getRandomPrim #-}+ |])++instance Member RandomFu r => IsCanonicalEffect R.MonadRandom r where+ canonicalDictionary = MonadRandom getRandomPrim+ {-# INLINEABLE canonicalDictionary #-}
+ test/Main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/RandomFuSpec.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module RandomFuSpec where++import Polysemy+import Polysemy.RandomFu++import Test.Hspec+import Control.Monad as M+import Control.Monad.IO.Class ( liftIO )++import qualified Data.Random as R+import qualified Data.Random.Source.PureMT as R++getRandomInts :: Member RandomFu r => Int -> Sem r [Int]+getRandomInts nDraws =+ sampleRVar $ M.replicateM nDraws (R.uniform 0 (100 :: Int))++getRandomIntsMR :: R.MonadRandom m => Int -> m [Int]+getRandomIntsMR nDraws =+ R.sample $ M.replicateM nDraws (R.uniform 0 (100 :: Int))++randomListsDifferent :: Member RandomFu r => Int -> Sem r Bool+randomListsDifferent nDraws = do+ a <- getRandomInts nDraws+ b <- getRandomInts nDraws+ return (a /= b)++randomListsDifferentMR :: R.MonadRandom m => Int -> m Bool+randomListsDifferentMR nDraws = do+ a <- getRandomIntsMR nDraws+ b <- getRandomIntsMR nDraws+ return (a /= b)++------------------------------------------------------------------------------++spec :: Spec+spec = describe "RandomFu" $ do+ it+ "Should produce [3, 78, 53, 41, 56], 5 psuedo-random Ints seeded from the same seed on each test."+ $ do+ result <- runM . runRandomIOPureMT (R.pureMT 1) $ getRandomInts 5+ result `shouldBe` [3, 78, 53, 41, 56]++ it+ "Should produce [3, 78, 53, 41, 56], 5 psuedo-random Ints seeded from the same seed on each test. Absorbing MonadRandom."+ $ do+ result <-+ runM+ . runRandomIOPureMT (R.pureMT 1)+ $ absorbMonadRandom+ $ getRandomIntsMR 5++ result `shouldBe` [3, 78, 53, 41, 56]+++ it "Should produce two distinct sets of psuedo-random Ints." $ do+ result <- runM . runRandomIO $ randomListsDifferent 5+ result `shouldBe` True++ it+ "Should produce two distinct sets of psuedo-random Ints (absorber version)."+ $ do+ result <-+ runM . runRandomIO $ absorbMonadRandom $ randomListsDifferentMR 5+ result `shouldBe` True+