polysemy-RandomFu 0.1.0.0 → 0.2.0.0
raw patch · 6 files changed
+83/−55 lines, 6 filesdep ~hspecdep ~polysemy-plugindep ~polysemy-zoo
Dependency ranges changed: hspec, polysemy-plugin, polysemy-zoo, random-fu, random-source, text
Files
- ChangeLog.md +4/−0
- Readme.md +14/−3
- polysemy-RandomFu.cabal +15/−11
- src/Polysemy/ConstraintAbsorber/MonadRandom.hs +48/−0
- src/Polysemy/RandomFu.hs +1/−41
- test/RandomFuSpec.hs +1/−0
ChangeLog.md view
@@ -1,5 +1,9 @@ # Changelog for polysemy-RandomFu +## 0.2.0.0+- Changes to keep up with ConstraintAbsorber changes in polysemy-zoo++ ## 0.1.0.0 (2019-06-14) - Initial Release with RandomFu effect/intepreters
Readme.md view
@@ -1,9 +1,13 @@-# polysemy-RandomFu+# polysemy-RandomFu v0.2.0.0 +[![Build Status][travis-badge]][travis]+[![Hackage][hackage-badge]][hackage]+[![Hackage Dependencies][hackage-deps-badge]][hackage-deps]+ ## 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.+- Includes a constraint "absorber" (see https://github.com/isovector/polysemy-zoo/blob/master/src/Polysemy/ConstraintAbsorber.hs) for+the random-fu ```MonadRandom``` typeclass. ## Example (from the tests) ```haskell@@ -32,3 +36,10 @@ ## 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++[travis]: <https://travis-ci.org/adamConnerSax/polysemy-extra>+[travis-badge]: <https://travis-ci.org/adamConnerSax/polysemy-Extra.svg?branch=master>+[hackage]: <https://hackage.haskell.org/package/polysemy-RandomFu>+[hackage-badge]: <https://img.shields.io/hackage/v/polysemy-RandomFu.svg>+[hackage-deps-badge]: <https://img.shields.io/hackage-deps/v/polysemy-RandomFu.svg>+[hackage-deps]: <http://packdeps.haskellers.com/feed?needle=polysemy-RandomFu>
polysemy-RandomFu.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 8b08324c19e2b90da9f91c6c9e4b0ec7b189d02891867db140555b58e4c9e461+-- hash: eae1a0503816a03e0d5218be187818539f2cba48460bc5b150f75b11a2ea2dfb name: polysemy-RandomFu-version: 0.1.0.0+version: 0.2.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@@ -18,6 +18,7 @@ copyright: 2019 Adam Conner-Sax license: BSD3 license-file: LICENSE+tested-with: GHC ==8.6.4 build-type: Simple extra-source-files: Readme.md@@ -30,6 +31,7 @@ library exposed-modules:+ Polysemy.ConstraintAbsorber.MonadRandom Polysemy.RandomFu other-modules: Paths_polysemy_RandomFu@@ -40,10 +42,10 @@ build-depends: base >=4.7 && <5 , polysemy >=0.3- , polysemy-plugin- , polysemy-zoo >=0.2- , random-fu- , random-source+ , polysemy-plugin >0.2.0.0 && <0.4.0.0+ , polysemy-zoo >=0.3+ , random-fu >=0.2.5.0 && <0.3.0.0+ , random-source >=0.3 && <0.4.0.0 default-language: Haskell2010 test-suite polysemy-RandomFu-test@@ -56,14 +58,16 @@ 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-tool-depends:+ hspec-discover:hspec-discover >=2.0 build-depends: base >=4.7 && <5- , hspec+ , hspec >=2.0 , polysemy >=0.3 , polysemy-RandomFu- , polysemy-plugin+ , polysemy-plugin >0.2.0.0 && <0.4.0.0 , polysemy-zoo- , random-fu- , random-source- , text+ , random-fu >=0.2.5.0 && <0.3.0.0+ , random-source >=0.3 && <0.4.0.0+ , text >=1.1.0.0 && <1.3.0.0 default-language: Haskell2010
+ src/Polysemy/ConstraintAbsorber/MonadRandom.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}++module Polysemy.ConstraintAbsorber.MonadRandom+ (+ absorbMonadRandom+ )+where++import Polysemy+import Polysemy.ConstraintAbsorber+import Polysemy.RandomFu++import qualified Data.Random.Source as R+import qualified Data.Random.Internal.Source as R++------------------------------------------------------------------------------+-- | absorb a @MonadError e@ constraint into @Member (Error e) r => Sem r@+absorbMonadRandom :: Member RandomFu r+ => (R.MonadRandom (Sem r) => Sem r a) -> Sem r a+absorbMonadRandom = absorbWithSem @R.MonadRandom @Action+ (RandomDict getRandomPrim)+ (Sub Dict) +{-# INLINEABLE absorbMonadRandom #-}++-- | A dictionary of the functions we need to supply+-- to make an instance of MonadRandom+data RandomDict m = RandomDict { getRandomPrim_ :: forall t. R.Prim t -> m t }++-- | Wrapper for a monadic action with phantom+-- type parameter for reflection.+-- Locally defined so that the instance we are going+-- to build with reflection must be coherent, that is+-- there cannot be orphans.+newtype Action m s' a = Action { action :: m a }+ deriving (Functor, Applicative, Monad)++-- | Given a reifiable mtl Error dictionary,+-- we can make an instance of @MonadError@ for the action+-- wrapped in @Action@.+$(R.monadRandom [d|+ instance ( Monad m+ , Reifies s' (RandomDict m)+ ) => R.MonadRandom (Action m s') where+ getRandomPrim t = Action+ $ getRandomPrim_ (reflect $ Proxy @s') t+ {-# INLINEABLE getRandomPrim #-}+ |])
src/Polysemy/RandomFu.hs view
@@ -1,8 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE UndecidableInstances #-} {-| Module : Polysemy.RandomFu Description : Polysemy random-fu effect@@ -33,18 +29,14 @@ , runRandomSource , runRandomIO , runRandomIOPureMT-- -- * Constraint absorber- , absorbMonadRandom ) where import Polysemy-import Polysemy.MTL+--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(..) )@@ -105,35 +97,3 @@ 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/RandomFuSpec.hs view
@@ -5,6 +5,7 @@ import Polysemy import Polysemy.RandomFu+import Polysemy.ConstraintAbsorber.MonadRandom import Test.Hspec import Control.Monad as M