polysemy-RandomFu 0.4.4.1 → 0.5.0.0

raw patch · 6 files changed

+98/−27 lines, 6 filesdep +mtldep +randomdep +rvardep ~random-fuPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl, random, rvar

Dependency ranges changed: random-fu

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• Readme.md +3/−1
• polysemy-RandomFu.cabal +7/−2
• src/Polysemy/ConstraintAbsorber/MonadRandom.hs +5/−1
• src/Polysemy/RandomFu.hs +50/−12
• test/RandomFuSpec.hs +27/−11

@@ -1,3 +1,9 @@+## v0.5.0.0+- Breaking: Following random-fu >= 0.3.0.0 we are dropping random-source.+  removed MonadRandom and its ConstraintAbsorber+- Changed lower bound on random to 1.2.1+- Changes to use random >= 1.2.1+ ## v0.4.4.1 - Bumped polysemy and text upper bounds 

@@ -1,4 +1,4 @@-# polysemy-RandomFu v0.4.2.1+# polysemy-RandomFu v0.5.0.0  [![Build Status][travis-badge]][travis] [![Hackage][hackage-badge]][hackage]@@ -8,6 +8,8 @@ - Polysemy effect and intepreters to use the random-fu library in a polysemy effect union (like an mtl stack). - Includes a constraint "absorber" (see https://github.com/isovector/polysemy-zoo/blob/master/src/Polysemy/ConstraintAbsorber.hs) for the random-fu ```MonadRandom``` typeclass.+- NB: If you compile with random-fu >= 0.3.0.0, there is no longer a constraint absorber in this library since random-fu no longer uses+  random-source or MonadRandom.  ## Example (from the tests) ```haskell

@@ -7,7 +7,7 @@ -- hash: 349bb25cc65abf6aff1ddd691ea89785dcab4cad79092dc05c66631746153a79  name:           polysemy-RandomFu-version:        0.4.4.1+version:        0.5.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@@ -55,11 +55,14 @@   ghc-options: -fplugin=Polysemy.Plugin   build-depends:       base >=4.7 && <5+    , mtl >= 2.0 && < 2.3     , polysemy >=1.3 && <1.8     , polysemy-plugin >0.2.0 && <0.5     , polysemy-zoo >=0.6.0 && <0.9-    , random-fu >=0.2.7.7 && <0.3.0.0+    , random-fu >=0.2.7.7 && <0.4.0.0     , random-source >=0.3.0.11 && <0.4.0.0+    , rvar >= 0.3.0 && < 0.4+    , random >= 1.2.1 && < 1.3   default-language: Haskell2010  test-suite polysemy-RandomFu-test@@ -90,10 +93,12 @@   build-depends:       base >=4.7 && <5     , hspec >=2.0+    , mtl >= 2.0 && < 2.3     , polysemy     , polysemy-RandomFu     , polysemy-plugin     , polysemy-zoo+    , random >= 1.2.1 && < 1.3     , random-fu     , random-source     , text >=1.1.0.0 && <2.1

@@ -1,6 +1,9 @@+{-# LANGUAGE CPP                         #-} {-# LANGUAGE GeneralizedNewtypeDeriving  #-} {-# LANGUAGE TemplateHaskell             #-}-+#if MIN_VERSION_random_fu(0,3,0)+module Polysemy.ConstraintAbsorber.MonadRandom () where+#else module Polysemy.ConstraintAbsorber.MonadRandom   (     absorbMonadRandom@@ -48,3 +51,4 @@   (RandomDict (getRandomPrim @r))   (Sub Dict) {-# INLINEABLE absorbMonadRandom #-}+#endif

@@ -1,4 +1,6 @@+{-# LANGUAGE CPP                   #-} {-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE TypeApplications      #-} {-| Module      : Polysemy.RandomFu Description : Polysemy random-fu effect@@ -22,7 +24,10 @@      -- * Actions   , sampleRVar+#if MIN_VERSION_random_fu(0,3,0)+#else   , getRandomPrim+#endif   , sampleDist      -- * Interpretations@@ -33,14 +38,21 @@ where  import           Polysemy+import           Polysemy.State as PS --import           Polysemy.MTL  import           Data.IORef                     ( newIORef ) import qualified Data.Random                   as R+import qualified Data.Random.RVar as R import qualified Data.Random.Internal.Source   as R+import qualified Data.Random.Source.StdGen     as R import qualified Data.Random.Source.PureMT     as R+import qualified Data.RVar                     as R (pureRVar)+import Data.Random.Source.IO () import           Control.Monad.IO.Class         ( MonadIO(..) )-+import Control.Monad.Reader.Class (MonadReader)+import qualified System.Random.Stateful as SR+import GHC.IORef (IORef)  ------------------------------------------------------------------------------ {- | An effect capable of sampling from a "random-fu" RVar or generating a@@ -50,8 +62,10 @@ -} data RandomFu m r where   SampleRVar ::  R.RVar t -> RandomFu m t+#if MIN_VERSION_random_fu(0,3,0)+#else   GetRandomPrim :: R.Prim t -> RandomFu m t-+#endif makeSem ''RandomFu  ------------------------------------------------------------------------------@@ -65,15 +79,19 @@ -- | Run a 'Random' effect using a given 'R.RandomSource' runRandomSource   :: forall s m r a-   . ( R.RandomSource m s+   . (SR.StatefulGen s m+     , R.RandomSource m s      , Member (Embed m) r      )   => s   -> Sem (RandomFu ': r) a   -> Sem r a runRandomSource source = interpret $ \case-    SampleRVar    rv -> embed $ R.runRVar (R.sample rv) source-    GetRandomPrim pt -> embed $ R.runRVar (R.getRandomPrim pt) source+    SampleRVar    rv -> embed $ R.runRVar rv source+#if MIN_VERSION_random_fu(0,3,0)+#else+    GetRandomPrim pt -> embed $ R.getRandomPrimFrom source pt+#endif {-# INLINEABLE runRandomSource #-}  ------------------------------------------------------------------------------@@ -83,19 +101,39 @@    . 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+runRandomIO x = do+  g <- SR.getStdGen+  evalState g $ reinterpret ( \case+    SampleRVar rv -> do+      g <- get+      let (x, g') = R.pureRVar rv g+      put g'+      return x+#if MIN_VERSION_random_fu(0,3,0)+#else+    GetRandomPrim pt -> raise $ R.getRandomPrim pt+#endif+    )+    x {-# INLINEABLE runRandomIO #-}  ------------------------------------------------------------------------------ -- | Run in 'IO', using the given 'R.PureMT' source, stored in an 'IORef' runRandomIOPureMT-  :: Member (Embed IO) r+  :: (Member (Embed IO) r+      )   => R.PureMT   -> Sem (RandomFu ': r) a   -> Sem r a-runRandomIOPureMT source re =-  embed (newIORef source) >>= flip runRandomSource re+runRandomIOPureMT pMT = interpret $ \case+   SampleRVar    rv -> liftIO $ do+     g <- SR.newIOGenM pMT+     R.runRVar rv g+#if MIN_VERSION_random_fu(0,3,0)+#else+   GetRandomPrim pt -> liftIO $ do+     g <- newIORef pMT+     R.getRandomPrimFromMTRef g pt+#endif+--getRandomPrimFromMTRef   embed (SR.newIOGenM source) >>= flip runRandomSource re {-# INLINEABLE runRandomIOPureMT #-}-

@@ -1,17 +1,22 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-} module RandomFuSpec where  import           Polysemy import           Polysemy.RandomFu-import           Polysemy.ConstraintAbsorber.MonadRandom  import           Test.Hspec import           Control.Monad                 as M import           Control.Monad.IO.Class         ( liftIO )  import qualified Data.Random                   as R++#if MIN_VERSION_random_fu(0,3,0)+#else+import           Polysemy.ConstraintAbsorber.MonadRandom+#endif+ import qualified Data.Random.Source.PureMT     as R  import qualified Data.Random.Source.MWC as MWC@@ -21,9 +26,12 @@ getRandomInts nDraws =   sampleRVar $ M.replicateM nDraws (R.uniform 0 (100 :: Int)) +#if MIN_VERSION_random_fu(0,3,0)+#else getRandomIntsMR :: R.MonadRandom m => Int -> m [Int] getRandomIntsMR nDraws =   R.sample $ M.replicateM nDraws (R.uniform 0 (100 :: Int))+#endif  randomListsDifferent :: Member RandomFu r => Int -> Sem r Bool randomListsDifferent nDraws = do@@ -31,12 +39,17 @@   b <- getRandomInts nDraws   return (a /= b) +#if MIN_VERSION_random_fu(0,3,0)+#else randomListsDifferentMR :: R.MonadRandom m => Int -> m Bool randomListsDifferentMR nDraws = do   a <- getRandomIntsMR nDraws   b <- getRandomIntsMR nDraws   return (a /= b)+#endif ++ ------------------------------------------------------------------------------  spec :: Spec@@ -45,35 +58,38 @@       "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]+        result `shouldBe` [26, 56, 52, 0, 0]    it-      "Should produce [3, 78, 53, 41, 56], 5 psuedo-random Ints seeded from the same seed on each test. Absorbing MonadRandom."+      "Should produce [3, 78, 53, 41, 56], 5 psuedo-random Ints seeded from the same seed on each test. "+#if MIN_VERSION_random_fu(0,3,0)+#else     $ do         result <-           runM           . runRandomIOPureMT (R.pureMT 1)           $ absorbMonadRandom           $ getRandomIntsMR 5-         result `shouldBe` [3, 78, 53, 41, 56]-   it-      "Should produce [95, 40, 24, 49, 64], 5 pseudo-random Ints seeded from the same seed on each test, from an MWC RandomSource."+      "Should produce [95, 40, 24, 49, 64], 5 pseudo-random Ints seeded from the same seed on each test, from an MWC RandomSource. Absorbing MonadRandom"+#endif+     $ do       gen <- MWC.initialize (V.fromList [0])       result <-         runM . runRandomSource gen $ getRandomInts 5-      result `shouldBe` [95, 40, 24, 49, 64]+      result `shouldBe` [22, 15, 75, 18, 80]    it "Should produce two distinct sets of psuedo-random Ints." $ do     result <- runM . runRandomIO $ randomListsDifferent 5     result `shouldBe` True-+#if MIN_VERSION_random_fu(0,3,0)+#else   it-      "Should produce two distinct sets of psuedo-random Ints (absorber version)."+      "Should produce two distinct sets of psuedo-random Ints."     $ do         result <-           runM . runRandomIO $ absorbMonadRandom $ randomListsDifferentMR 5         result `shouldBe` True-+#endif