constrained-monads 0.2.0.1 → 0.3.0.0

raw patch · 5 files changed

+71/−68 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• constrained-monads.cabal +1/−1
• src/Control/Monad/Constrained.hs +67/−64
• src/Control/Monad/Constrained/IntSet.hs +1/−1
• src/Control/Monad/Constrained/Writer.hs +1/−1
• test/Spec.hs +1/−1

@@ -1,5 +1,5 @@ name:                constrained-monads-version:             0.2.0.1+version:             0.3.0.0 synopsis:            Typeclasses and instances for monads with constraints.  description:         A library for monads with constraints over the types they contain. This allows set, etc to conform to the monad class. It is structured as a prelude replacement: everything that doesn't conflict with the new definitions of 'Functor', 'Monad', etc is reexported.                      

@@ -25,10 +25,9 @@   ,Traversable(..)   ,    -- * Horrible type-level stuff-  AppVect(..)-  ,FunType-  ,liftAP-  ,liftAM+  Free(..)+  ,lowerP+  ,lowerM   ,    -- * Useful functions    guard@@ -92,18 +91,22 @@ -- Type-level shenanigans -------------------------------------------------------------------------------- --- | A heterogeneous snoc list, for storing the arguments to 'liftA',--- wrapped in their applicatives.+-- | A free applicative. Applicative operations are defined in terms of+-- /interpretations/ of this. infixl 5 :>-data AppVect f xs where-  Nil :: AppVect f '[]-  (:>) :: AppVect f xs -> f x -> AppVect f (x ': xs)+data Free f a where+  Pure :: a -> Free f a+  (:>) :: Free f (a -> b) -> f a -> Free f b --- | The type of a function for 'liftA'.-type family FunType (xs :: [*]) (y :: *) :: * where-  FunType '[] y = y-  FunType (x ': xs) y = FunType xs (x -> y)+instance Prelude.Functor (Free f) where+  fmap f (Pure a) = Pure (f a)+  fmap f (x :> y) = ((f .) Prelude.<$> x) :> y +instance Prelude.Applicative (Free f) where+  pure = Pure+  Pure f <*> y = Prelude.fmap f y+  (x :> y) <*> z = (flip Prelude.<$> x Prelude.<*> z) :> y+ -------------------------------------------------------------------------------- -- Standard classes --------------------------------------------------------------------------------@@ -149,7 +152,8 @@     --     -- @instance 'Functor' 'Set' where     --    type 'Suitable' 'Set' a = 'Ord' a-    --    'fmap' = 'Set.map'@+    --    'fmap' = Set.'Set.map'+    --    x '<$' xs = if Set.'Set.null' xs then Set.'Set.empty' else Set.'Set.singleton' x@     type Suitable f a :: Constraint      -- | Maps a function over a functor@@ -169,7 +173,7 @@ -- provided in the Prelude. This is to facilitate the lifting of functions -- to arbitrary numbers of arguments. ----- A minimal complete definition must include implementations of 'liftA'+-- A minimal complete definition must include implementations of 'lower' -- functions satisfying the following laws: -- -- [/identity/]@@ -208,13 +212,13 @@ -- (which implies that 'pure' and '<*>' satisfy the applicative functor laws). class Functor f =>       Applicative f  where-    {-# MINIMAL liftA #-}+    {-# MINIMAL lower #-}      -- | Lift a value.     pure         :: Suitable f a         => a -> f a-    pure x = liftA x Nil+    pure x = lower (Pure x)     {-# INLINE pure #-}      infixl 4 <*>@@ -223,7 +227,7 @@     (<*>)         :: Suitable f b         => f (a -> b) -> f a -> f b-    fs <*> xs = liftA ($) (Nil :> fs :> xs)+    (<*>) = liftA2 ($)     {-# INLINE (<*>) #-}      infixl 4 *>@@ -263,9 +267,9 @@     -- @'liftA2' f xs ys = do     --    x <- xs     --    y <- ys-    --    'pure' (f x)@+    --    'pure' (f x y)@     ---    -- But now we can't define the 'liftA' functions for things which are+    -- But now we can't define the 'lower' functions for things which are     -- 'Applicative' but not 'Monad' (square matrices,     -- 'Control.Applicative.ZipList's, etc). Also, some types have a more     -- efficient @('<*>')@ than @('>>=')@ (see, for instance, the@@ -273,33 +277,33 @@     -- monad).     --     -- The one missing piece is @-XApplicativeDo@: I can't figure out a way-    -- to get do-notation to desugar to using the 'liftA' functions, rather+    -- to get do-notation to desugar to using the 'lower' functions, rather     -- than @('<*>')@.     --     -- From some preliminary performance testing, it seems that this approach     -- has /no/ performance overhead.     --     -- Utility definitions of this function are provided: if your 'Applicative'-    -- is a @Prelude.'Prelude.Applicative'@, 'liftA' can be defined in terms of-    -- @('<*>')@. 'liftAP' does exactly this.+    -- is a @Prelude.'Prelude.Applicative'@, 'lower' can be defined in terms of+    -- @('<*>')@. 'lowerP' does exactly this.     ---    -- Alternatively, if your applicative is a 'Monad', 'liftA' can be defined-    -- in terms of @('>>=')@, which is what 'liftAM' does.-    liftA+    -- Alternatively, if your applicative is a 'Monad', 'lower' can be defined+    -- in terms of @('>>=')@, which is what 'lowerM' does.+    lower         :: Suitable f a-        => FunType xs a -> AppVect f xs -> f a+        => Free f a -> f a      liftA2         :: Suitable f c         => (a -> b -> c) -> f a -> f b -> f c     liftA2 f xs ys =-        liftA f (Nil :> xs :> ys)+        lower (Pure f :> xs :> ys)      liftA3         :: Suitable f d         => (a -> b -> c -> d) -> f a -> f b -> f c -> f d     liftA3 f xs ys zs =-        liftA f (Nil :> xs :> ys :> zs)+        lower (Pure f :> xs :> ys :> zs)      {-# INLINE liftA2 #-}     {-# INLINE liftA3 #-}@@ -308,19 +312,19 @@ (<**>) :: (Applicative f, Suitable f b) => f a -> f (a -> b) -> f b (<**>) = liftA2 (flip ($)) --- | A definition of 'liftA' that uses monadic operations.-liftAM :: (Monad f, Suitable f a) => FunType xs a -> AppVect f xs -> f a-liftAM = go pure where-  go :: (Suitable f b, Monad f) => (a -> f b) -> FunType xs a -> AppVect f xs -> f b-  go f g Nil = f g-  go f g (xs :> x) = go (\c -> x >>= f . c) g xs+-- | A definition of 'lower' that uses monadic operations.+lowerM :: (Monad f, Suitable f a) => Free f a -> f a+lowerM = go pure where+  go :: (Suitable f b, Monad f) => (a -> f b) -> Free f a -> f b+  go f (Pure x) = f x+  go f (xs :> x) = go (\c -> x >>= f . c) xs --- | A definition of 'liftA' which uses the "Prelude"'s @('Prelude.<*>')@.-liftAP :: Prelude.Applicative f => FunType xs a -> AppVect f xs -> f a-liftAP f Nil = Prelude.pure f-liftAP f (Nil :> xs) = Prelude.fmap f xs-liftAP f (ys :> xs) = liftAP f ys Prelude.<*> xs-{-# INLINABLE liftAP #-}+-- | A definition of 'lower' which uses the "Prelude"'s @('Prelude.<*>')@.+lowerP :: Prelude.Applicative f => Free f a -> f a+lowerP (Pure x) = Prelude.pure x+lowerP (Pure f :> xs) = Prelude.fmap f xs+lowerP (ys :> xs) = lowerP ys Prelude.<*> xs+{-# INLINABLE lowerP #-}  {-# INLINE liftA2P #-} {-# INLINE liftA3P #-}@@ -716,7 +720,7 @@     (<$) = (Prelude.<$)  instance Applicative [] where-    liftA = liftAP+    lower = lowerP     (<*>) = (Prelude.<*>)     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)@@ -740,7 +744,7 @@     (<$) = (Prelude.<$)  instance Applicative Maybe where-    liftA = liftAP+    lower = lowerP     (<*>) = (Prelude.<*>)     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)@@ -765,7 +769,7 @@     (<$) = (Prelude.<$)  instance Applicative IO where-    liftA = liftAP+    lower = lowerP     (<*>) = (Prelude.<*>)     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)@@ -786,7 +790,7 @@     (<$) = (Prelude.<$)  instance Applicative Identity where-    liftA = liftAP+    lower = lowerP     (<*>) = (Prelude.<*>)     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)@@ -806,7 +810,7 @@     (<$) = (Prelude.<$)  instance Applicative (Either a) where-    liftA = liftAP+    lower = lowerP     (<*>) = (Prelude.<*>)     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)@@ -830,7 +834,7 @@     fs <*> xs = foldMap (`Set.map` xs) fs     xs *> ys = if null xs then Set.empty else ys     xs <* ys = if null ys then Set.empty else xs-    liftA = liftAM+    lower = lowerM  instance Monad Set where     (>>=) = flip foldMap@@ -850,7 +854,7 @@     (<$) = (Prelude.<$)  instance Monoid a => Applicative ((,) a) where-    liftA = liftAP+    lower = lowerP     (<*>) = (Prelude.<*>)     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)@@ -875,7 +879,7 @@     (<$) = (Prelude.<$)  instance Applicative Seq where-    liftA = liftAP+    lower = lowerP     (<*>) = (Prelude.<*>)     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)@@ -896,7 +900,7 @@     (<$) = (Prelude.<$)  instance Applicative Tree where-    liftA = liftAP+    lower = lowerP     (<*>) = (Prelude.<*>)     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)@@ -913,7 +917,7 @@     (<$) = (Prelude.<$)  instance Applicative ((->) a) where-    liftA = liftAP+    lower = lowerP     (<*>) = (Prelude.<*>)     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)@@ -930,7 +934,7 @@     (<$) = (Prelude.<$)  instance Applicative (ContT r m) where-    liftA = liftAP+    lower = lowerP     (<*>) = (Prelude.<*>)     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)@@ -947,7 +951,7 @@     (<$) = (Prelude.<$)  instance Applicative Control.Applicative.ZipList where-    liftA = liftAP+    lower = lowerP     (<*>) = (Prelude.<*>)     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)@@ -986,7 +990,7 @@             (x,s') <- xs s             (_,s'') <- ys s'             pure (x,s'')-    liftA = liftAM+    lower = lowerM  instance (Monad m, Alternative m) => Alternative (Strict.StateT s m) where     empty = Strict.StateT (const empty)@@ -1031,7 +1035,7 @@             ~(x,s') <- xs s             ~(_,s'') <- ys s'             pure (x,s'')-    liftA = liftAM+    lower = lowerM  instance (Monad m, Alternative m) => Alternative (StateT s m) where     empty = StateT (const empty)@@ -1056,10 +1060,9 @@     {-# INLINE pure #-}     f <*> v = ReaderT $ \ r -> runReaderT f r <*> runReaderT v r     {-# INLINE (<*>) #-}-    liftA f ys = ReaderT $ \r -> liftA f (tr r ys) where-      tr :: r -> AppVect (ReaderT r m) xs -> AppVect m xs-      tr _ Nil = Nil-      tr r (Nil :> xs) = Nil :> runReaderT xs r+    lower ys = ReaderT $ \r -> lower (tr r ys) where+      tr :: r -> Free (ReaderT r m) xs -> Free m xs+      tr _ (Pure x) = Pure x       tr r (xs :> x) = tr r xs :> runReaderT x r     ReaderT xs *> ReaderT ys = ReaderT (\c -> xs c *> ys c)     ReaderT xs <* ReaderT ys = ReaderT (\c -> xs c <* ys c)@@ -1088,7 +1091,7 @@ instance Monad m => Applicative (MaybeT m) where   pure x = MaybeT (pure (Just x))   MaybeT fs <*> MaybeT xs = MaybeT (liftA2 (<*>) fs xs)-  liftA = liftAM+  lower = lowerM   MaybeT xs *> MaybeT ys = MaybeT (liftA2 (*>) xs ys)   MaybeT xs <* MaybeT ys = MaybeT (liftA2 (<*) xs ys) @@ -1110,7 +1113,7 @@          Applicative (ExceptT e m) where     pure x = ExceptT (pure (Right x))     ExceptT fs <*> ExceptT xs = ExceptT (liftA2 (<*>) fs xs)-    liftA = liftAM+    lower = lowerM     ExceptT xs *> ExceptT ys = ExceptT (xs *> ys)     ExceptT xs <* ExceptT ys = ExceptT (xs <* ys) @@ -1137,9 +1140,9 @@     (<*>) =         (coerce :: (f (a -> b) -> f a -> f b) -> IdentityT f (a -> b) -> IdentityT f a -> IdentityT f b)             (<*>)-    liftA f =-        (coerce :: (AppVect f xs -> f b) -> (AppVect (IdentityT f) xs -> IdentityT f b))-            (liftA f)+    lower =+        (coerce :: (Free f xs -> f b) -> (Free (IdentityT f) xs -> IdentityT f b))+            lower     IdentityT xs *> IdentityT ys = IdentityT (xs *> ys)     IdentityT xs <* IdentityT ys = IdentityT (xs <* ys) 

@@ -77,7 +77,7 @@         if null ys             then mempty             else xs-    liftA = liftAM+    lower = lowerM  instance Alternative IntSet where     empty = mempty

@@ -166,7 +166,7 @@     WriterT_ fs <*> WriterT_ xs = WriterT_ (fs <*> xs)     WriterT_ xs *> WriterT_ ys = WriterT_ (xs *> ys)     WriterT_ xs <* WriterT_ ys = WriterT_ (xs <* ys)-    liftA = liftAM+    lower = lowerM  instance Monad m => Monad (WriterT s m) where   WriterT_ xs >>= f = WriterT_ (xs >>= (unWriterT . f))

@@ -33,7 +33,7 @@   (<$) = (Prelude.<$)  instance Applicative Gen where-  liftA = liftAP+  lower = lowerP  instance Monad Gen where   (>>=) = (Prelude.>>=)