packages feed

special-functors (empty) → 1.0

raw patch · 9 files changed

+1073/−0 lines, 9 filesdep +basedep +mtlsetup-changed

Dependencies added: base, mtl

Files

+ Control/Applicative.hs view
@@ -0,0 +1,222 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Applicative+-- Copyright   :  Conor McBride and Ross Paterson 2005+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  portable+--+-- This module describes a structure intermediate between a functor and+-- a monad: it provides pure expressions and sequencing, but no binding.+-- (Technically, a strong lax monoidal functor.)  For more details, see+-- /Applicative Programming with Effects/,+-- by Conor McBride and Ross Paterson, online at+-- <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.+--+-- This interface was introduced for parsers by Niklas R&#xF6;jemo, because+-- it admits more sharing than the monadic interface.  The names here are+-- mostly based on recent parsing work by Doaitse Swierstra.+--+-- This class is also useful with instances of the+-- 'Data.Traversable.Traversable' class.++module Control.Applicative (+	-- * Applicative functors+	Applicative(..),+	-- * Alternatives+	Alternative(..),+	-- * Instances+	Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..),+	-- * Utility functions+	(<$>), (<$), (*>), (<*), (<**>),+	liftA, liftA2, liftA3,+	optional, some, many+	) where++#ifdef __HADDOCK__+import Prelude+#endif++import Control.Monad.Instances ()+++import Control.Arrow+	(Arrow(arr, (>>>), (&&&)), ArrowZero(zeroArrow), ArrowPlus((<+>)))+import Control.Monad (liftM, ap, MonadPlus(..))+import Data.Monoid (Monoid(..))++infixl 3 <|>+infixl 4 <$>, <$+infixl 4 <*>, <*, *>, <**>++-- | A functor with application.+--+-- Instances should satisfy the following laws:+--+-- [/identity/]+--	@'pure' 'id' '<*>' v = v@+--+-- [/composition/]+--	@'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@+--+-- [/homomorphism/]+--	@'pure' f '<*>' 'pure' x = 'pure' (f x)@+--+-- [/interchange/]+--	@u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@+--+-- The 'Functor' instance should satisfy+--+-- @+--	'fmap' f x = 'pure' f '<*>' x+-- @+--+-- If @f@ is also a 'Monad', define @'pure' = 'return'@ and @('<*>') = 'ap'@.++class Functor f => Applicative f where+	-- | Lift a value.+	pure :: a -> f a++        -- | Sequential application.+	(<*>) :: f (a -> b) -> f a -> f b++-- | A monoid on applicative functors.+class Applicative f => Alternative f where+	-- | The identity of '<|>'+	empty :: f a+	-- | An associative binary operation+	(<|>) :: f a -> f a -> f a++-- instances for Prelude types++instance Applicative Maybe where+	pure = return+	(<*>) = ap++instance Alternative Maybe where+	empty = Nothing+	Nothing <|> p = p+	Just x <|> _ = Just x++instance Applicative [] where+	pure = return+	(<*>) = ap++instance Alternative [] where+	empty = []+	(<|>) = (++)++instance Applicative IO where+	pure = return+	(<*>) = ap++instance Applicative ((->) a) where+	pure = const+	(<*>) f g x = f x (g x)++instance Monoid a => Applicative ((,) a) where+	pure x = (mempty, x)+	(u, f) <*> (v, x) = (u `mappend` v, f x)++-- new instances++newtype Const a b = Const { getConst :: a }++instance Functor (Const m) where+	fmap _ (Const v) = Const v++instance Monoid m => Applicative (Const m) where+	pure _ = Const mempty+	Const f <*> Const v = Const (f `mappend` v)++newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }++instance Monad m => Functor (WrappedMonad m) where+	fmap f (WrapMonad v) = WrapMonad (liftM f v)++instance Monad m => Applicative (WrappedMonad m) where+	pure = WrapMonad . return+	WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v)++instance MonadPlus m => Alternative (WrappedMonad m) where+	empty = WrapMonad mzero+	WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)++newtype WrappedArrow a b c = WrapArrow { unwrapArrow :: a b c }++instance Arrow a => Functor (WrappedArrow a b) where+	fmap f (WrapArrow a) = WrapArrow (a >>> arr f)++instance Arrow a => Applicative (WrappedArrow a b) where+	pure x = WrapArrow (arr (const x))+	WrapArrow f <*> WrapArrow v = WrapArrow (f &&& v >>> arr (uncurry id))++instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where+	empty = WrapArrow zeroArrow+	WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v)++-- | Lists, but with an 'Applicative' functor based on zipping, so that+--+-- @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@+--+newtype ZipList a = ZipList { getZipList :: [a] }++instance Functor ZipList where+	fmap f (ZipList xs) = ZipList (map f xs)++instance Applicative ZipList where+	pure x = ZipList (repeat x)+	ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs)++-- extra functions++-- | A synonym for 'fmap'.+(<$>) :: Functor f => (a -> b) -> f a -> f b+f <$> a = fmap f a++-- | Replace the value.+(<$) :: Functor f => a -> f b -> f a+(<$) = (<$>) . const+ +-- | Sequence actions, discarding the value of the first argument.+(*>) :: Applicative f => f a -> f b -> f b+(*>) = liftA2 (const id)+ +-- | Sequence actions, discarding the value of the second argument.+(<*) :: Applicative f => f a -> f b -> f a+(<*) = liftA2 const+ +-- | A variant of '<*>' with the arguments reversed.+(<**>) :: Applicative f => f a -> f (a -> b) -> f b+(<**>) = liftA2 (flip ($))++-- | Lift a function to actions.+-- This function may be used as a value for `fmap` in a `Functor` instance.+liftA :: Applicative f => (a -> b) -> f a -> f b+liftA f a = pure f <*> a++-- | Lift a binary function to actions.+liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c+liftA2 f a b = f <$> a <*> b++-- | Lift a ternary function to actions.+liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d+liftA3 f a b c = f <$> a <*> b <*> c++-- | One or none.+optional :: Alternative f => f a -> f (Maybe a)+optional v = Just <$> v <|> pure Nothing++-- | One or more.+some :: Alternative f => f a -> f [a]+some v = some_v+  where many_v = some_v <|> pure []+	some_v = (:) <$> v <*> many_v++-- | Zero or more.+many :: Alternative f => f a -> f [a]+many v = many_v+  where many_v = some_v <|> pure []+	some_v = (:) <$> v <*> many_v
+ Control/Monad/Instances.hs view
@@ -0,0 +1,38 @@+{-# OPTIONS_NHC98 --prelude #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Instances+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- 'Functor' and 'Monad' instances for @(->) r@ and+-- 'Functor' instances for @(,) a@ and @'Either' a@.++module Control.Monad.Instances (Functor(..),Monad(..)) where++import Prelude++import Control.Monad.Reader ()+import Control.Monad.Error ()++{-+instance Functor ((->) r) where+	fmap = (.)++instance Monad ((->) r) where+	return = const+	f >>= k = \ r -> k (f r) r+-}++instance Functor ((,) a) where+	fmap f (x,y) = (x, f y)++{-+instance Functor (Either a) where+	fmap _ (Left x) = Left x+	fmap f (Right y) = Right (f y)+-}
+ Data/Foldable.hs view
@@ -0,0 +1,298 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Foldable+-- Copyright   :  Ross Paterson 2005+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  portable+--+-- Class of data structures that can be folded to a summary value.+--+-- Many of these functions generalize "Prelude", "Control.Monad" and+-- "Data.List" functions of the same names from lists to any 'Foldable'+-- functor.  To avoid ambiguity, either import those modules hiding+-- these names or qualify uses of these function names with an alias+-- for this module.++module Data.Foldable (+	-- * Folds+	Foldable(..),+	-- ** Special biased folds+	foldr',+	foldl',+	foldrM,+	foldlM,+	-- ** Folding actions+	-- *** Applicative actions+	traverse_,+	for_,+	sequenceA_,+	asum,+	-- *** Monadic actions+	mapM_,+	forM_,+	sequence_,+	msum,+	-- ** Specialized folds+	toList,+	concat,+	concatMap,+	and,+	or,+	any,+	all,+	sum,+	product,+	maximum,+	maximumBy,+	minimum,+	minimumBy,+	-- ** Searches+	elem,+	notElem,+	find+	) where++import Prelude hiding (foldl, foldr, foldl1, foldr1, mapM_, sequence_,+		elem, notElem, concat, concatMap, and, or, any, all,+		sum, product, maximum, minimum)+import qualified Prelude (foldl, foldr, foldl1, foldr1)+import Control.Applicative+import Control.Monad (MonadPlus(..))+import Data.Maybe (fromMaybe, listToMaybe)+import Data.Monoid (Monoid(..), )+import Data.MonoidExample++#ifdef __NHC__+import Control.Arrow (ArrowZero(..)) -- work around nhc98 typechecker problem+#endif++#ifdef __GLASGOW_HASKELL__+import GHC.Exts (build)+#endif++-- | Data structures that can be folded.+--+-- Minimal complete definition: 'foldMap' or 'foldr'.+--+-- For example, given a data type+--+-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)+--+-- a suitable instance would be+--+-- > instance Foldable Tree+-- >    foldMap f Empty = mempty+-- >    foldMap f (Leaf x) = f x+-- >    foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r+--+-- This is suitable even for abstract types, as the monoid is assumed+-- to satisfy the monoid laws.+--+class Foldable t where+	-- | Combine the elements of a structure using a monoid.+	fold :: Monoid m => t m -> m+	fold = foldMap id++	-- | Map each element of the structure to a monoid,+	-- and combine the results.+	foldMap :: Monoid m => (a -> m) -> t a -> m+	foldMap f = foldr (mappend . f) mempty++	-- | Right-associative fold of a structure.+	--+	-- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@+	foldr :: (a -> b -> b) -> b -> t a -> b+	foldr f z t = appEndo (foldMap (Endo . f) t) z++	-- | Left-associative fold of a structure.+	--+	-- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@+	foldl :: (a -> b -> a) -> a -> t b -> a+	foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z++	-- | A variant of 'foldr' that has no base case,+	-- and thus may only be applied to non-empty structures.+	--+	-- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@+	foldr1 :: (a -> a -> a) -> t a -> a+	foldr1 f xs = fromMaybe (error "foldr1: empty structure")+			(foldr mf Nothing xs)+	  where mf x Nothing = Just x+		mf x (Just y) = Just (f x y)++	-- | A variant of 'foldl' that has no base case,+	-- and thus may only be applied to non-empty structures.+	--+	-- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@+	foldl1 :: (a -> a -> a) -> t a -> a+	foldl1 f xs = fromMaybe (error "foldl1: empty structure")+			(foldl mf Nothing xs)+	  where mf Nothing y = Just y+		mf (Just x) y = Just (f x y)++-- instances for Prelude types++instance Foldable Maybe where+	foldr _f z Nothing = z+	foldr f z (Just x) = f x z++	foldl _f z Nothing = z+	foldl f z (Just x) = f z x++instance Foldable [] where+	foldr = Prelude.foldr+	foldl = Prelude.foldl+	foldr1 = Prelude.foldr1+	foldl1 = Prelude.foldl1++-- | Fold over the elements of a structure,+-- associating to the right, but strictly.+foldr' :: Foldable t => (a -> b -> b) -> b -> t a -> b+foldr' f z xs = foldl f' id xs z+  where f' k x w = k $! f x w++-- | Monadic fold over the elements of a structure,+-- associating to the right, i.e. from right to left.+foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b+foldrM f z xs = foldl f' return xs z+  where f' k x w = f x w >>= k++-- | Fold over the elements of a structure,+-- associating to the left, but strictly.+foldl' :: Foldable t => (a -> b -> a) -> a -> t b -> a+foldl' f z xs = foldr f' id xs z+  where f' x k w = k $! f w x++-- | Monadic fold over the elements of a structure,+-- associating to the left, i.e. from left to right.+foldlM :: (Foldable t, Monad m) => (a -> b -> m a) -> a -> t b -> m a+foldlM f z xs = foldr f' return xs z+  where f' x k w = f w x >>= k++-- | Map each element of a structure to an action, evaluate+-- these actions from left to right, and ignore the results.+traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()+traverse_ f = foldr ((*>) . f) (pure ())++-- | 'for_' is 'traverse_' with its arguments flipped.+for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()+{-# INLINE for_ #-}+for_ = flip traverse_++-- | Map each element of a structure to a monadic action, evaluate+-- these actions from left to right, and ignore the results.+mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()+mapM_ f = foldr ((>>) . f) (return ())++-- | 'forM_' is 'mapM_' with its arguments flipped.+forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()+{-# INLINE forM_ #-}+forM_ = flip mapM_++-- | Evaluate each action in the structure from left to right,+-- and ignore the results.+sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f ()+sequenceA_ = foldr (*>) (pure ())++-- | Evaluate each monadic action in the structure from left to right,+-- and ignore the results.+sequence_ :: (Foldable t, Monad m) => t (m a) -> m ()+sequence_ = foldr (>>) (return ())++-- | The sum of a collection of actions, generalizing 'concat'.+asum :: (Foldable t, Alternative f) => t (f a) -> f a+{-# INLINE asum #-}+asum = foldr (<|>) empty++-- | The sum of a collection of actions, generalizing 'concat'.+msum :: (Foldable t, MonadPlus m) => t (m a) -> m a+{-# INLINE msum #-}+msum = foldr mplus mzero++-- These use foldr rather than foldMap to avoid repeated concatenation.++-- | List of elements of a structure.+toList :: Foldable t => t a -> [a]+#ifdef __GLASGOW_HASKELL__+toList t = build (\ c n -> foldr c n t)+#else+toList = foldr (:) []+#endif++-- | The concatenation of all the elements of a container of lists.+concat :: Foldable t => t [a] -> [a]+concat = fold++-- | Map a function over all the elements of a container and concatenate+-- the resulting lists.+concatMap :: Foldable t => (a -> [b]) -> t a -> [b]+concatMap = foldMap++-- | 'and' returns the conjunction of a container of Bools.  For the+-- result to be 'True', the container must be finite; 'False', however,+-- results from a 'False' value finitely far from the left end.+and :: Foldable t => t Bool -> Bool+and = getAll . foldMap All++-- | 'or' returns the disjunction of a container of Bools.  For the+-- result to be 'False', the container must be finite; 'True', however,+-- results from a 'True' value finitely far from the left end.+or :: Foldable t => t Bool -> Bool+or = getAny . foldMap Any++-- | Determines whether any element of the structure satisfies the predicate.+any :: Foldable t => (a -> Bool) -> t a -> Bool+any p = getAny . foldMap (Any . p)++-- | Determines whether all elements of the structure satisfy the predicate.+all :: Foldable t => (a -> Bool) -> t a -> Bool+all p = getAll . foldMap (All . p)++-- | The 'sum' function computes the sum of the numbers of a structure.+sum :: (Foldable t, Num a) => t a -> a+sum = getSum . foldMap Sum++-- | The 'product' function computes the product of the numbers of a structure.+product :: (Foldable t, Num a) => t a -> a+product = getProduct . foldMap Product++-- | The largest element of a non-empty structure.+maximum :: (Foldable t, Ord a) => t a -> a+maximum = foldr1 max++-- | The largest element of a non-empty structure with respect to the+-- given comparison function.+maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a+maximumBy cmp = foldr1 max'+  where max' x y = case cmp x y of+			GT -> x+			_  -> y++-- | The least element of a non-empty structure.+minimum :: (Foldable t, Ord a) => t a -> a+minimum = foldr1 min++-- | The least element of a non-empty structure with respect to the+-- given comparison function.+minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a+minimumBy cmp = foldr1 min'+  where min' x y = case cmp x y of+			GT -> y+			_  -> x++-- | Does the element occur in the structure?+elem :: (Foldable t, Eq a) => a -> t a -> Bool+elem = any . (==)++-- | 'notElem' is the negation of 'elem'.+notElem :: (Foldable t, Eq a) => a -> t a -> Bool+notElem x = not . elem x++-- | The 'find' function takes a predicate and a structure and returns+-- the leftmost element of the structure matching the predicate, or+-- 'Nothing' if there is no such element.+find :: Foldable t => (a -> Bool) -> t a -> Maybe a+find p = listToMaybe . concatMap (\ x -> if p x then [x] else [])
+ Data/MonoidExample.hs view
@@ -0,0 +1,259 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid+-- Copyright   :  (c) Andy Gill 2001,+--                (c) Oregon Graduate Institute of Science and Technology, 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- The Monoid class with various general-purpose instances.+--+--    Inspired by the paper+--    /Functional Programming with Overloading and+--        Higher-Order Polymorphism/,+--      Mark P Jones (<http://citeseer.ist.psu.edu/jones95functional.html>)+--        Advanced School of Functional Programming, 1995.+-----------------------------------------------------------------------------++module Data.MonoidExample (+        -- * Monoid typeclass+	Dual(..),+	Endo(..),+        -- * Bool wrappers+	All(..),+	Any(..),+        -- * Num wrappers+	Sum(..),+	Product(..),+        -- * Maybe wrappers+        -- $MaybeExamples+	First(..),+	Last(..)+  ) where++import Prelude+import Data.Monoid (Monoid(..), )+++{-+-- just for testing+import Data.Maybe+import Test.QuickCheck+-- -}++{-+-- ---------------------------------------------------------------------------+-- | The monoid class.+-- A minimal complete definition must supply 'mempty' and 'mappend',+-- and these should satisfy the monoid laws.++class Monoid a where+	mempty  :: a+	-- ^ Identity of 'mappend'+	mappend :: a -> a -> a+	-- ^ An associative operation+	mconcat :: [a] -> a++	-- ^ Fold a list using the monoid.+	-- For most types, the default definition for 'mconcat' will be+	-- used, but the function is included in the class definition so+	-- that an optimized version can be provided for specific types.++	mconcat = foldr mappend mempty++-- Monoid instances.++instance Monoid [a] where+	mempty  = []+	mappend = (++)++instance Monoid b => Monoid (a -> b) where+	mempty _ = mempty+	mappend f g x = f x `mappend` g x++instance Monoid () where+	-- Should it be strict?+	mempty        = ()+	_ `mappend` _ = ()+	mconcat _     = ()++instance (Monoid a, Monoid b) => Monoid (a,b) where+	mempty = (mempty, mempty)+	(a1,b1) `mappend` (a2,b2) =+		(a1 `mappend` a2, b1 `mappend` b2)++instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where+	mempty = (mempty, mempty, mempty)+	(a1,b1,c1) `mappend` (a2,b2,c2) =+		(a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2)++instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where+	mempty = (mempty, mempty, mempty, mempty)+	(a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) =+		(a1 `mappend` a2, b1 `mappend` b2,+		 c1 `mappend` c2, d1 `mappend` d2)++instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>+		Monoid (a,b,c,d,e) where+	mempty = (mempty, mempty, mempty, mempty, mempty)+	(a1,b1,c1,d1,e1) `mappend` (a2,b2,c2,d2,e2) =+		(a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2,+		 d1 `mappend` d2, e1 `mappend` e2)++-- lexicographical ordering+instance Monoid Ordering where+	mempty         = EQ+	LT `mappend` _ = LT+	EQ `mappend` y = y+	GT `mappend` _ = GT+-}+++-- | The dual of a monoid, obtained by swapping the arguments of 'mappend'.+newtype Dual a = Dual { getDual :: a }+	deriving (Eq, Ord, Read, Show, Bounded)++instance Monoid a => Monoid (Dual a) where+	mempty = Dual mempty+	Dual x `mappend` Dual y = Dual (y `mappend` x)++-- | The monoid of endomorphisms under composition.+newtype Endo a = Endo { appEndo :: a -> a }++instance Monoid (Endo a) where+	mempty = Endo id+	Endo f `mappend` Endo g = Endo (f . g)++-- | Boolean monoid under conjunction.+newtype All = All { getAll :: Bool }+	deriving (Eq, Ord, Read, Show, Bounded)++instance Monoid All where+	mempty = All True+	All x `mappend` All y = All (x && y)++-- | Boolean monoid under disjunction.+newtype Any = Any { getAny :: Bool }+	deriving (Eq, Ord, Read, Show, Bounded)++instance Monoid Any where+	mempty = Any False+	Any x `mappend` Any y = Any (x || y)++-- | Monoid under addition.+newtype Sum a = Sum { getSum :: a }+	deriving (Eq, Ord, Read, Show, Bounded)++instance Num a => Monoid (Sum a) where+	mempty = Sum 0+	Sum x `mappend` Sum y = Sum (x + y)++-- | Monoid under multiplication.+newtype Product a = Product { getProduct :: a }+	deriving (Eq, Ord, Read, Show, Bounded)++instance Num a => Monoid (Product a) where+	mempty = Product 1+	Product x `mappend` Product y = Product (x * y)++-- $MaybeExamples+-- To implement @find@ or @findLast@ on any 'Foldable':+--+-- @+-- findLast :: Foldable t => (a -> Bool) -> t a -> Maybe a+-- findLast pred = getLast . foldMap (\x -> if pred x+--                                            then Last (Just x)+--                                            else Last Nothing)+-- @+--+-- Much of Data.Map's interface can be implemented with+-- Data.Map.alter. Some of the rest can be implemented with a new+-- @alterA@ function and either 'First' or 'Last':+--+-- > alterA :: (Applicative f, Ord k) =>+-- >           (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)+-- >+-- > instance Monoid a => Applicative ((,) a)  -- from Control.Applicative+--+-- @+-- insertLookupWithKey :: Ord k => (k -> v -> v -> v) -> k -> v+--                     -> Map k v -> (Maybe v, Map k v)+-- insertLookupWithKey combine key value =+--   Arrow.first getFirst . alterA doChange key+--   where+--   doChange Nothing = (First Nothing, Just value)+--   doChange (Just oldValue) =+--     (First (Just oldValue),+--      Just (combine key value oldValue))+-- @++-- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to+-- <http://en.wikipedia.org/wiki/Monoid>: \"Any semigroup @S@ may be+-- turned into a monoid simply by adjoining an element @e@ not in @S@+-- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S@.\" Since+-- there is no \"Semigroup\" typeclass providing just 'mappend', we+-- use 'Monoid' instead.+{-+instance Monoid a => Monoid (Maybe a) where+  mempty = Nothing+  Nothing `mappend` m = m+  m `mappend` Nothing = m+  Just m1 `mappend` Just m2 = Just (m1 `mappend` m2)+-}+++-- | Maybe monoid returning the leftmost non-Nothing value.+newtype First a = First { getFirst :: Maybe a }+#ifndef __HADDOCK__+	deriving (Eq, Ord, Read, Show)+#else  /* __HADDOCK__ */+instance Eq a => Eq (First a)+instance Ord a => Ord (First a)+instance Read a => Read (First a)+instance Show a => Show (First a)+#endif++instance Monoid (First a) where+	mempty = First Nothing+	r@(First (Just _)) `mappend` _ = r+	First Nothing `mappend` r = r++-- | Maybe monoid returning the rightmost non-Nothing value.+newtype Last a = Last { getLast :: Maybe a }+#ifndef __HADDOCK__+	deriving (Eq, Ord, Read, Show)+#else  /* __HADDOCK__ */+instance Eq a => Eq (Last a)+instance Ord a => Ord (Last a)+instance Read a => Read (Last a)+instance Show a => Show (Last a)+#endif++instance Monoid (Last a) where+	mempty = Last Nothing+	_ `mappend` r@(Last (Just _)) = r+	r `mappend` Last Nothing = r++{-+{--------------------------------------------------------------------+  Testing+--------------------------------------------------------------------}+instance Arbitrary a => Arbitrary (Maybe a) where+  arbitrary = oneof [return Nothing, Just `fmap` arbitrary]++prop_mconcatMaybe :: [Maybe [Int]] -> Bool+prop_mconcatMaybe x =+  fromMaybe [] (mconcat x) == mconcat (catMaybes x)++prop_mconcatFirst :: [Maybe Int] -> Bool+prop_mconcatFirst x =+  getFirst (mconcat (map First x)) == listToMaybe (catMaybes x)+prop_mconcatLast :: [Maybe Int] -> Bool+prop_mconcatLast x =+  getLast (mconcat (map Last x)) == listLastToMaybe (catMaybes x)+	where listLastToMaybe [] = Nothing+              listLastToMaybe lst = Just (last lst)+-- -}
+ Data/Traversable.hs view
@@ -0,0 +1,135 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Traversable+-- Copyright   :  Conor McBride and Ross Paterson 2005+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  portable+--+-- Class of data structures that can be traversed from left to right,+-- performing an action on each element.+--+-- See also+--+--  * /Applicative Programming with Effects/,+--    by Conor McBride and Ross Paterson, online at+--    <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.+--+--  * /The Essence of the Iterator Pattern/,+--    by Jeremy Gibbons and Bruno Oliveira,+--    in /Mathematically-Structured Functional Programming/, 2006, and online at+--    <http://web.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/#iterator>.+--+-- Note that the functions 'mapM' and 'sequence' generalize "Prelude"+-- functions of the same names from lists to any 'Traversable' functor.+-- To avoid ambiguity, either import the "Prelude" hiding these names+-- or qualify uses of these function names with an alias for this module.++module Data.Traversable (+	Traversable(..),+	for,+	forM,+	fmapDefault,+	foldMapDefault,+	) where++import Prelude hiding (mapM, sequence, foldr)+import qualified Prelude (mapM, foldr)+import Control.Applicative+import Data.Foldable (Foldable())+import Data.Monoid (Monoid)++-- | Functors representing data structures that can be traversed from+-- left to right.+--+-- Minimal complete definition: 'traverse' or 'sequenceA'.+--+-- Instances are similar to 'Functor', e.g. given a data type+--+-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)+--+-- a suitable instance would be+--+-- > instance Traversable Tree+-- >	traverse f Empty = pure Empty+-- >	traverse f (Leaf x) = Leaf <$> f x+-- >	traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r+--+-- This is suitable even for abstract types, as the laws for '<*>'+-- imply a form of associativity.+--+-- The superclass instances should satisfy the following:+--+--  * In the 'Functor' instance, 'fmap' should be equivalent to traversal+--    with the identity applicative functor ('fmapDefault').+--+--  * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be+--    equivalent to traversal with a constant applicative functor+--    ('foldMapDefault').+--+class (Functor t, Foldable t) => Traversable t where+	-- | Map each element of a structure to an action, evaluate+	-- these actions from left to right, and collect the results.+	traverse :: Applicative f => (a -> f b) -> t a -> f (t b)+	traverse f = sequenceA . fmap f++	-- | Evaluate each action in the structure from left to right,+	-- and collect the results.+	sequenceA :: Applicative f => t (f a) -> f (t a)+	sequenceA = traverse id++	-- | Map each element of a structure to a monadic action, evaluate+	-- these actions from left to right, and collect the results.+	mapM :: Monad m => (a -> m b) -> t a -> m (t b)+	mapM f = unwrapMonad . traverse (WrapMonad . f)++	-- | Evaluate each monadic action in the structure from left to right,+	-- and collect the results.+	sequence :: Monad m => t (m a) -> m (t a)+	sequence = mapM id++-- instances for Prelude types++instance Traversable Maybe where+	traverse _f Nothing = pure Nothing+	traverse f (Just x) = Just <$> f x++instance Traversable [] where+	traverse f = Prelude.foldr cons_f (pure [])+	  where cons_f x ys = (:) <$> f x <*> ys++	mapM = Prelude.mapM++-- general functions++-- | 'for' is 'traverse' with its arguments flipped.+for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)+{-# INLINE for #-}+for = flip traverse++-- | 'forM' is 'mapM' with its arguments flipped.+forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)+{-# INLINE forM #-}+forM = flip mapM++-- | This function may be used as a value for `fmap` in a `Functor` instance.+fmapDefault :: Traversable t => (a -> b) -> t a -> t b+fmapDefault f = getId . traverse (Id . f)++-- | This function may be used as a value for `Data.Foldable.foldMap`+-- in a `Foldable` instance.+foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m+foldMapDefault f = getConst . traverse (Const . f)++-- local instances++newtype Id a = Id { getId :: a }++instance Functor Id where+	fmap f (Id x) = Id (f x)++instance Applicative Id where+	pure = Id+	Id f <*> Id x = Id (f x)
+ LICENSE view
@@ -0,0 +1,83 @@+This library (libraries/base) is derived from code from several+sources: ++  * Code from the GHC project which is largely (c) The University of+    Glasgow, and distributable under a BSD-style license (see below),++  * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+    and freely redistributable (but see the full license for+    restrictions).++  * Code from the Haskell Foreign Function Interface specification,+    which is (c) Manuel M. T. Chakravarty and freely redistributable+    (but see the full license for restrictions).++The full text of these licenses is reproduced below.  All of the+licenses are BSD-style or compatible.++-----------------------------------------------------------------------------++The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.++-----------------------------------------------------------------------------++Code derived from the document "Report on the Programming Language+Haskell 98", is distributed under the following license:++  Copyright (c) 2002 Simon Peyton Jones++  The authors intend this Report to belong to the entire Haskell+  community, and so we grant permission to copy and distribute it for+  any purpose, provided that it is reproduced in its entirety,+  including this Notice.  Modified versions of this Report may also be+  copied and distributed for any purpose, provided that the modified+  version is clearly presented as such, and that it does not claim to+  be a definition of the Haskell 98 Language.++-----------------------------------------------------------------------------++Code derived from the document "The Haskell 98 Foreign Function+Interface, An Addendum to the Haskell 98 Report" is distributed under+the following license:++  Copyright (c) 2002 Manuel M. T. Chakravarty++  The authors intend this Report to belong to the entire Haskell+  community, and so we grant permission to copy and distribute it for+  any purpose, provided that it is reproduced in its entirety,+  including this Notice.  Modified versions of this Report may also be+  copied and distributed for any purpose, provided that the modified+  version is clearly presented as such, and that it does not claim to+  be a definition of the Haskell 98 Foreign Function Interface.++-----------------------------------------------------------------------------
+ README view
@@ -0,0 +1,10 @@+These are the modules for applicative functors and friends,+as found in GHC-6.6 and higher.+We provide them for use in versions up to GHC-6.4.+This package can be used for backward compatibility.+++ToDo:++Add various instances of Foldable and Traversable for base types like Map,+but these will be less efficient as you don't have access to their implementations.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ special-functors.cabal view
@@ -0,0 +1,25 @@+Name:                special-functors+Version:             1.0+Synopsis:            Control.Applicative, Data.Foldable, Data.Traversable (compatibility package)+Category:            Generics+Description:+  This package contains Control.Applicative, Data.Foldable, Data.Traversable+  from 6.8's base for use in earlier GHC versions+License:             BSD3+License-file:        LICENSE+Author:              libraries@haskell.org+Maintainer:          haskell@henning-thielemann.de+Tested-With:         GHC==6.4.1+Build-Depends:       base<2, mtl+Build-Type:          Simple+Extensions:          CPP+GHC-Options:         -funbox-strict-fields -Wall+GHC-Prof-Options:    -funbox-strict-fields -auto-all -Wall+Exposed-Modules:+  Control.Monad.Instances+  Control.Applicative+  Data.Foldable+  Data.Traversable+Other-Modules:+  Data.MonoidExample+Extra-Source-Files:  README