constrained-monads 0.1.0.0 → 0.2.0.0

raw patch · 2 files changed

+91/−147 lines, 2 filesdep +constraintsPVP ok

version bump matches the API change (PVP)

Dependencies added: constraints

API changes (from Hackage documentation)

Files

• constrained-monads.cabal +2/−1
• src/Control/Monad/Constrained.hs +89/−146

@@ -1,5 +1,5 @@ name:                constrained-monads-version:             0.1.0.0+version:             0.2.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.                      @@ -27,6 +27,7 @@   build-depends:       base >= 4.9 && < 5                      , containers >= 0.5                      , transformers >= 0.5+                     , constraints >= 0.8   default-language:    Haskell2010   ghc-options:         -Wall 

@@ -1,12 +1,14 @@ {-# LANGUAGE ConstraintKinds      #-}-{-# LANGUAGE DataKinds            #-} {-# LANGUAGE BangPatterns         #-}+{-# LANGUAGE DataKinds            #-} {-# LANGUAGE GADTs                #-} {-# LANGUAGE LambdaCase           #-} {-# LANGUAGE RebindableSyntax     #-} {-# LANGUAGE TypeFamilies         #-} {-# LANGUAGE TypeOperators        #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE RankNTypes           #-}  -- | A module for constrained monads. This module is intended to be imported -- with the @-XRebindableSyntax@ extension turned on: everything from the@@ -23,8 +25,8 @@   ,Traversable(..)   ,    -- * Horrible type-level stuff-   Vect(..)-  ,AppVect(..)+  AppVect(..)+  ,FunType   ,liftAP   ,liftAM   ,@@ -81,29 +83,27 @@ import           Control.Monad.Trans.Reader       (ReaderT (..), mapReaderT) import           Control.Monad.Trans.State        (StateT (..)) import qualified Control.Monad.Trans.State.Strict as Strict (StateT (..))-import           Control.Monad.Trans.State.Strict (state, runState)  import           Control.Arrow (first)-import           Data.Tuple (swap)+import           Data.Tuple+import           Control.Monad.Trans.State.Strict (state, runState)  -------------------------------------------------------------------------------- -- Type-level shenanigans -------------------------------------------------------------------------------- --- | A heterogeneous list, for storing the arguments to 'liftA'. (There /has/ to--- be a better way to do this).-infixr 5 :--data Vect xs where-  Nil  :: Vect '[]-  (:-) :: x -> Vect xs -> Vect (x ': xs)---- | Another heterogeneous list, for storing the arguments to 'liftA', wrapped--- in their applicatives.-infixr 5 :*+-- | A heterogeneous snoc list, for storing the arguments to 'liftA',+-- wrapped in their applicatives.+infixl 5 :> data AppVect f xs where-  NilA :: AppVect f '[]-  (:*) :: f x -> AppVect f xs -> AppVect f (x ': xs)+  Nil :: AppVect f '[]+  (:>) :: AppVect f xs -> f x -> AppVect f (x ': xs) +-- | The type of a function for 'liftA'.+type family FunType (xs :: [*]) (y :: *) :: * where+  FunType '[] y = y+  FunType (x ': xs) y = FunType xs (x -> y)+ -------------------------------------------------------------------------------- -- Standard classes --------------------------------------------------------------------------------@@ -214,7 +214,7 @@     pure         :: Suitable f a         => a -> f a-    pure x = liftA (\Nil -> x) NilA+    pure x = liftA x Nil     {-# INLINE pure #-}      infixl 4 <*>@@ -223,7 +223,7 @@     (<*>)         :: Suitable f b         => f (a -> b) -> f a -> f b-    fs <*> xs = liftA (\(f :- x :- Nil) -> f x) (fs :* xs :* NilA)+    fs <*> xs = liftA ($) (Nil :> fs :> xs)     {-# INLINE (<*>) #-}      infixl 4 *>@@ -276,9 +276,8 @@     -- to get do-notation to desugar to using the 'liftA' functions, rather     -- than @('<*>')@.     ---    -- It would also be preferable to avoid the two intermediate structures-    -- ('Vect', 'AppVect', etc). Ideally GHC would optimize them away, but-    -- it seems unlikely.+    -- 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@@ -287,133 +286,55 @@     -- Alternatively, if your applicative is a 'Monad', 'liftA' can be defined     -- in terms of @('>>=')@, which is what 'liftAM' does.     liftA-        :: Suitable f b-        => (Vect xs -> b) -> AppVect f xs -> f b+        :: Suitable f a+        => FunType xs a -> AppVect f xs -> f a      liftA2         :: Suitable f c         => (a -> b -> c) -> f a -> f b -> f c     liftA2 f xs ys =-        liftA-            (\(x :- y :- Nil) ->-                  f x y)-            (xs :* ys :* NilA)+        liftA f (Nil :> xs :> ys)+     liftA3         :: Suitable f d         => (a -> b -> c -> d) -> f a -> f b -> f c -> f d     liftA3 f xs ys zs =-        liftA-            (\(x :- y :- z :- Nil) ->-                  f x y z)-            (xs :* ys :* zs :* NilA)-    liftA4-        :: Suitable f e-        => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e-    liftA4 f ws xs ys zs =-        liftA-            (\(w :- x :- y :- z :- Nil) ->-                  f w x y z)-            (ws :* xs :* ys :* zs :* NilA)-    liftA5-        :: Suitable f g-        => (a -> b -> c -> d -> e -> g)-        -> f a-        -> f b-        -> f c-        -> f d-        -> f e-        -> f g-    liftA5 f vs ws xs ys zs =-        liftA-            (\(v :- w :- x :- y :- z :- Nil) ->-                  f v w x y z)-            (vs :* ws :* xs :* ys :* zs :* NilA)--    liftA6-        :: Suitable f h-        => (a -> b -> c -> d -> e -> g -> h)-        -> f a-        -> f b-        -> f c-        -> f d-        -> f e-        -> f g-        -> f h-    liftA6 f us vs ws xs ys zs =-        liftA-            (\(u :- v :- w :- x :- y :- z :- Nil) ->-                  f u v w x y z)-            (us :* vs :* ws :* xs :* ys :* zs :* NilA)--    liftA7-        :: Suitable f i-        => (a -> b -> c -> d -> e -> g -> h -> i)-        -> f a-        -> f b-        -> f c-        -> f d-        -> f e-        -> f g-        -> f h-        -> f i-    liftA7 f ts us vs ws xs ys zs =-        liftA-            (\(t :- u :- v :- w :- x :- y :- z :- Nil) ->-                  f t u v w x y z)-            (ts :* us :* vs :* ws :* xs :* ys :* zs :* NilA)--    liftA8-        :: Suitable f j-        => (a -> b -> c -> d -> e -> g -> h -> i -> j)-        -> f a-        -> f b-        -> f c-        -> f d-        -> f e-        -> f g-        -> f h-        -> f i-        -> f j-    liftA8 f ss ts us vs ws xs ys zs =-        liftA-            (\(s :- t :- u :- v :- w :- x :- y :- z :- Nil) ->-                  f s t u v w x y z)-            (ss :* ts :* us :* vs :* ws :* xs :* ys :* zs :* NilA)+        liftA f (Nil :> xs :> ys :> zs) -    liftA9-        :: Suitable f k-        => (a -> b -> c -> d -> e -> g -> h -> i -> j -> k)-        -> f a-        -> f b-        -> f c-        -> f d-        -> f e-        -> f g-        -> f h-        -> f i-        -> f j-        -> f k-    liftA9 f rs ss ts us vs ws xs ys zs =-        liftA-            (\(r :- s :- t :- u :- v :- w :- x :- y :- z :- Nil) ->-                  f r s t u v w x y z)-            (rs :* ss :* ts :* us :* vs :* ws :* xs :* ys :* zs :* NilA)+    {-# INLINE liftA2 #-}+    {-# INLINE liftA3 #-}  -- | A variant of '<*>' with the arguments reversed. (<**>) :: (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 'liftA' which uses the "Prelude"'s @('Prelude.<*>')@.-liftAP :: (Prelude.Applicative f) => (Vect xs -> b) -> (AppVect f xs -> f b)-liftAP f NilA = Prelude.pure (f Nil)-liftAP f (x :* NilA) = Prelude.fmap (f . (:-Nil)) x-liftAP f (x :* xs) =  ((f .) . (:-)) Prelude.<$> x Prelude.<*> liftAP id xs+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 'liftA' which uses 's @('>>=')@.-liftAM :: (Monad f, Suitable f b) => (Vect xs -> b) -> (AppVect f xs -> f b)-liftAM f NilA = pure (f Nil)-liftAM f (x :* NilA) = fmap (f . (:-Nil)) x-liftAM f (x :* xs) = x >>= \y -> liftAM (f . (y:-)) xs+{-# INLINE liftA2P #-}+{-# INLINE liftA3P #-}+-- | Definitions for the various lifts using only "Prelude" functions.+liftA2P+    :: (Prelude.Applicative f)+    => (a -> b -> c) -> f a -> f b -> f c+liftA2P f x y = f Prelude.<$> x Prelude.<*> y++liftA3P+    :: Prelude.Applicative f+    => (a -> b -> c -> d) -> f a -> f b -> f c -> f d+liftA3P f xs ys zs = f Prelude.<$> xs Prelude.<*> ys Prelude.<*> zs+ {- | The 'Monad' class defines the basic operations over a /monad/, a concept from a branch of mathematics known as /category theory/. From the perspective of a Haskell programmer, however, it is best to@@ -795,11 +716,13 @@     (<$) = (Prelude.<$)  instance Applicative [] where-  liftA = liftAP-  (<*>) = (Prelude.<*>)-  (*>) = (Prelude.*>)-  (<*) = (Prelude.<*)-  pure = Prelude.pure+    liftA = liftAP+    (<*>) = (Prelude.<*>)+    (*>) = (Prelude.*>)+    (<*) = (Prelude.<*)+    pure = Prelude.pure+    liftA2 = liftA2P+    liftA3 = liftA3P  instance Alternative [] where   empty = []@@ -822,6 +745,8 @@     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)     pure = Prelude.pure+    liftA2 = liftA2P+    liftA3 = liftA3P  instance Alternative Maybe where     empty = Control.Applicative.empty@@ -845,6 +770,8 @@     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)     pure = Prelude.pure+    liftA2 = liftA2P+    liftA3 = liftA3P  instance Alternative IO where     empty = Control.Applicative.empty@@ -864,12 +791,14 @@     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)     pure = Prelude.pure+    liftA2 = liftA2P+    liftA3 = liftA3P  instance Monad Identity where     (>>=) = (Prelude.>>=)  instance Traversable Identity where-  traverse f (Identity x) = fmap Identity (f x)+    traverse f (Identity x) = fmap Identity (f x)  instance Functor (Either e) where     type Suitable (Either e) a = ()@@ -882,6 +811,8 @@     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)     pure = Prelude.pure+    liftA2 = liftA2P+    liftA3 = liftA3P  instance Monad (Either a) where     (>>=) = (Prelude.>>=)@@ -905,8 +836,8 @@     (>>=) = flip foldMap  instance Alternative Set where-  empty = Set.empty-  (<|>) = Set.union+    empty = Set.empty+    (<|>) = Set.union  instance Functor (Map a) where     type Suitable (Map a) b = ()@@ -924,6 +855,8 @@     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)     pure = Prelude.pure+    liftA2 = liftA2P+    liftA3 = liftA3P  instance Monoid a => Monad ((,) a) where     (>>=) = (Prelude.>>=)@@ -947,6 +880,8 @@     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)     pure = Prelude.pure+    liftA2 = liftA2P+    liftA3 = liftA3P  instance Alternative Seq where     empty = Control.Applicative.empty@@ -966,6 +901,8 @@     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)     pure = Prelude.pure+    liftA2 = liftA2P+    liftA3 = liftA3P  instance Monad Tree where     (>>=) = (Prelude.>>=)@@ -981,6 +918,8 @@     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)     pure = Prelude.pure+    liftA2 = liftA2P+    liftA3 = liftA3P  instance Monad ((->) a) where   (>>=) = (Prelude.>>=)@@ -996,6 +935,8 @@     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)     pure = Prelude.pure+    liftA2 = liftA2P+    liftA3 = liftA3P  instance Monad (ContT r m) where     (>>=) = (Prelude.>>=)@@ -1011,6 +952,8 @@     (*>) = (Prelude.*>)     (<*) = (Prelude.<*)     pure = Prelude.pure+    liftA2 = liftA2P+    liftA3 = liftA3P  instance Functor m => Functor (Strict.StateT s m) where     type Suitable (Strict.StateT s m) a = Suitable m (a, s)@@ -1114,10 +1057,10 @@     f <*> v = ReaderT $ \ r -> runReaderT f r <*> runReaderT v r     {-# INLINE (<*>) #-}     liftA f ys = ReaderT $ \r -> liftA f (tr r ys) where-      tr :: Functor m => r -> AppVect (ReaderT r m) xs -> AppVect m xs-      tr _ NilA = NilA-      tr r (xs :* NilA) = runReaderT xs r :* NilA-      tr r (x :* xs) = runReaderT x r :* tr r xs+      tr :: r -> AppVect (ReaderT r m) xs -> AppVect m xs+      tr _ Nil = Nil+      tr r (Nil :> xs) = Nil :> runReaderT xs r+      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) @@ -1146,8 +1089,8 @@   pure x = MaybeT (pure (Just x))   MaybeT fs <*> MaybeT xs = MaybeT (liftA2 (<*>) fs xs)   liftA = liftAM-  MaybeT xs *> MaybeT ys = MaybeT (xs *> ys)-  MaybeT xs <* MaybeT ys = MaybeT (xs <* ys)+  MaybeT xs *> MaybeT ys = MaybeT (liftA2 (*>) xs ys)+  MaybeT xs <* MaybeT ys = MaybeT (liftA2 (<*) xs ys)  instance Monad m => Monad (MaybeT m) where   MaybeT x >>= f = MaybeT (x >>= maybe (pure Nothing) (runMaybeT . f))