Foldable.hs

{-# OPTIONS -fglasgow-exts -cpp -fno-warn-name-shadowing #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Collections.Foldable
-- Copyright   :  Ross Paterson 2005, adaptation to MPTC+FD by Jean-Philippe Bernardy
-- License     :  BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  :  jeanphilippe.bernardy (google mail address)
-- Stability   :  experimental
-- Portability :  MPTC+FD
--
-- Class of data structures that can be folded to a summary value.

module Data.Collections.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,
        --More general versions exist in Data.Collections
	--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
import Data.Array

#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 a | t -> a where
        -- | Combine the elements of a structure using a monoid.
        fold :: Monoid a => t -> a
        fold = foldMap id

        -- | Map each element of the structure to a monoid,
        -- and combine the results.
        foldMap :: Monoid m => (a -> m) -> t -> 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 -> 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 :: (b -> a -> b) -> b -> t -> b
	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
	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
	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)
 
        -- | Tells whether the structure is empty.
        null :: t -> Bool    
        null = all (const False)                

        -- | Returns the size of the structure.
        size :: t -> Int   
        size = foldr (const (+1)) 0

        -- | Tells whether the structure contains a single element.
        isSingleton :: t -> Bool              
        isSingleton = (1 ==) . size -- FIXME: more efficient default.

-- instances for Prelude types

instance Foldable (Maybe a) a where
	foldr _ z Nothing = z
	foldr f z (Just x) = f x z

	foldl _ z Nothing = z
	foldl f z (Just x) = f z x

instance Foldable [a] a where
        null = Prelude.null
        size = Prelude.length
	foldr = Prelude.foldr
	foldl = Prelude.foldl
	foldr1 = Prelude.foldr1
	foldl1 = Prelude.foldl1

instance Ix i => Foldable (Array i a) (i,a) where
	foldr f z = Prelude.foldr f z . assocs

-- | Fold over the elements of a structure,
-- associating to the right, but strictly.
foldr' :: Foldable t a => (a -> b -> b) -> b -> t -> b
foldr' f z xs = foldl f' id xs z
  where f' k x z = k $! f x z

-- | Monadic fold over the elements of a structure,
-- associating to the right, i.e. from right to left.
foldrM :: (Foldable t a, Monad m) => (a -> b -> m b) -> b -> t -> m b
foldrM f z xs = foldl f' return xs z
  where f' k x z = f x z >>= k

-- | Fold over the elements of a structure,
-- associating to the left, but strictly.
foldl' :: Foldable t b => (a -> b -> a) -> a -> t -> a
foldl' f z xs = foldr f' id xs z
  where f' x k z = k $! f z x

-- | Monadic fold over the elements of a structure,
-- associating to the left, i.e. from left to right.
foldlM :: (Foldable t b, Monad m) => (a -> b -> m a) -> a -> t -> m a
foldlM f z xs = foldr f' return xs z
  where f' x k z = f z 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 a, Applicative f) => (a -> f b) -> t -> f ()
traverse_ f = foldr ((*>) . f) (pure ())

-- | 'for_' is 'traverse_' with its arguments flipped.
for_ :: (Foldable t a, Applicative f) => t -> (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 a, Monad m) => (a -> m b) -> t -> m ()
mapM_ f = foldr ((>>) . f) (return ())

-- | 'forM_' is 'mapM_' with its arguments flipped.
forM_ :: (Foldable t a, Monad m) => t -> (a -> m b) -> m ()
{-# INLINE forM_ #-}
forM_ = flip mapM_

-- | Evaluate each action in the structure from left to right,
-- and ignore the results.
sequenceA_ :: forall f a t. (Foldable t (f a), Applicative f) => t -> f ()
sequenceA_ = foldr (*>) (pure ())

-- | Evaluate each monadic action in the structure from left to right,
-- and ignore the results.
sequence_ :: forall m a t. (Foldable t (m a), Monad m) => t -> m ()
sequence_ = foldr (>>) (return ())

-- | The sum of a collection of actions, generalizing 'concat'.
asum :: (Foldable t (f a), Alternative f) => t -> f a
{-# INLINE asum #-}
asum = foldr (<|>) empty

-- | The sum of a collection of actions, generalizing 'concat'.
msum :: (Foldable t (m a), MonadPlus m) => t -> 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 a => t -> [a]
#ifdef __GLASGOW_HASKELL__
toList t = build (\ c n -> foldr c n t)
#else
toList = foldr (:) []
#endif

{- Not used or exported
-- | The concatenation of all the elements of a container of lists.
concat :: Foldable t [a] => t -> [a]
concat = fold
-}

-- | Map a function over all the elements of a container and concatenate
-- the resulting lists.
concatMap :: Foldable t a => (a -> [b]) -> t -> [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 Bool => t -> 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 Bool => t -> Bool
or = getAny . foldMap Any

-- | Determines whether any element of the structure satisfies the predicate.
any :: Foldable t a => (a -> Bool) -> t -> Bool
any p = getAny . foldMap (Any . p)

-- | Determines whether all elements of the structure satisfy the predicate.
all :: Foldable t a => (a -> Bool) -> t -> Bool
all p = getAll . foldMap (All . p)

-- | The 'sum' function computes the sum of the numbers of a structure.
sum :: (Foldable t a, Num a) => t -> a
sum = getSum . foldMap Sum

-- | The 'product' function computes the product of the numbers of a structure.
product :: (Foldable t a, Num a) => t -> a
product = getProduct . foldMap Product

-- | The largest element of the structure.
maximum :: (Foldable t a, Ord a) => t -> a
maximum = foldr1 max

-- | The largest element of a non-empty structure with respect to the
-- given comparison function.
maximumBy :: Foldable t a => (a -> a -> Ordering) -> t -> a
maximumBy cmp = foldr1 max'
  where max' x y = case cmp x y of
			GT -> x
			_  -> y

-- | The least element of a non-null structure.
minimum :: (Foldable t a, Ord a) => t -> a
minimum = foldr1 min

-- | The least element of a non-empty structure with respect to the
-- given comparison function.
minimumBy :: Foldable t a => (a -> a -> Ordering) -> t -> 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 a, Eq a) => a -> t -> Bool
elem = any . (==)

-- | 'notElem' is the negation of 'elem'.
notElem :: (Foldable t a, Eq a) => a -> t -> 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 => (a -> Bool) -> t -> Maybe a
find p = listToMaybe . concatMap (\ x -> if p x then [x] else [])