AList.hs

-- | Lists suitable for parallel execution (taken from Hackage's monad-par package). (For converting to regular lists, there is the toList function in Data.Foldable.)
module Control.CUtils.AList (AList(..), filterAList, assocFold, monoid, lenAList, findAList, concatAList) where

import Control.Parallel
import Control.Monad
import Control.Applicative
import Data.Monoid
import Data.Foldable (Foldable, foldMap)
import Data.Traversable (Traversable, traverse, foldMapDefault)

data AList t = Append (AList t) (AList t) | List [t] deriving (Eq, Ord, Show)

instance Monad AList where
	return x = List [x]
	Append ls ls2 >>= f = ((ls >>= f) `par` (ls2 >>= f)) `seq` Append (ls >>= f) (ls2 >>= f)
	List ls >>= f = foldr mplus mzero (map f ls)

instance MonadPlus AList where
	mzero = List []
	mplus m n = (m `par` n) `seq` case (m, n) of
		(List [x], List xs) -> List (x:xs)
		(List [x], Append y z) -> Append (mplus m y) z
		(List [], n) -> n
		(m, List []) -> m
		_ -> Append m n

instance Functor AList where
	fmap f m = m >>= return . f

instance Traversable AList where
	traverse f (Append ls ls2) = Append <$> traverse f ls <*> traverse f ls2
	traverse f (List ls) = List <$> traverse f ls

instance Foldable AList where
	foldMap = foldMapDefault

-- | Filters the AList using a predicate.
filterAList f ls = ls >>= \x -> List $ if f x then [x] else []

noNils (Append m n) = noNils m `mplus` noNils n
noNils ls = ls

assocFold0 f (Append ls ls2) = (assocFold0 f ls `par` assocFold0 f ls2) `seq` f (assocFold0 f ls) (assocFold0 f ls2)
assocFold0 f (List ls) = foldl1 f ls

-- | Folds the AList with a function, that must be associative. This allows parallelism to be introduced.
assocFold f = assocFold0 f . noNils

-- | Combine monoid elements to get a result.
monoid ls = if noNils ls == List [] then
		mempty
	else
		assocFold mappend ls

-- | Length of an AList.
lenAList ls = if noNils ls == List [] then
		0
	else
		assocFold (+) (fmap (const 1) ls)

-- | Find the first element satisfying a predicate.
findAList f = getFirst . monoid . fmap (\x -> First $ if f x then Just x else Nothing)

-- | Concatenate an AList of ALists.
concatAList ls = ls >>= id