monad-choice 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+460/−20 lines, 5 filesdep +contravariantdep +primitivedep ~basedep ~invariantdep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: contravariant, primitive

Dependency ranges changed: base, invariant, mtl, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +42/−0
• monad-choice.cabal +10/−7
• src/Control/Monad/Choice/Random.hs +391/−0
• src/Control/Monad/Class/Choice.hs +16/−12
• src/Control/Monad/Trans/Choice/Covariant.hs +1/−1

@@ -1,5 +1,47 @@ # Changelog +## 0.2.0.0 (2020-03-27)+Fixed broken `MonadChoice` instance for `MonadRandom` types and fixed, expanded, and fine tuned dependency version requirements.++### Additions+- `UniformRandom`+  - Created marker `newtype` `UniformRandom` that provides a `MonadChoice` instance for members of the `MonadRandom` typeclass.+  - Added functions `lift` and `colift` to wrap and unwrap `UniformRandom`, respectively.+  - Added instance for `MonadChoice` using `uniform` from the `MoandRandom` package when the wrapped monad is a member of the `MonadRandom` class.+  - Added various passthrough instances+    - `Functor`+    - `Applicative`+    - `Monad`+    - `MonadRandom`+    - `MonadFix`+    - `MonadFail`+    - `Alternative`+    - `MonadPlus`+    - `MonadIO`+    - `Semigroup`+    - `Monoid`+    - `MonadError`+    - `MonadReader`+    - `MonadState`+    - `Foldable`+    - `Traversable`+    - `Eq1`+    - `Ord1`+    - `MonadZip`+    - `MonadCont`+    - `Eq`+    - `Ord`+    - `MonadRWS`+    - `MonadWriter`+    - `MonadSplit`+    - `PrimMonad`+    - `MonadInterleave`++### Removals+- `MonadChoice`+  - Removed previous instance for members of the `MonadRandom` type class since it overlapped with all other `MonadChoice` instances.+  - Removed passthrough instances for constant space `WriterT` and `RWST` if `transformers` version is less than 0.5.6+ ## 0.1.0.0 (2020-02-29) Inital version 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 6b28c8a7bf1da981f4efd400c5e91cb2a160d9cc56dadee09cad68c0d7d40c6c+-- hash: 34b44d19dedf1fd3d3446c6f2ede560eb2fa06e1617bc9e0ffead649b89b08bf  name:           monad-choice-version:        0.1.0.0+version:        0.2.0.0 synopsis:       Monad, monad transformer, and typeclass representing choices. description:    The Monad Choice library contains monads, monad transformers, and a typeclass representing a sequence of choices of objects of arbitrary types where future choices can depend on previous ones. category:       Control@@ -30,6 +30,7 @@   exposed-modules:       Control.Monad.Choice.Covariant       Control.Monad.Choice.Invariant+      Control.Monad.Choice.Random       Control.Monad.Class.Choice       Control.Monad.Trans.Choice.Covariant       Control.Monad.Trans.Choice.Invariant@@ -37,11 +38,13 @@       Paths_monad_choice   hs-source-dirs:       src-  ghc-options: -Weverything -Wno-implicit-prelude -Wno-safe+  ghc-options: -Weverything -Wno-implicit-prelude -Wno-safe -Wno-unsafe   build-depends:       MonadRandom >=0.5 && <0.6-    , base >=4.7 && <5-    , invariant >=0.1.0 && <0.6-    , mtl >=2.2 && <2.3-    , transformers ==0.5.*+    , base >=4.9 && <5+    , contravariant >=1.4 && <1.6+    , invariant >=0.4 && <0.6+    , mtl >=2.2.1 && <2.3+    , primitive >=0.6.1 && <0.8+    , transformers >=0.5.3 && <0.6   default-language: Haskell2010

@@ -0,0 +1,391 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}++{-|+Module     : Control.Monad.Trans.Choice.Covariant+Copyright  : (c) Eamon Olive, 2020+             (c) Louis Hyde,  2020+License    : AGPL-3+Maintainer : ejolive97@gmail.com+Stability  : experimental++Module for 'UniformRandom', a wrapper that provides an instance of 'MonadChoice' when it wraps a member of 'MonadRandom'.+This is done by using the 'uniform' function as 'choose'.++-}+module Control.Monad.Choice.Random+  ( UniformRandom+    ( UniformRandom+    )+  , lift+  , colift+  )+  where++-- Before 4.10 liftA2 was not a class function of Applicative+import Control.Applicative+  ( Alternative+    ( empty+    , (<|>)+    , some+    , many+    )+#if MIN_VERSION_base(4,10,0)+  , Applicative+    ( liftA2+    )+#endif+  )++import Control.Monad+  ( MonadPlus+    ( mzero+    , mplus+    )+  )+import Control.Monad.Class.Choice+  ( MonadChoice+    ( choose+    )+  )+import Control.Monad.Cont.Class+  ( MonadCont+    ( callCC+    )+  )+import Control.Monad.Error.Class+  ( MonadError+    ( throwError+    , catchError+    )+  )+import qualified Control.Monad.Fail as Fail+  ( MonadFail+    ( fail+    )+  )+import Control.Monad.Fix+  ( MonadFix+    ( mfix+    )+  )+import Control.Monad.IO.Class+  ( MonadIO+    ( liftIO+    )+  )+import Control.Monad.Primitive+  ( PrimMonad+    ( PrimState+    , primitive+    )+  )+import Control.Monad.Random.Class+  ( MonadRandom+    ( getRandomR+    , getRandom+    , getRandomRs+    , getRandoms+    )+  , MonadSplit+    ( getSplit+    )+  , MonadInterleave+    ( interleave+    )+  , uniform+  )+import Control.Monad.Reader.Class+  ( MonadReader+    ( ask+    , local+    , reader+    )+  )+import Control.Monad.RWS.Class+  ( MonadRWS+  )+import Control.Monad.State.Class+  ( MonadState+    ( get+    , put+    , state+    )+  )+import Control.Monad.Writer.Class+  ( MonadWriter+    ( writer+    , tell+    , listen+    , pass+    )+  )+import Control.Monad.Zip+  ( MonadZip+    ( mzip+    , mzipWith+    , munzip+    )+  )++import Data.Foldable+  ( Foldable+    ( fold+    , foldr'+    , foldl'+    , toList+    )+  )+import Data.Functor.Classes+  ( Eq1+    ( liftEq+    )+  , Ord1+    ( liftCompare+    )+  )+#if !MIN_VERSION_base(4,13,0)+import Data.Semigroup+  ( Semigroup+    ( (<>)+    )+  )+#endif++newtype UniformRandom r a+  = UniformRandom+    { runUniformRandom :: r a+    }++-- | An alias for 'UniformRandom'+lift :: r a -> UniformRandom r a+lift = UniformRandom+{-# INLINE lift #-}++-- | A function to unwrap a 'UniformRandom'+colift :: UniformRandom r a -> r a+colift = runUniformRandom+{-# INLINE colift #-}++-- | Convenience function for writing instances+lift2 :: (r a -> s b -> t c) -> UniformRandom r a -> UniformRandom s b -> UniformRandom t c+lift2 = (((lift .) . (. colift)) .) . (. colift)+{-# INLINE lift2 #-}++instance Functor f => Functor (UniformRandom f) where+  fmap = (lift .) . (. colift) . fmap+  {-# INLINE fmap #-}++instance Applicative f => Applicative (UniformRandom f) where+  pure = lift . pure+  {-# INLINE pure #-}+  (<*>) = lift2 (<*>)+  {-# INLINE (<*>) #-}+#if MIN_VERSION_base(4,10,0)+  liftA2 = lift2 . liftA2+  {-# INLINE liftA2 #-}+#endif+  (*>) = lift2 (*>)+  {-# INLINE (*>) #-}+  (<*) = lift2 (<*)+  {-# INLINE (<*) #-}++instance Monad m => Monad (UniformRandom m) where+  (>>=) = (lift .) . (. (colift .)) . (>>=) . colift+  {-# INLINE (>>=) #-}++instance (Foldable f, MonadRandom m) => MonadChoice f (UniformRandom m) where+  choose = lift . uniform+  {-# INLINE choose #-}++instance MonadRandom m => MonadRandom (UniformRandom m) where+  getRandomR = lift . getRandomR+  {-# INLINE getRandomR #-}+  getRandom = lift getRandom+  {-# INLINE getRandom #-}+  getRandomRs = lift . getRandomRs+  {-# INLINE getRandomRs #-}+  getRandoms = lift getRandoms+  {-# INLINE getRandoms #-}++instance MonadFix m => MonadFix (UniformRandom m) where+  mfix = lift . mfix . (colift .)+  {-# INLINE mfix #-}++instance Fail.MonadFail m => Fail.MonadFail (UniformRandom m) where+  fail = lift . Fail.fail+  {-# INLINE fail #-}++instance Alternative f => Alternative (UniformRandom f) where+  empty = lift empty+  {-# INLINE empty #-}+  (<|>) = lift2 (<|>)+  {-# INLINE (<|>) #-}+  some = lift . some . colift+  {-# INLINE some #-}+  many = lift . many . colift+  {-# INLINE many #-}++instance MonadPlus m => MonadPlus (UniformRandom m) where+  mzero = lift mzero+  {-# INLINE mzero #-}+  mplus = lift2 mplus+  {-# INLINE mplus #-}++instance MonadIO m => MonadIO (UniformRandom m) where+  liftIO = lift . liftIO+  {-# INLINE liftIO #-}++instance Semigroup (r a) => Semigroup (UniformRandom r a) where+  (<>) = lift2 (<>)+  {-# INLINE (<>) #-}++instance+  ( Monoid (r a)+#if !MIN_VERSION_base(4,11,0)+  , Semigroup (r a)+#endif+  )+    => Monoid (UniformRandom r a)+  where+    mempty = lift mempty+    {-# INLINE mempty #-}+    mappend = (<>)+    {-# INLINE mappend #-}++instance MonadError e m => MonadError e (UniformRandom m) where+  throwError = lift . throwError+  {-# INLINE throwError #-}+  catchError = (. (colift .)) . (lift .) . catchError . colift+  {-# INLINE catchError #-}++instance MonadReader r m => MonadReader r (UniformRandom m) where+  ask = lift ask+  {-# INLINE ask #-}+  local = (lift .) . (. colift) . local+  {-# INLINE local #-}+  reader = lift . reader+  {-# INLINE reader #-}++instance MonadState s m => MonadState s (UniformRandom m) where+  get = lift get+  {-# INLINE get #-}+  put = lift . put+  {-# INLINE put #-}+  state = lift . state+  {-# INLINE state #-}++instance Foldable f => Foldable (UniformRandom f) where+  fold = fold . colift+  {-# INLINE fold #-}+  foldMap = (. colift) . foldMap+  {-# INLINE foldMap #-}+  foldr = ((. colift) .) . foldr+  {-# INLINE foldr #-}+  foldr' = ((. colift) .) . foldr'+  {-# INLINE foldr' #-}+  foldl = ((. colift) .) . foldl+  {-# INLINE foldl #-}+  foldl' = ((. colift) .) . foldl'+  {-# INLINE foldl' #-}+  foldr1 = (. colift) . foldr1+  {-# INLINE foldr1 #-}+  foldl1 = (. colift) . foldl1+  {-# INLINE foldl1 #-}+  toList = toList . colift+  {-# INLINE toList #-}+  null = null . colift+  {-# INLINE null #-}+  length = length . colift+  {-# INLINE length #-}+  elem = (. colift) . elem+  {-# INLINE elem #-}+  maximum = maximum . colift+  {-# INLINE maximum #-}+  minimum = minimum . colift+  {-# INLINE minimum #-}+  sum = sum . colift+  {-# INLINE sum #-}+  product = product . colift+  {-# INLINE product #-}++instance Traversable t => Traversable (UniformRandom t) where+  traverse = (fmap lift .) . (. colift) . traverse+  {-# INLINE traverse #-}+  sequenceA = fmap lift . sequenceA . colift+  {-# INLINE sequenceA #-}+  mapM = (fmap lift .) . (. colift) . mapM+  {-# INLINE mapM #-}+  sequence = fmap lift . sequence . colift+  {-# INLINE sequence #-}++instance Eq1 f => Eq1 (UniformRandom f) where+  liftEq = ((. colift) .) . (. colift) . liftEq+  {-# INLINE liftEq #-}++instance Ord1 f => Ord1 (UniformRandom f) where+  liftCompare = ((. colift) .) . (. colift) . liftCompare+  {-# INLINE liftCompare #-}++instance MonadZip m => MonadZip (UniformRandom m) where+  mzip = lift2 mzip+  {-# INLINE mzip #-}+  mzipWith = lift2 . mzipWith+  {-# INLINE mzipWith #-}+  munzip = (\(m1,m2) -> (lift m1, lift m2)) . munzip . colift+  {-# INLINE munzip #-}++instance MonadCont m => MonadCont (UniformRandom m) where+  callCC = lift . callCC . (colift .) . (. (lift .))+  {-# INLINE callCC #-}++instance Eq (r a) => Eq (UniformRandom r a) where+  (==) = (. colift) . (==) . colift+  {-# INLINE (==) #-}+  (/=) = (. colift) . (/=) . colift+  {-# INLINE (/=) #-}++instance Ord (r a) => Ord (UniformRandom r a) where+  compare = (. colift) . compare . colift+  {-# INLINE compare #-}+  (<) = (. colift) . (<) . colift+  {-# INLINE (<) #-}+  (<=) = (. colift) . (<=) . colift+  {-# INLINE (<=) #-}+  (>) = (. colift) . (>) . colift+  {-# INLINE (>) #-}+  (>=) = (. colift) . (>=) . colift+  {-# INLINE (>=) #-}+  max = lift2 max+  {-# INLINE max #-}+  min = lift2 min+  {-# INLINE min #-}++instance MonadRWS r w s m => MonadRWS r w s (UniformRandom m)++instance MonadWriter w m => MonadWriter w (UniformRandom m) where+  writer = lift . writer+  {-# INLINE writer #-}+  tell = lift . tell+  {-# INLINE tell #-}+  listen = lift . listen . colift+  {-# INLINE listen #-}+  pass = lift . pass . colift+  {-# INLINE pass #-}++instance MonadSplit g m => MonadSplit g (UniformRandom m) where+  getSplit = lift getSplit+  {-# INLINE getSplit #-}++instance PrimMonad m => PrimMonad (UniformRandom m) where+  type PrimState (UniformRandom m) = PrimState m++  primitive = lift . primitive+  {-# INLINE primitive #-}++instance MonadInterleave m => MonadInterleave (UniformRandom m) where+  interleave = lift . interleave . colift+  {-# INLINE interleave #-}

@@ -1,5 +1,6 @@-{-# Language MultiParamTypeClasses #-}-{-# Language FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-}  {-| Module     : Control.Monad.Class.Choice@@ -19,10 +20,6 @@ import Control.Monad   ( join   )-import Control.Monad.Random.Class-  ( MonadRandom-  , uniform-  ) import Control.Monad.Trans   ( lift   )@@ -44,9 +41,11 @@ import Control.Monad.Trans.Reader   ( ReaderT   )+#if MIN_VERSION_transformers(0,5,6) import Control.Monad.Trans.RWS.CPS as RWS.CPS   ( RWST   )+#endif import Control.Monad.Trans.RWS.Lazy as RWS.Lazy   ( RWST   )@@ -62,9 +61,11 @@ import Control.Monad.Trans.State.Strict as State.Strict   ( StateT   )+#if MIN_VERSION_transformers(0,5,6) import Control.Monad.Trans.Writer.CPS as Writer.CPS   ( WriterT   )+#endif import Control.Monad.Trans.Writer.Lazy as Writer.Lazy   ( WriterT   )@@ -79,9 +80,9 @@ -- -- > berry :: MonadChoice NonEmpty m => m String -- > berry = do--- >   color  <- choose $ "red" :| ["blue", "pink", "cyan"]--- >   prefix <- choose $ "color" :| ["straw", "rasp", "cran"]--- >   return $ prefix ++ "berry"+-- >   berryColor  <- choose $ "red"   :| ["blue", "orange", "yellow", "black"]+-- >   berryFlavor <- choose $ "sweet" :| ["sour", "bitter"]+-- >   (++ "berry") <$> choose ( berryColor :| [berryFlavor, berryColor ++ "-" ++ berryFlavor] ) -- -- Since this has a polymorphic type this could be used for a variety of purposes. class Monad m => MonadChoice f m where@@ -95,9 +96,6 @@     => f (m a) -> m a chooseM = join . choose -instance (Foldable f, MonadRandom m) => MonadChoice f m where-  choose = uniform- instance MonadChoice f m => MonadChoice f (MaybeT m) where   choose = lift . choose  @@ -116,8 +114,11 @@ instance MonadChoice f m => MonadChoice f (ReaderT r m) where   choose = lift . choose +#if MIN_VERSION_transformers(0,5,6)+-- | @since 0.5.6 instance MonadChoice f m => MonadChoice f (Writer.CPS.WriterT w m) where   choose = lift . choose+#endif  instance (Monoid w, MonadChoice f m) => MonadChoice f (Writer.Lazy.WriterT w m) where   choose = lift . choose@@ -137,8 +138,11 @@ instance (Monoid w, MonadChoice f m) => MonadChoice f (RWS.Strict.RWST r w s m) where   choose = lift . choose +#if MIN_VERSION_transformers(0,5,6)+-- | @since 0.5.6 instance MonadChoice f m => MonadChoice f (RWS.CPS.RWST r w s m) where   choose = lift . choose+#endif  instance MonadChoice f m => MonadChoice f (SelectT r m) where   choose = lift . choose

@@ -119,7 +119,7 @@     where       go :: w -> ChoiceT f m (a, w -> w) -> ChoiceT f m a       go acc (FixedT (value, f)) = writer (value, f acc)-      go acc (LiftThenT action next) = LiftThenT (listen action) (\(a,w)-> go (acc <> w) $ next a)+      go acc (LiftThenT action next) = LiftThenT (listen action) (\(a,w)-> go (mappend acc w) $ next a)       go acc (ChooseThenT options next) = ChooseThenT options $ go acc . next  instance MonadRWS r w s m => MonadRWS  r w s (ChoiceT f m)