diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,9 +1,13 @@ # Changelog for polysemy-zoo +## 0.2.0.0 (2019-06-14) + +- Remove `Polysemy.RandomFu`, which is moving to its own package +- Add explicit cabal bounds for dependencies of `polysemy-zoo` + ## 0.1.2.1 (2019-06-12) - Update the tests to run against `polysemy-0.4.0.0` - ## 0.1.2.0 (2019-06-01) diff --git a/polysemy-zoo.cabal b/polysemy-zoo.cabal --- a/polysemy-zoo.cabal +++ b/polysemy-zoo.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: b8422eaa237bad8199d235d37dd432322f191094275f7e61d94fb38fb030d101 +-- hash: be5a00f62e6365b8c06031d6b6bba39891290626e69ab7d0a78f1861f2dd035d name: polysemy-zoo -version: 0.1.2.1 +version: 0.2.0.0 synopsis: Experimental, user-contributed effects and interpreters for polysemy description: Please see the README on GitHub at category: Polysemy @@ -34,7 +34,6 @@ Polysemy.MTL Polysemy.Operators Polysemy.Random - Polysemy.RandomFu Polysemy.Several other-modules: Paths_polysemy_zoo @@ -44,15 +43,13 @@ ghc-options: -fplugin=Polysemy.Plugin build-depends: base >=4.7 && <5 - , constraints - , containers + , constraints >=0.10.1 && <0.12 + , containers >=0.6 && <0.7 , mtl >=2.0.1.0 && <3.0.0.0 , polysemy >=0.3 , polysemy-plugin , random >=1.1 && <1.2 - , random-fu - , random-source - , reflection + , reflection >=2.1.4 && <3.0.0 default-language: Haskell2010 test-suite polysemy-zoo-test @@ -62,7 +59,6 @@ IdempotentLoweringSpec KVStoreSpec MTLSpec - RandomFuSpec SeveralSpec Paths_polysemy_zoo hs-source-dirs: @@ -71,16 +67,14 @@ ghc-options: -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 - , constraints - , containers + , constraints >=0.10.1 && <0.12 + , containers >=0.6 && <0.7 , hspec , mtl >=2.0.1.0 && <3.0.0.0 , polysemy >=0.4 , polysemy-plugin , polysemy-zoo , random >=1.1 && <1.2 - , random-fu - , random-source - , reflection + , reflection >=2.1.4 && <3.0.0 , text default-language: Haskell2010 diff --git a/src/Polysemy/RandomFu.hs b/src/Polysemy/RandomFu.hs deleted file mode 100644 --- a/src/Polysemy/RandomFu.hs +++ /dev/null @@ -1,137 +0,0 @@ -{-# 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 #-} - -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 #-} diff --git a/test/RandomFuSpec.hs b/test/RandomFuSpec.hs deleted file mode 100644 --- a/test/RandomFuSpec.hs +++ /dev/null @@ -1,68 +0,0 @@ -{-# 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 -