commit ghc-free for openSUSE:Factory
singleOutAll :: [a] -> [(Maybe a,[a])] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/free.cabal new/free-4.12.4/free.cabal --- old/free-4.12.1/free.cabal 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/free.cabal 2016-01-17 03:15:13.000000000 +0100 @@ -1,6 +1,6 @@ name: free category: Control, Monads -version: 4.12.1 +version: 4.12.4
Hello community, here is the log from the commit of package ghc-free for openSUSE:Factory checked in at 2016-01-21 23:43:38 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-free (Old) and /work/SRC/openSUSE:Factory/.ghc-free.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-free" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-free/ghc-free.changes 2015-08-27 08:55:30.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-free.new/ghc-free.changes 2016-01-22 01:08:49.000000000 +0100 @@ -1,0 +2,10 @@ +Mon Jan 18 10:33:25 UTC 2016 - mimi.vx@gmail.com + +- update to 4.12.4 +* Add instances for ExceptT: like ErrorT, but without an Error constraint. +* Support containers +* Support transformers 0.5 +* Removed a number of spurious class constraints. +* Support comonad 5 + +------------------------------------------------------------------- Old: ---- free-4.12.1.tar.gz New: ---- free-4.12.4.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-free.spec ++++++ --- /var/tmp/diff_new_pack.kNrhli/_old 2016-01-22 01:08:51.000000000 +0100 +++ /var/tmp/diff_new_pack.kNrhli/_new 2016-01-22 01:08:51.000000000 +0100 @@ -18,7 +18,7 @@ %global pkg_name free Name: ghc-free -Version: 4.12.1 +Version: 4.12.4 Release: 0 Summary: Monads for free Group: System/Libraries @@ -33,6 +33,7 @@ # Begin cabal-rpm deps: BuildRequires: ghc-bifunctors-devel BuildRequires: ghc-comonad-devel +BuildRequires: ghc-containers-devel BuildRequires: ghc-distributive-devel BuildRequires: ghc-exceptions-devel BuildRequires: ghc-mtl-devel ++++++ free-4.12.1.tar.gz -> free-4.12.4.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/.travis.yml new/free-4.12.4/.travis.yml --- old/free-4.12.1/.travis.yml 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/.travis.yml 2016-01-17 03:15:13.000000000 +0100 @@ -1,13 +1,14 @@ env: - - GHCVER=7.4.2 CABALVER=1.16 - - GHCVER=7.6.3 CABALVER=1.16 + - GHCVER=7.4.2 CABALVER=1.18 + - GHCVER=7.6.3 CABALVER=1.18 - GHCVER=7.8.4 CABALVER=1.18 - - GHCVER=7.10.1 CABALVER=1.22 - - GHCVER=head CABALVER=1.22 + - GHCVER=7.10.2 CABALVER=1.22 + - GHCVER=8.0.1 CABALVER=1.24 + - GHCVER=head CABALVER=1.24 matrix: allow_failures: - - env: GHCVER=head CABALVER=1.22 + - env: GHCVER=head CABALVER=1.24 before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/CHANGELOG.markdown new/free-4.12.4/CHANGELOG.markdown --- old/free-4.12.1/CHANGELOG.markdown 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/CHANGELOG.markdown 2016-01-17 03:15:13.000000000 +0100 @@ -1,3 +1,19 @@ +4.12.4 +------ +* Removed a number of spurious class constraints. +* Support GHC 8 + +4.12.3 +------ +* Support `comonad` 5 + +4.12.2 +------ +* Add instances for `ExceptT`: like `ErrorT`, but without an `Error` constraint. +* Support `containers` +* Support `transformers` 0.5 + + 4.12.1 ------ * Support GHC 7.4 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/README.markdown new/free-4.12.4/README.markdown --- old/free-4.12.1/README.markdown 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/README.markdown 2016-01-17 03:15:13.000000000 +0100 @@ -1,7 +1,7 @@ free ==== -[![Build Status](https://secure.travis-ci.org/ekmett/free.png?branch=master)](http://travis-ci.org/ekmett/free) +[![Hackage](https://img.shields.io/hackage/v/free.svg)](https://hackage.haskell.org/package/free) [![Build Status](https://secure.travis-ci.org/ekmett/free.png?branch=master)](http://travis-ci.org/ekmett/free) This package provides a common definitions for working with free monads, free applicatives, and cofree comonads in Haskell. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/examples/Cabbage.lhs new/free-4.12.4/examples/Cabbage.lhs --- old/free-4.12.1/examples/Cabbage.lhs 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/examples/Cabbage.lhs 2016-01-17 03:15:13.000000000 +0100 @@ -43,7 +43,7 @@ @ *Cabbage> singleOut1 (== Sheep) [Wolf, Sheep, Cabbage] -[(Just Wolf,[Sheep,Cabbage]),(Just Sheep,[Wolf,Cabbage]),(Just Cabbage,[Wolf,Sheep]),(Nothing,[Wolf,Sheep,Cabbage])] +(Just Sheep,[Wolf,Cabbage]) @ license: BSD3 cabal-version: >= 1.10 license-file: LICENSE @@ -69,16 +69,18 @@ build-depends: base == 4.*, bifunctors >= 4 && < 6, - comonad == 4.*, + comonad >= 4 && < 6, distributive >= 0.2.1, mtl >= 2.0.1.0 && < 2.3, prelude-extras >= 0.4 && < 1, profunctors >= 4 && < 6, semigroupoids >= 4 && < 6, semigroups >= 0.8.3.1 && < 1, - transformers >= 0.2.0 && < 0.5, + transformers >= 0.2.0 && < 0.6, + transformers-compat >= 0.3 && < 1, template-haskell >= 2.7.0.0 && < 3, - exceptions >= 0.6 && < 0.9 + exceptions >= 0.6 && < 0.9, + containers < 0.6 exposed-modules: Control.Applicative.Free diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/src/Control/Alternative/Free.hs new/free-4.12.4/src/Control/Alternative/Free.hs --- old/free-4.12.1/src/Control/Alternative/Free.hs 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/src/Control/Alternative/Free.hs 2016-01-17 03:15:13.000000000 +0100 @@ -69,7 +69,7 @@ (Alt xs) <*> ys = Alt (xs >>= alternatives . (`ap'` ys)) where - ap' :: (Functor f) => AltF f (a -> b) -> Alt f a -> Alt f b + ap' :: AltF f (a -> b) -> Alt f a -> Alt f b Pure f `ap'` u = fmap f u (u `Ap` f) `ap'` v = Alt [u `Ap` (flip <$> f) <*> v] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/src/Control/Comonad/Cofree/Class.hs new/free-4.12.4/src/Control/Comonad/Cofree/Class.hs --- old/free-4.12.1/src/Control/Comonad/Cofree/Class.hs 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/src/Control/Comonad/Cofree/Class.hs 2016-01-17 03:15:13.000000000 +0100 @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} @@ -23,7 +24,10 @@ import Control.Comonad.Trans.Traced import Control.Comonad.Trans.Identity import Data.List.NonEmpty -import Data.Semigroup +import Data.Tree +#if __GLASGOW_HASKELL__ < 710 +import Data.Monoid +#endif -- | Allows you to peel a layer off a cofree comonad. class (Functor f, Comonad w) => ComonadCofree f w | w -> f where @@ -34,6 +38,9 @@ unwrap (_ :| []) = Nothing unwrap (_ :| (a : as)) = Just (a :| as) +instance ComonadCofree [] Tree where + unwrap = subForest + instance ComonadCofree (Const b) ((,) b) where unwrap = Const . fst @@ -46,5 +53,5 @@ instance ComonadCofree f w => ComonadCofree f (StoreT s w) where unwrap (StoreT wsa s) = flip StoreT s <$> unwrap wsa -instance (ComonadCofree f w, Semigroup m, Monoid m) => ComonadCofree f (TracedT m w) where +instance (ComonadCofree f w, Monoid m) => ComonadCofree f (TracedT m w) where unwrap (TracedT wma) = TracedT <$> unwrap wma diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/src/Control/Comonad/Cofree.hs new/free-4.12.4/src/Control/Comonad/Cofree.hs --- old/free-4.12.1/src/Control/Comonad/Cofree.hs 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/src/Control/Comonad/Cofree.hs 2016-01-17 03:15:13.000000000 +0100 @@ -25,6 +25,7 @@ , ComonadCofree(..) , section , coiter + , coiterW , unfold , unfoldM , hoistCofree @@ -41,6 +42,7 @@ import Control.Comonad.Env.Class import Control.Comonad.Store.Class as Class import Control.Comonad.Traced.Class +import Control.Comonad.Hoist.Class import Control.Category import Control.Monad(ap, (>=>), liftM) import Control.Monad.Zip @@ -64,7 +66,7 @@ -- /Formally/ -- -- A 'Comonad' @v@ is a cofree 'Comonad' for @f@ if every comonad homomorphism --- another comonad @w@ to @v@ is equivalent to a natural transformation +-- from another comonad @w@ to @v@ is equivalent to a natural transformation -- from @w@ to @f@. -- -- A 'cofree' functor is right adjoint to a forgetful functor. @@ -110,6 +112,10 @@ coiter :: Functor f => (a -> f a) -> a -> Cofree f a coiter psi a = a :< (coiter psi <$> psi a) +-- | Like coiter for comonadic values. +coiterW :: (Comonad w, Functor f) => (w a -> f (w a)) -> w a -> Cofree f a +coiterW psi a = extract a :< (coiterW psi <$> psi a) + -- | Unfold a cofree comonad from a seed. unfold :: Functor f => (b -> (a, f b)) -> b -> Cofree f a unfold f c = case f c of @@ -151,7 +157,7 @@ {-# INLINE lower #-} instance Alternative f => Monad (Cofree f) where - return x = x :< empty + return = pure {-# INLINE return #-} (a :< m) >>= k = case k a of b :< n -> b :< (n <|> fmap (>>= k) m) @@ -182,7 +188,7 @@ {-# INLINE (@>) #-} instance Alternative f => Applicative (Cofree f) where - pure = return + pure x = x :< empty {-# INLINE pure #-} (<*>) = ap {-# INLINE (<*>) #-} @@ -235,6 +241,10 @@ foldMap f = go where go (a :< as) = f a `mappend` foldMap go as {-# INLINE foldMap #-} +#if __GLASGOW_HASKELL__ >= 709 + length = go 0 where + go s (_ :< as) = foldl' go (s + 1) as +#endif instance Foldable1 f => Foldable1 (Cofree f) where foldMap1 f = go where @@ -291,6 +301,9 @@ {-# NOINLINE cofreeDataType #-} #endif +instance ComonadHoist Cofree where + cohoist = hoistCofree + instance ComonadEnv e w => ComonadEnv e (Cofree w) where ask = ask . lower {-# INLINE ask #-} @@ -331,12 +344,24 @@ _unwrap f (a :< as) = (a :<) <$> f as {-# INLINE _unwrap #-} --- | Construct a @Lens@ into a @'Cofree' f@ given a list of lenses into the base functor. +-- | Construct an @Lens@ into a @'Cofree' g@ given a list of lenses into the base functor. +-- When the input list is empty, this is equivalent to '_extract'. +-- When the input list is non-empty, this composes the input lenses +-- with '_unwrap' to walk through the @'Cofree' g@ before using +-- '_extract' to get the element at the final location. -- -- For more on lenses see the 'lens' package on hackage. -- --- @telescoped :: 'Functor' g => [Lens' ('Cofree' g a) (g ('Cofree' g a))] -> Lens' ('Cofree' g a) a@ -telescoped :: (Functor f, Functor g) => +-- @telescoped :: [Lens' (g ('Cofree' g a)) ('Cofree' g a)] -> Lens' ('Cofree' g a) a@ +-- +-- @telescoped :: [Traversal' (g ('Cofree' g a)) ('Cofree' g a)] -> Traversal' ('Cofree' g a) a@ +-- +-- @telescoped :: [Getter (g ('Cofree' g a)) ('Cofree' g a)] -> Getter ('Cofree' g a) a@ +-- +-- @telescoped :: [Fold (g ('Cofree' g a)) ('Cofree' g a)] -> Fold ('Cofree' g a) a@ +-- +-- @telescoped :: [Setter' (g ('Cofree' g a)) ('Cofree' g a)] -> Setter' ('Cofree' g a) a@ +telescoped :: Functor f => [(Cofree g a -> f (Cofree g a)) -> g (Cofree g a) -> f (g (Cofree g a))] -> (a -> f a) -> Cofree g a -> f (Cofree g a) telescoped = Prelude.foldr (\l r -> _unwrap . l . r) _extract diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/src/Control/Comonad/Trans/Cofree.hs new/free-4.12.4/src/Control/Comonad/Trans/Cofree.hs --- old/free-4.12.1/src/Control/Comonad/Trans/Cofree.hs 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/src/Control/Comonad/Trans/Cofree.hs 2016-01-17 03:15:13.000000000 +0100 @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Rank2Types #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DeriveDataTypeable #-} #endif @@ -26,6 +27,7 @@ , ComonadCofree(..) , headF , tailF + , transCofreeT , coiterT ) where @@ -33,6 +35,8 @@ import Control.Comonad import Control.Comonad.Trans.Class import Control.Comonad.Cofree.Class +import Control.Comonad.Env.Class +import Control.Comonad.Hoist.Class import Control.Category import Data.Bifunctor import Data.Bifoldable @@ -83,6 +87,10 @@ instance Traversable f => Bitraversable (CofreeF f) where bitraverse f g (a :< as) = (:<) <$> f a <*> traverse g as +transCofreeF :: (forall x. f x -> g x) -> CofreeF f a b -> CofreeF g a b +transCofreeF t (a :< fb) = a :< t fb +{-# INLINE transCofreeF #-} + -- | This is a cofree comonad of some functor @f@, with a comonad @w@ threaded through it at each level. newtype CofreeT f w a = CofreeT { runCofreeT :: w (CofreeF f a (CofreeT f w a)) } #if __GLASGOW_HASKELL__ >= 707 @@ -132,12 +140,19 @@ instance (Traversable f, Traversable w) => Traversable (CofreeT f w) where traverse f = fmap CofreeT . traverse (bitraverse f (traverse f)) . runCofreeT -instance Functor f => ComonadTrans (CofreeT f) where +instance ComonadTrans (CofreeT f) where lower = fmap headF . runCofreeT instance (Functor f, Comonad w) => ComonadCofree f (CofreeT f w) where unwrap = tailF . extract . runCofreeT +instance (Functor f, ComonadEnv e w) => ComonadEnv e (CofreeT f w) where + ask = ask . lower + {-# INLINE ask #-} + +instance Functor f => ComonadHoist (CofreeT f) where + cohoist g = CofreeT . fmap (second (cohoist g)) . g . runCofreeT + instance Show (w (CofreeF f a (CofreeT f w a))) => Show (CofreeT f w a) where showsPrec d (CofreeT w) = showParen (d > 10) $ showString "CofreeT " . showsPrec 11 w @@ -153,8 +168,10 @@ compare (CofreeT a) (CofreeT b) = compare a b instance (Alternative f, Monad w) => Monad (CofreeT f w) where +#if __GLASGOW_HASKELL__ < 710 return = CofreeT . return . (:< empty) {-# INLINE return #-} +#endif CofreeT cx >>= f = CofreeT $ do a :< m <- cx b :< n <- runCofreeT $ f a @@ -177,6 +194,10 @@ (a :< fa, b :< fb) <- mzip ma mb return $ (a, b) :< (uncurry mzip <$> mzip fa fb) +-- | Lift a natural transformation from @f@ to @g@ into a comonad homomorphism from @'CofreeT' f w@ to @'CofreeT' g w@ +transCofreeT :: (Functor g, Comonad w) => (forall x. f x -> g x) -> CofreeT f w a -> CofreeT g w a +transCofreeT t = CofreeT . liftW (fmap (transCofreeT t) . transCofreeF t) . runCofreeT + -- | Unfold a @CofreeT@ comonad transformer from a coalgebra and an initial comonad. coiterT :: (Functor f, Comonad w) => (w a -> f (w a)) -> w a -> CofreeT f w a coiterT psi = CofreeT . extend (\w -> extract w :< fmap (coiterT psi) (psi w)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/src/Control/Monad/Free/Church.hs new/free-4.12.4/src/Control/Monad/Free/Church.hs --- old/free-4.12.1/src/Control/Monad/Free/Church.hs 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/src/Control/Monad/Free/Church.hs 2016-01-17 03:15:13.000000000 +0100 @@ -56,6 +56,7 @@ ( F(..) , improve , fromF + , iter , iterM , toF , retract @@ -69,7 +70,7 @@ import Control.Applicative import Control.Monad as Monad import Control.Monad.Fix -import Control.Monad.Free hiding (retract, iterM, cutoff) +import Control.Monad.Free hiding (retract, iter, iterM, cutoff) import qualified Control.Monad.Free as Free import Control.Monad.Reader.Class import Control.Monad.Writer.Class @@ -87,8 +88,12 @@ -- http://comonad.com/reader/2011/free-monads-for-less-2/ newtype F f a = F { runF :: forall r. (a -> r) -> (f r -> r) -> r } +-- | Tear down a 'Free' 'Monad' using iteration. +iter :: (f a -> a) -> F f a -> a +iter phi xs = runF xs id phi + -- | Like iter for monadic values. -iterM :: (Monad m, Functor f) => (f (m a) -> m a) -> F f a -> m a +iterM :: Monad m => (f (m a) -> m a) -> F f a -> m a iterM phi xs = runF xs return phi instance Functor (F f) where @@ -110,7 +115,7 @@ (>>-) = (>>=) instance Monad (F f) where - return a = F (\kp _ -> kp a) + return = pure F m >>= f = F (\kp kf -> m (\a -> runF (f a) kp kf) kf) instance MonadFix (F f) where @@ -118,7 +123,7 @@ a = f (impure a) impure (F x) = x id (error "MonadFix (F f): wrap") -instance (Foldable f, Functor f) => Foldable (F f) where +instance Foldable f => Foldable (F f) where foldr f r xs = runF xs f (foldr (.) id) r {-# INLINE foldr #-} @@ -169,7 +174,7 @@ hoistF :: (forall x. f x -> g x) -> F f a -> F g a hoistF t (F m) = F (\p f -> m p (f . t)) --- | The very definition of a free monoid is that given a natural transformation you get a monoid homomorphism. +-- | The very definition of a free monad is that given a natural transformation you get a monad homomorphism. foldF :: Monad m => (forall x. f x -> m x) -> F f a -> m a foldF f (F m) = m return (Monad.join . f) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/src/Control/Monad/Free/Class.hs new/free-4.12.4/src/Control/Monad/Free/Class.hs --- old/free-4.12.1/src/Control/Monad/Free/Class.hs 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/src/Control/Monad/Free/Class.hs 2016-01-17 03:15:13.000000000 +0100 @@ -43,6 +43,7 @@ import Control.Monad.Trans.Maybe import Control.Monad.Trans.List import Control.Monad.Trans.Error +import Control.Monad.Trans.Except import Control.Monad.Trans.Identity #if !(MIN_VERSION_base(4,8,0)) @@ -144,6 +145,9 @@ instance (Functor f, MonadFree f m, Error e) => MonadFree f (ErrorT e m) where wrap = ErrorT . wrap . fmap runErrorT +instance (Functor f, MonadFree f m) => MonadFree f (ExceptT e m) where + wrap = ExceptT . wrap . fmap runExceptT + -- instance (Functor f, MonadFree f m) => MonadFree f (EitherT e m) where -- wrap = EitherT . wrap . fmap runEitherT diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/src/Control/Monad/Free/TH.hs new/free-4.12.4/src/Control/Monad/Free/TH.hs --- old/free-4.12.1/src/Control/Monad/Free/TH.hs 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/src/Control/Monad/Free/TH.hs 2016-01-17 03:15:13.000000000 +0100 @@ -189,13 +189,18 @@ RecC cName fields -> liftCon' typeSig ts cx f n ns cName $ map (\(_, _, ty) -> ty) fields InfixC (_,t1) cName (_,t2) -> liftCon' typeSig ts cx f n ns cName [t1, t2] ForallC ts' cx' con' -> liftCon typeSig (ts ++ ts') (cx ++ cx') f n ns con' + _ -> fail "Unsupported constructor type" -- | Provide free monadic actions for a type declaration. liftDec :: Bool -- ^ Include type signature? -> Maybe [Name] -- ^ Include only mentioned constructor names. Use all constructors when @Nothing@. -> Dec -- ^ Data type declaration. -> Q [Dec] +#if MIN_VERSION_template_haskell(2,11,0) +liftDec typeSig onlyCons (DataD _ tyName tyVarBndrs _ cons _) +#else liftDec typeSig onlyCons (DataD _ tyName tyVarBndrs cons _) +#endif | null tyVarBndrs = fail $ "Type " ++ show tyName ++ " needs at least one free variable" | otherwise = concat <$> mapM (liftCon typeSig [] [] con nextTyName (init tyNames)) cons' where @@ -213,6 +218,7 @@ constructorName (RecC name _) = name constructorName (InfixC _ name _) = name constructorName (ForallC _ _ c) = constructorName c +constructorName _ = error "Unsupported constructor type" -- | Generate monadic actions for a data type. genFree :: Bool -- ^ Include type signature? @@ -232,7 +238,11 @@ genFreeCon typeSig cname = do info <- reify cname case info of - DataConI _ _ tname _ -> genFree typeSig (Just [cname]) tname + DataConI _ _ tname +#if !(MIN_VERSION_template_haskell(2,11,0)) + _ +#endif + -> genFree typeSig (Just [cname]) tname _ -> fail "makeFreeCon expects a data constructor" -- | @$('makeFree' ''T)@ provides free monadic actions for the @@ -240,7 +250,7 @@ makeFree :: Name -> Q [Dec] makeFree = genFree True Nothing --- | Like 'makeFreeCon', but does not provide type signatures. +-- | Like 'makeFree', but does not provide type signatures. -- This can be used to attach Haddock comments to individual arguments -- for each generated function. -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/src/Control/Monad/Free.hs new/free-4.12.4/src/Control/Monad/Free.hs --- old/free-4.12.1/src/Control/Monad/Free.hs 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/src/Control/Monad/Free.hs 2016-01-17 03:15:13.000000000 +0100 @@ -28,6 +28,7 @@ , retract , liftF , iter + , iterA , iterM , hoistFree , foldFree @@ -186,7 +187,7 @@ Free m >>- f = Free ((>>- f) <$> m) instance Functor f => Monad (Free f) where - return = Pure + return = pure {-# INLINE return #-} Pure a >>= f = f a Free m >>= f = Free ((>>= f) <$> m) @@ -303,18 +304,23 @@ iter _ (Pure a) = a iter phi (Free m) = phi (iter phi <$> m) --- | Like iter for monadic values. +-- | Like 'iter' for applicative values. +iterA :: (Applicative p, Functor f) => (f (p a) -> p a) -> Free f a -> p a +iterA _ (Pure x) = pure x +iterA phi (Free f) = phi (iterA phi <$> f) + +-- | Like 'iter' for monadic values. iterM :: (Monad m, Functor f) => (f (m a) -> m a) -> Free f a -> m a iterM _ (Pure x) = return x -iterM phi (Free f) = phi $ fmap (iterM phi) f +iterM phi (Free f) = phi (iterM phi <$> f) -- | Lift a natural transformation from @f@ to @g@ into a natural transformation from @'FreeT' f@ to @'FreeT' g@. hoistFree :: Functor g => (forall a. f a -> g a) -> Free f b -> Free g b hoistFree _ (Pure a) = Pure a hoistFree f (Free as) = Free (hoistFree f <$> f as) --- | The very definition of a free monoid is that given a natural transformation you get a monoid homomorphism. -foldFree :: (Functor m, Monad m) => (forall x . f x -> m x) -> Free f a -> m a +-- | The very definition of a free monad is that given a natural transformation you get a monad homomorphism. +foldFree :: Monad m => (forall x . f x -> m x) -> Free f a -> m a foldFree _ (Pure a) = return a foldFree f (Free as) = f as >>= foldFree f diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/src/Control/Monad/Trans/Free/Church.hs new/free-4.12.4/src/Control/Monad/Trans/Free/Church.hs --- old/free-4.12.1/src/Control/Monad/Trans/Free/Church.hs 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/src/Control/Monad/Trans/Free/Church.hs 2016-01-17 03:15:13.000000000 +0100 @@ -146,10 +146,10 @@ {-# INLINE throwError #-} m `catchError` f = toFT $ fromFT m `catchError` (fromFT . f) -instance (MonadCont m) => MonadCont (FT f m) where +instance MonadCont m => MonadCont (FT f m) where callCC f = join . lift $ callCC (\k -> return $ f (lift . k . return)) -instance (Functor f, MonadReader r m) => MonadReader r (FT f m) where +instance MonadReader r m => MonadReader r (FT f m) where ask = lift ask {-# INLINE ask #-} local f = hoistFT (local f) @@ -165,7 +165,7 @@ {-# INLINE writer #-} #endif -instance (Functor f, MonadState s m) => MonadState s (FT f m) where +instance MonadState s m => MonadState s (FT f m) where get = lift get {-# INLINE get #-} put = lift . put @@ -223,7 +223,7 @@ hoistFT phi (FT m) = FT (\kp kf -> join . phi $ m (return . kp) (\xg -> return . kf (join . phi . xg))) -- | Lift a natural transformation from @f@ to @g@ into a monad homomorphism from @'FT' f m@ to @'FT' g n@ -transFT :: Monad m => (forall a. f a -> g a) -> FT f m b -> FT g m b +transFT :: (forall a. f a -> g a) -> FT f m b -> FT g m b transFT phi (FT m) = FT (\kp kf -> m kp (\xg -> kf xg . phi)) -- | Pull out and join @m@ layers of @'FreeT' f m a@. @@ -252,7 +252,11 @@ -- @ -- 'retract' . 'liftF' = 'id' -- @ +#if __GLASGOW_HASKELL__ < 710 retract :: (Functor f, Monad f) => F f a -> f a +#else +retract :: Monad f => F f a -> f a +#endif retract m = runF m return join {-# INLINE retract #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/src/Control/Monad/Trans/Free.hs new/free-4.12.4/src/Control/Monad/Trans/Free.hs --- old/free-4.12.1/src/Control/Monad/Trans/Free.hs 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/src/Control/Monad/Trans/Free.hs 2016-01-17 03:15:13.000000000 +0100 @@ -224,7 +224,7 @@ instance (Functor f, Monad m) => Monad (FreeT f m) where fail e = FreeT (fail e) - return a = FreeT (return (Pure a)) + return = pure {-# INLINE return #-} FreeT m >>= f = FreeT $ m >>= \v -> case v of Pure a -> runFreeT (f a) @@ -332,7 +332,7 @@ hoistFreeT :: (Monad m, Functor f) => (forall a. m a -> n a) -> FreeT f m b -> FreeT f n b hoistFreeT mh = FreeT . mh . liftM (fmap (hoistFreeT mh)) . runFreeT --- | Lift a natural transformation from @f@ to @g@ into a monad homomorphism from @'FreeT' f m@ to @'FreeT' g n@ +-- | Lift a natural transformation from @f@ to @g@ into a monad homomorphism from @'FreeT' f m@ to @'FreeT' g m@ transFreeT :: (Monad m, Functor g) => (forall a. f a -> g a) -> FreeT f m b -> FreeT g m b transFreeT nt = FreeT . liftM (fmap (transFreeT nt) . transFreeF nt) . runFreeT @@ -431,7 +431,11 @@ -- @ -- 'intercalateT' f ≡ 'retractT' . 'intersperseT' f -- @ +#if __GLASGOW_HASKELL__ < 710 intercalateT :: (Monad m, MonadTrans t, Monad (t m), Functor (t m)) => t m a -> FreeT (t m) m b -> t m b +#else +intercalateT :: (Monad m, MonadTrans t, Monad (t m)) => t m a -> FreeT (t m) m b -> t m b +#endif intercalateT f (FreeT m) = do val <- lift m case val of diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/free-4.12.1/src/Control/Monad/Trans/Iter.hs new/free-4.12.4/src/Control/Monad/Trans/Iter.hs --- old/free-4.12.1/src/Control/Monad/Trans/Iter.hs 2015-05-15 19:34:34.000000000 +0200 +++ new/free-4.12.4/src/Control/Monad/Trans/Iter.hs 2016-01-17 03:15:13.000000000 +0100 @@ -172,7 +172,7 @@ {-# INLINE (<*>) #-} instance Monad m => Monad (IterT m) where - return = IterT . return . Left + return = pure {-# INLINE return #-} IterT m >>= k = IterT $ m >>= either (runIterT . k) (return . Right . (>>= k)) {-# INLINE (>>=) #-}
participants (1)
-
root@hilbert.suse.de