packages feed

reducers 0.3.0.1 → 3.0

raw patch · 29 files changed

+1321/−1320 lines, 29 filesdep ~comonaddep ~keysdep ~pointed

Dependency ranges changed: comonad, keys, pointed, semigroupoids

Files

− Data/Generator.hs 
@@ -1,204 +0,0 @@-{-# LANGUAGE UndecidableInstances, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, CPP #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Generator--- Copyright   :  (c) Edward Kmett 2009--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  portable------ A 'Generator' @c@ is a possibly-specialized container, which contains values of --- type 'Elem' @c@, and which knows how to efficiently apply a 'Reducer' to extract--- an answer.------ Since a 'Generator' is not polymorphic in its contents, it is more specialized--- than "Data.Foldable.Foldable", and a 'Reducer' may supply efficient left-to-right--- and right-to-left reduction strategies that a 'Generator' may avail itself of.--------------------------------------------------------------------------------module Data.Generator-  (-  -- * Generators-    Generator(..)-  -- * Generator Transformers-  , Keys(Keys, getKeys)-  , Values(Values, getValues)-  , Char8(Char8, getChar8)-  -- * Combinators-  , reduce-  , mapReduceWith-  , reduceWith-  ) where--import Data.Monoid (Monoid, mappend, mempty)--import Data.Array -import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.ByteString as Strict (ByteString, foldl')-import qualified Data.ByteString.Char8 as Strict8 (foldl')-import qualified Data.ByteString.Lazy as Lazy (ByteString, toChunks)-import qualified Data.ByteString.Lazy.Char8 as Lazy8 (toChunks)-import Data.Word (Word8)-import Data.FingerTree (Measured, FingerTree)-import Data.Sequence (Seq)-import qualified Data.Set as Set-import Data.Set (Set)-import qualified Data.IntSet as IntSet-import Data.IntSet (IntSet)-import qualified Data.IntMap as IntMap-import Data.IntMap (IntMap)-import qualified Data.HashSet as HashSet-import Data.HashSet (HashSet)-import qualified Data.HashMap.Lazy as HashMap-import Data.HashMap.Lazy (HashMap)-import qualified Data.Map as Map-import Data.Map (Map)-import Data.List.NonEmpty (NonEmpty)-import qualified Data.List.NonEmpty as NonEmpty--- import Control.Parallel.Strategies (rseq, parMap)-import Data.Foldable (fold,foldMap)-import Data.Semigroup.Reducer---- | minimal definition 'mapReduce' or 'mapTo'-class Generator c where-  type Elem c-  mapReduce :: (Reducer e m, Monoid m) => (Elem c -> e) -> c -> m-  mapTo     :: (Reducer e m, Monoid m) => (Elem c -> e) -> m -> c -> m -  mapFrom   :: (Reducer e m, Monoid m) => (Elem c -> e) -> c -> m -> m--  mapReduce f = mapTo f mempty-  mapTo f m = mappend m . mapReduce f-  mapFrom f = mappend . mapReduce f---instance Generator Strict.ByteString where-  type Elem Strict.ByteString = Word8-  mapTo f = Strict.foldl' (\a -> snoc a . f)--instance Generator Lazy.ByteString where-  type Elem Lazy.ByteString = Word8-  -- mapReduce f = fold . parMap rseq (mapReduce f) . Lazy.toChunks-  mapReduce f = fold . map (mapReduce f) . Lazy.toChunks--instance Generator Text where-  type Elem Text = Char-  mapTo f = Text.foldl' (\a -> snoc a . f)--instance Generator [c] where-  type Elem [c] = c-  mapReduce f = foldr (cons . f) mempty--instance Generator (NonEmpty c) where-  type Elem (NonEmpty c) = c-  mapReduce f = mapReduce f . NonEmpty.toList--instance Measured v e => Generator (FingerTree v e) where-  type Elem (FingerTree v e) = e-  mapReduce f = foldMap (unit . f)--instance Generator (Seq c) where-  type Elem (Seq c) = c-  mapReduce f = foldMap (unit . f)--instance Generator IntSet where-  type Elem IntSet = Int-  mapReduce f = mapReduce f . IntSet.toList--instance Generator (HashSet a) where-  type Elem (HashSet a) = a-  mapReduce f = mapReduce f . HashSet.toList--instance Generator (Set a) where-  type Elem (Set a) = a-  mapReduce f = mapReduce f . Set.toList--instance Generator (IntMap v) where-  type Elem (IntMap v) = (Int,v)-  mapReduce f = mapReduce f . IntMap.toList--instance Generator (Map k v) where-  type Elem (Map k v) = (k,v) -  mapReduce f = mapReduce f . Map.toList--instance Generator (HashMap k v) where-  type Elem (HashMap k v) = (k, v)-  mapReduce f = mapReduce f . HashMap.toList--instance Ix i => Generator (Array i e) where-  type Elem (Array i e) = (i,e)-  mapReduce f = mapReduce f . assocs---- | a 'Generator' transformer that asks only for the keys of an indexed container-newtype Keys c = Keys { getKeys :: c } --instance Generator (Keys (IntMap v)) where-  type Elem (Keys (IntMap v)) = Int-  mapReduce f = mapReduce f . IntMap.keys . getKeys--instance Generator (Keys (Map k v)) where-  type Elem (Keys (Map k v)) = k-  mapReduce f = mapReduce f . Map.keys . getKeys--instance Ix i => Generator (Keys (Array i e)) where-  type Elem (Keys (Array i e)) = i-  mapReduce f = mapReduce f . range . bounds . getKeys---- | a 'Generator' transformer that asks only for the values contained in an indexed container-newtype Values c = Values { getValues :: c } --instance Generator (Values (IntMap v)) where-  type Elem (Values (IntMap v)) = v-  mapReduce f = mapReduce f . IntMap.elems . getValues--instance Generator (Values (Map k v)) where-  type Elem (Values (Map k v)) = v-  mapReduce f = mapReduce f . Map.elems . getValues--instance Ix i => Generator (Values (Array i e)) where-  type Elem (Values (Array i e)) = e-  mapReduce f = mapReduce f . elems . getValues---- | a 'Generator' transformer that treats 'Word8' as 'Char'--- This lets you use a 'ByteString' as a 'Char' source without going through a 'Monoid' transformer like 'UTF8'-newtype Char8 c = Char8 { getChar8 :: c } --instance Generator (Char8 Strict.ByteString) where-  type Elem (Char8 Strict.ByteString) = Char-  mapTo f m = Strict8.foldl' (\a -> snoc a . f) m . getChar8--instance Generator (Char8 Lazy.ByteString) where-  type Elem (Char8 Lazy.ByteString) = Char-  mapReduce f = fold . map (mapReduce f . Char8) . Lazy8.toChunks . getChar8---- | Apply a 'Reducer' directly to the elements of a 'Generator'-reduce :: (Generator c, Reducer (Elem c) m, Monoid m) => c -> m-reduce = mapReduce id-{-# SPECIALIZE reduce :: (Reducer Word8 m, Monoid m) => Strict.ByteString -> m #-}-{-# SPECIALIZE reduce :: (Reducer Word8 m, Monoid m) => Lazy.ByteString -> m #-}-{-# SPECIALIZE reduce :: (Reducer Char m, Monoid m) => Char8 Strict.ByteString -> m #-}-{-# SPECIALIZE reduce :: (Reducer Char m, Monoid m) => Char8 Lazy.ByteString -> m #-}-{-# SPECIALIZE reduce :: (Reducer c m, Monoid m) => [c] -> m #-}-{-# SPECIALIZE reduce :: (Generator (FingerTree v e), Reducer e m, Monoid m) => FingerTree v e -> m #-}-{-# SPECIALIZE reduce :: (Reducer Char m, Monoid m) => Text -> m #-}-{-# SPECIALIZE reduce :: (Reducer e m, Monoid m) => Seq e -> m #-}-{-# SPECIALIZE reduce :: (Reducer Int m, Monoid m) => IntSet -> m #-}-{-# SPECIALIZE reduce :: (Reducer a m, Monoid m) => Set a -> m #-}-{-# SPECIALIZE reduce :: (Reducer a m, Monoid m) => HashSet a -> m #-}-{-# SPECIALIZE reduce :: (Reducer (Int,v) m, Monoid m) => IntMap v -> m #-}-{-# SPECIALIZE reduce :: (Reducer (k,v) m, Monoid m) => Map k v -> m #-}-{-# SPECIALIZE reduce :: (Reducer (k,v) m, Monoid m) => HashMap k v -> m #-}-{-# SPECIALIZE reduce :: (Reducer Int m, Monoid m) => Keys (IntMap v) -> m #-}-{-# SPECIALIZE reduce :: (Reducer k m, Monoid m) => Keys (Map k v) -> m #-}-{-# SPECIALIZE reduce :: (Reducer v m, Monoid m) => Values (IntMap v) -> m #-}-{-# SPECIALIZE reduce :: (Reducer v m, Monoid m) => Values (Map k v) -> m #-}--mapReduceWith :: (Generator c, Reducer e m, Monoid m) => (m -> n) -> (Elem c -> e) -> c -> n-mapReduceWith f g = f . mapReduce g-{-# INLINE mapReduceWith #-}--reduceWith :: (Generator c, Reducer (Elem c) m, Monoid m) => (m -> n) -> c -> n-reduceWith f = f . reduce-{-# INLINE reduceWith #-}
− Data/Generator/Combinators.hs 
@@ -1,233 +0,0 @@-{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Generator.Combinators--- Copyright   :  (c) Edward Kmett 2009--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  non-portable (type families, MPTCs)------ Utilities for working with Monoids that conflict with names from the "Prelude",--- "Data.Foldable", "Control.Monad" or elsewhere. Intended to be imported qualified.------ > import Data.Generator.Combinators as Generator-----------------------------------------------------------------------------------module Data.Generator.Combinators-    (-    -- * Monadic Reduction-      mapM_-    , forM_-    , msum-    -- * Applicative Reduction-    , traverse_-    , for_-    , asum-    -- * Logical Reduction-    , and-    , or-    , any-    , all-    -- * Monoidal Reduction-    , foldMap-    , fold-    , toList -    -- * List-Like Reduction-    , concatMap-    , elem-    , filter-    , filterWith-    --, find-    , sum-    , product-    , notElem-    ) where--import Prelude hiding -  ( mapM_, any, all, elem, filter, concatMap, and, or-  , sum, product, notElem, replicate, cycle, repeat-  )-import Control.Applicative-import Control.Monad (MonadPlus)-import Data.Generator-import Data.Monoid (Monoid(..))-import Data.Semigroup (Sum(..), Product(..), All(..), Any(..), WrappedMonoid(..))-import Data.Semigroup.Applicative (Traversal(..))-import Data.Semigroup.Alternative (Alternate(..))-import Data.Semigroup.Monad (Action(..))-import Data.Semigroup.MonadPlus (MonadSum(..))-import Data.Semigroup.Reducer (Reducer(..))---- | Efficiently 'mapReduce' a 'Generator' using the 'Traversal' monoid. A specialized version of its namesake from "Data.Foldable"------ @---     'mapReduce' 'getTraversal'--- @-traverse_ :: (Generator c, Applicative f) => (Elem c -> f b) -> c -> f ()-traverse_ = mapReduceWith getTraversal-{-# INLINE traverse_ #-}-    --- | Convenience function as found in "Data.Foldable"------ @---     'flip' 'traverse_'--- @-for_ :: (Generator c, Applicative f) => c -> (Elem c -> f b) -> f ()-for_ = flip traverse_-{-# INLINE for_ #-}---- | The sum of a collection of actions, generalizing 'concat'------ @---    'reduceWith' 'getAlt'--- @ -asum :: (Generator c, Alternative f, f a ~ Elem c) => c -> f a-asum = reduceWith getAlternate-{-# INLINE asum #-}---- | Efficiently 'mapReduce' a 'Generator' using the 'Action' monoid. A specialized version of its namesake from "Data.Foldable" and "Control.Monad"--- --- @---    'mapReduceWith' 'getAction'--- @ -mapM_ :: (Generator c, Monad m) => (Elem c -> m b) -> c -> m ()-mapM_ = mapReduceWith getAction-{-# INLINE mapM_ #-}---- | Convenience function as found in "Data.Foldable" and "Control.Monad"------ @---     'flip' 'mapM_'--- @-forM_ :: (Generator c, Monad m) => c -> (Elem c -> m b) -> m ()-forM_ = flip mapM_-{-# INLINE forM_ #-}---- | The sum of a collection of actions, generalizing 'concat'------ @---     'reduceWith' 'getMonadSum'--- @-msum :: (Generator c, MonadPlus m, m a ~ Elem c) => c -> m a-msum = reduceWith getMonadSum-{-# INLINE msum #-}---- | Efficiently 'mapReduce' a 'Generator' using the 'WrappedMonoid' monoid. A specialized version of its namesake from "Data.Foldable"------ @---     'mapReduceWith' 'unwrapMonoid'--- @-foldMap :: (Monoid m, Generator c) => (Elem c -> m) -> c -> m-foldMap = mapReduceWith unwrapMonoid-{-# INLINE foldMap #-}---- | Type specialization of "foldMap" above-concatMap :: Generator c => (Elem c -> [b]) -> c -> [b]-concatMap = foldMap-{-# INLINE concatMap #-}---- | Efficiently 'reduce' a 'Generator' using the 'WrappedMonoid' monoid. A specialized version of its namesake from "Data.Foldable"------ @---     'reduceWith' 'unwrapMonoid'--- @-fold :: (Monoid m, Generator c, Elem c ~ m) => c -> m-fold = reduceWith unwrapMonoid-{-# INLINE fold #-}---- | Convert any 'Generator' to a list of its contents. Specialization of 'reduce'-toList :: Generator c => c -> [Elem c]-toList = reduce-{-# INLINE toList #-}---- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool'------ @---     'reduceWith' 'getAll'--- @-and :: (Generator c, Elem c ~ Bool) => c -> Bool-and = reduceWith getAll-{-# INLINE and #-}---- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool'------ @---     'reduceWith' 'getAny'--- @-or :: (Generator c, Elem c ~ Bool) => c -> Bool-or = reduceWith getAny-{-# INLINE or #-}---- | Efficiently 'mapReduce' any 'Generator' checking to see if any of its values match the supplied predicate------ @---     'mapReduceWith' 'getAny'--- @-any :: Generator c => (Elem c -> Bool) -> c -> Bool-any = mapReduceWith getAny-{-# INLINE any #-}---- | Efficiently 'mapReduce' any 'Generator' checking to see if all of its values match the supplied predicate------ @---     'mapReduceWith' 'getAll'--- @-all :: Generator c => (Elem c -> Bool) -> c -> Bool-all = mapReduceWith getAll-{-# INLINE all #-}---- | Efficiently sum over the members of any 'Generator'------ @---     'reduceWith' 'getSum'--- @-sum :: (Generator c, Num (Elem c)) => c -> Elem c-sum = reduceWith getSum-{-# INLINE sum #-}---- | Efficiently take the product of every member of a 'Generator'------ @---     'reduceWith' 'getProduct'--- @-product :: (Generator c, Num (Elem c)) => c -> Elem c-product = reduceWith getProduct-{-# INLINE product #-}---- | Check to see if 'any' member of the 'Generator' matches the supplied value-elem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool-elem = any . (==)-{-# INLINE elem #-}---- | Check to make sure that the supplied value is not a member of the 'Generator'-notElem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool-notElem x = not . elem x-{-# INLINE notElem #-}---- | Efficiently 'mapReduce' a subset of the elements in a 'Generator'-filter :: (Generator c, Reducer (Elem c) m, Monoid m) => (Elem c -> Bool) -> c -> m-filter p = foldMap f where-    f x | p x = unit x-        | otherwise = mempty-{-# INLINE filter #-}---- | Allows idiomatic specialization of filter by proving a function that will be used to transform the output-filterWith :: (Generator c, Reducer (Elem c) m, Monoid m) => (m -> n) -> (Elem c -> Bool) -> c -> n -filterWith f p = f . filter p-{-# INLINE filterWith #-}--{----- | A specialization of 'filter' using the 'First' 'Monoid', analogous to 'Data.List.find'------ @---     'filterWith' 'getFirst'--- @-find :: Generator c => (Elem c -> Bool) -> c -> Maybe (Elem c)-find = filterWith getFirst-{-# INLINE find #-}---}
− Data/Semigroup/Alt.hs 
@@ -1,38 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Semigroup.Alt--- Copyright   :  (c) Edward Kmett 2009-2011--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  non-portable (MPTCs)------ A semigroup for working 'Alt' or 'Plus' -----------------------------------------------------------------------------------module Data.Semigroup.Alt-    ( Alter(..)-    ) where--import Data.Functor.Plus-import Data.Monoid (Monoid(..))-import Data.Semigroup (Semigroup(..))-import Data.Semigroup.Reducer (Reducer(..))---- | A 'Alter' turns any 'Alt' instance into a 'Semigroup'.--newtype Alter f a = Alter { getAlter :: f a } -    deriving (Functor,Alt,Plus)--instance Alt f => Semigroup (Alter f a) where-    Alter a <> Alter b = Alter (a <!> b) --instance Plus f => Monoid (Alter f a) where-    mempty = zero-    Alter a `mappend` Alter b = Alter (a <!> b) --instance Alt f => Reducer (f a) (Alter f a) where-    unit = Alter
− Data/Semigroup/Alternative.hs 
@@ -1,39 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Semigroup.Alternative--- Copyright   :  (c) Edward Kmett 2009-2011--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  non-portable (MPTCs)------ A semigroup for working with 'Alternative' 'Functor's.-----------------------------------------------------------------------------------module Data.Semigroup.Alternative-    ( Alternate(..)-    ) where--import Control.Applicative-import Data.Monoid (Monoid(..))-import Data.Semigroup (Semigroup(..))-import Data.Semigroup.Reducer (Reducer(..))---- | A 'Alternate' turns any 'Alternative' instance into a 'Monoid'.--newtype Alternate f a = Alternate { getAlternate :: f a } -  deriving (Functor,Applicative,Alternative)--instance Alternative f => Semigroup (Alternate f a) where-  Alternate a <> Alternate b = Alternate (a <|> b)-   -instance Alternative f => Monoid (Alternate f a) where-  mempty = empty -  Alternate a `mappend` Alternate b = Alternate (a <|> b) --instance Alternative f => Reducer (f a) (Alternate f a) where-  unit = Alternate -
− Data/Semigroup/Applicative.hs 
@@ -1,61 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Semigroup.Applicative--- Copyright   :  (c) Edward Kmett 2009--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  non-portable (MPTCs)------ Semigroups for working with 'Applicative' 'Functor's.-----------------------------------------------------------------------------------module Data.Semigroup.Applicative -    ( Traversal(..)-    , Ap(..)-    ) where--import Control.Applicative-import Data.Monoid (Monoid(..))-import Data.Semigroup (Semigroup(..))-import Data.Semigroup.Reducer (Reducer(..))---- | A 'Traversal' uses an glues together 'Applicative' actions with (*>)---   in the manner of 'traverse_' from "Data.Foldable". Any values returned by ---   reduced actions are discarded.-newtype Traversal f = Traversal { getTraversal :: f () } --instance Applicative f => Semigroup (Traversal f) where-  Traversal a <> Traversal b = Traversal (a *> b)--instance Applicative f => Monoid (Traversal f) where-  mempty = Traversal (pure ())-  Traversal a `mappend` Traversal b = Traversal (a *> b)--instance Applicative f => Reducer (f a) (Traversal f) where-  unit = Traversal . (() <$)-  a `cons` Traversal b = Traversal (a *> b)-  Traversal a `snoc` b = Traversal (() <$ (a *> b))---- | Efficiently avoid needlessly rebinding when using 'snoc' on an action that already returns ()---   A rewrite rule automatically applies this when possible-snocTraversal :: Reducer (f ()) (Traversal f) => Traversal f -> f () -> Traversal f-snocTraversal a = (<>) a . Traversal-{-# RULES "unitTraversal" unit = Traversal #-}-{-# RULES "snocTraversal" snoc = snocTraversal #-}--newtype Ap f m = Ap { getApp :: f m } -  deriving (Functor,Applicative)--instance (Applicative f, Semigroup m) => Semigroup (Ap f m) where-  (<>) = liftA2 (<>)--instance (Applicative f, Monoid m) => Monoid (Ap f m) where-  mempty = pure mempty-  mappend = liftA2 mappend--instance (Applicative f, Reducer c m) => Reducer (f c) (Ap f m) where-  unit = fmap unit . Ap
− Data/Semigroup/Apply.hs 
@@ -1,55 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Semigroup.Apply--- Copyright   :  (c) Edward Kmett 2009-2011--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  non-portable (MPTCs)------ Semigroups for working with 'Apply'-----------------------------------------------------------------------------------module Data.Semigroup.Apply-    ( Trav(..)-    , App(..)-    ) where--import Data.Functor-import Data.Functor.Apply-import Data.Semigroup (Semigroup(..))-import Data.Semigroup.Reducer (Reducer(..))---- | A 'Trav' uses an glues together 'Applicative' actions with (*>)---   in the manner of 'traverse_' from "Data.Foldable". Any values returned by ---   reduced actions are discarded.-newtype Trav f = Trav { getTrav :: f () } --instance Apply f => Semigroup (Trav f) where-  Trav a <> Trav b = Trav (a .> b)--instance Apply f => Reducer (f a) (Trav f) where-    unit = Trav . (() <$)-    a `cons` Trav b = Trav (a .> b)-    Trav a `snoc` b = Trav (() <$ (a .> b))---- | Efficiently avoid needlessly rebinding when using 'snoc' on an action that already returns ()---   A rewrite rule automatically applies this when possible-snocTrav :: Reducer (f ()) (Trav f) => Trav f -> f () -> Trav f-snocTrav a = (<>) a . Trav-{-# RULES "unitTrav" unit = Trav #-}-{-# RULES "snocTrav" snoc = snocTrav #-}---- | A 'App' turns any 'Apply' wrapped around a 'Semigroup' into a 'Semigroup'--newtype App f m = App { getApp :: f m } -  deriving (Functor,Apply)--instance (Apply f, Semigroup m) => Semigroup (App f m) where-  (<>) = liftF2 (<>)--instance (Apply f, Reducer c m) => Reducer (f c) (App f m) where-  unit = fmap unit . App
− Data/Semigroup/Generator.hs 
@@ -1,71 +0,0 @@-{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, CPP #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Semigroup.Generator--- Copyright   :  (c) Edward Kmett 2009--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  portable------ A 'Generator1' @c@ is a possibly-specialized container, which contains values of --- type 'Elem' @c@, and which knows how to efficiently apply a 'Reducer' to extract--- an answer.------ 'Generator1' is to 'Generator' as 'Foldable1' is to 'Foldable'.--------------------------------------------------------------------------------module Data.Semigroup.Generator-  (-  -- * Generators-    Generator1(..)-  -- * Combinators-  , reduce1-  , mapReduceWith1-  , reduceWith1-  ) where---- import Data.Monoid (Monoid(..))--- import Data.Foldable (fold,foldMap)-import Data.List.NonEmpty-import Data.Semigroup (Semigroup(..)) -- , WrappedMonoid(..))-import Data.Semigroup.Foldable-import Data.Semigroup.Reducer-import Data.Generator---- | minimal definition 'mapReduce1' or 'mapTo1'-class Generator c => Generator1 c where-  mapReduce1 :: Reducer e m => (Elem c -> e) -> c -> m-  mapTo1     :: Reducer e m => (Elem c -> e) -> m -> c -> m -  mapFrom1   :: Reducer e m => (Elem c -> e) -> c -> m -> m--  mapTo1 f m = (<>) m . mapReduce1 f-  mapFrom1 f = (<>) . mapReduce1 f--instance Generator1 (NonEmpty e) where-  mapReduce1 f = foldMap1 (unit . f)--{--mapReduceDefault :: (Generator1 c, Reducer (Elem c) m, Monoid m) => (Elem c -> e) -> c -> m-mapReduceDefault f = unwrapMonoid . mapReduce1 f --mapToDefault :: (Generator1 c, Reducer (Elem c) m, Monoid m) => (Elem c -> e) -> m -> c -> m-mapToDefault f = unwrapMonoid . mapTo1 f --mapFromDefault :: (Generator1 c, Reducer (Elem c) m, Monoid m) => (Elem c -> e) -> m -> c -> m-mapFromDefault f = unwrapMonoid . mapFrom1 f --}---- | Apply a 'Reducer' directly to the elements of a 'Generator'-reduce1 :: (Generator1 c, Reducer (Elem c) m) => c -> m-reduce1 = mapReduce1 id-{-# SPECIALIZE reduce1 :: Reducer a m => NonEmpty a -> m #-}--mapReduceWith1 :: (Generator1 c, Reducer e m) => (m -> n) -> (Elem c -> e) -> c -> n-mapReduceWith1 f g = f . mapReduce1 g-{-# INLINE mapReduceWith1 #-}--reduceWith1 :: (Generator1 c, Reducer (Elem c) m) => (m -> n) -> c -> n-reduceWith1 f = f . reduce1-{-# INLINE reduceWith1 #-}
− Data/Semigroup/Instances.hs 
@@ -1,8 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Data.Semigroup.Instances where--import Data.FingerTree-import Data.Semigroup--instance Measured v a => Semigroup (FingerTree v a) where-  (<>) = mappend
− Data/Semigroup/Monad.hs 
@@ -1,61 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Semigroup.Monad--- Copyright   :  (c) Edward Kmett 2009--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  non-portable (MPTCs)------ Semigroups for working with 'Monad's.-----------------------------------------------------------------------------------module Data.Semigroup.Monad-    ( Action(..)-    , Mon(..)-    ) where--import Control.Monad (liftM, liftM2)-import Data.Monoid (Monoid(..))-import Data.Semigroup (Semigroup(..))-import Data.Semigroup.Reducer (Reducer(..))---- | A 'Action' uses an glues together monadic actions with (>>)---   in the manner of 'mapM_' from "Data.Foldable". Any values returned by ---   reduced actions are discarded.-newtype Action f = Action { getAction :: f () } --instance Monad f => Semigroup (Action f) where-  Action a <> Action b = Action (a >> b)--instance Monad f => Monoid (Action f) where-  mempty = Action (return ())-  Action a `mappend` Action b = Action (a >> b)--instance Monad f => Reducer (f a) (Action f) where-  unit a            = Action (a >> return ())-  a `cons` Action b = Action (a >> b)-  Action a `snoc` b = Action (a >> b >> return ())---- | Efficiently avoid needlessly rebinding when using 'snoc' on an action that already returns ()---   A rewrite rule automatically applies this when possible-snocAction :: Reducer (f ()) (Action f) => Action f -> f () -> Action f-snocAction a = (<>) a . Action-{-# RULES "unitAction" unit = Action #-}-{-# RULES "snocAction" snoc = snocAction #-}--newtype Mon f m = Mon { getMon :: f m } -  deriving (Monad)--instance (Monad f, Semigroup m) => Semigroup (Mon f m) where-  (<>) = liftM2 (<>)--instance (Monad f, Monoid m) => Monoid (Mon f m) where-  mempty = return mempty-  mappend = liftM2 mappend--instance (Monad f, Reducer c m) => Reducer (f c) (Mon f m) where-  unit = liftM unit . Mon
− Data/Semigroup/MonadPlus.hs 
@@ -1,39 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Semigroup.MonadPlus--- Copyright   :  (c) Edward Kmett 2009-2011--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  non-portable (MPTCs)------ A semigroup for working with instances of 'MonadPlus'-----------------------------------------------------------------------------------module Data.Semigroup.MonadPlus-    ( MonadSum(..)-    ) where--import Control.Monad (MonadPlus(..))-import Data.Monoid (Monoid(..))-import Data.Semigroup (Semigroup(..))-import Data.Semigroup.Reducer (Reducer(..))---- | A 'MonadSum' turns any 'MonadPlus' instance into a 'Monoid'.--newtype MonadSum f a = MonadSum { getMonadSum :: f a } -  deriving (Monad,MonadPlus)--instance MonadPlus f => Semigroup (MonadSum f a) where-  MonadSum a <> MonadSum b = MonadSum (mplus a b)-   -instance MonadPlus f => Monoid (MonadSum f a) where-  mempty = mzero-  MonadSum a `mappend` MonadSum b = MonadSum (mplus a b) --instance MonadPlus f => Reducer (f a) (MonadSum f a) where-  unit = MonadSum -
− Data/Semigroup/Reducer.hs 
@@ -1,221 +0,0 @@-{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving, TypeOperators, ScopedTypeVariables, CPP #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Semigroup.Reducer--- Copyright   :  (c) Edward Kmett 2009--- License     :  BSD3--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  non-portable (MPTCs)------ A @c@-'Reducer' is a 'Semigroup' with a canonical mapping from @c@ to the Semigroup.-----------------------------------------------------------------------------------module Data.Semigroup.Reducer-    ( Reducer(..)-    , foldMapReduce, foldMapReduce1-    , foldReduce, foldReduce1-    , pureUnit-    , returnUnit-    , Count(..)-    ) where--import Control.Applicative--import qualified Data.Monoid as Monoid-import Data.Semigroup as Semigroup-import Data.Semigroup.Foldable-import Data.Semigroup.Instances ()-import Data.Hashable-import Data.Foldable-import Data.FingerTree--import qualified Data.Sequence as Seq-import Data.Sequence (Seq)-import qualified Data.Set as Set-import Data.Set (Set)-import qualified Data.IntSet as IntSet-import Data.IntSet (IntSet)-import qualified Data.IntMap as IntMap-import Data.IntMap (IntMap)-import qualified Data.Map as Map-import Data.Map (Map)--#ifdef LANGUAGE_DeriveDataTypeable-import Data.Data-#endif----import Text.Parsec.Prim---- | This type may be best read infix. A @c `Reducer` m@ is a 'Semigroup' @m@ that maps--- values of type @c@ through @unit@ to values of type @m@. A @c@-'Reducer' may also--- supply operations which tack-on another @c@ to an existing 'Monoid' @m@ on the left--- or right. These specialized reductions may be more efficient in some scenarios--- and are used when appropriate by a 'Generator'. The names 'cons' and 'snoc' work--- by analogy to the synonymous operations in the list monoid.------ This class deliberately avoids functional-dependencies, so that () can be a @c@-Reducer--- for all @c@, and so many common reducers can work over multiple types, for instance,--- First and Last may reduce both @a@ and 'Maybe' @a@. Since a 'Generator' has a fixed element--- type, the input to the reducer is generally known and extracting from the monoid usually--- is sufficient to fix the result type. Combinators are available for most scenarios where--- this is not the case, and the few remaining cases can be handled by using an explicit --- type annotation.------ Minimal definition: 'unit' or 'snoc'-class Semigroup m => Reducer c m where-  -- | Convert a value into a 'Semigroup'-  unit :: c -> m -  -- | Append a value to a 'Semigroup' for use in left-to-right reduction-  snoc :: m -> c -> m-  -- | Prepend a value onto a 'Semigroup' for use during right-to-left reduction-  cons :: c -> m -> m --  snoc m = (<>) m . unit-  cons = (<>) . unit---- | Apply a 'Reducer' to a 'Foldable' container, after mapping the contents into a suitable form for reduction.-foldMapReduce :: (Foldable f, Monoid m, Reducer e m) => (a -> e) -> f a -> m-foldMapReduce f = foldMap (unit . f)--foldMapReduce1 :: (Foldable1 f, Reducer e m) => (a -> e) -> f a -> m-foldMapReduce1 f = foldMap1 (unit . f)---- | Apply a 'Reducer' to a 'Foldable' mapping each element through 'unit'-foldReduce :: (Foldable f, Monoid m, Reducer e m) => f e -> m-foldReduce = foldMap unit---- | Apply a 'Reducer' to a 'Foldable1' mapping each element through 'unit'-foldReduce1 :: (Foldable1 f, Reducer e m) => f e -> m-foldReduce1 = foldMap1 unit--returnUnit :: (Monad m, Reducer c n) => c -> m n -returnUnit = return . unit--pureUnit :: (Applicative f, Reducer c n) => c -> f n-pureUnit = pure . unit--newtype Count = Count { getCount :: Int } deriving -  ( Eq, Ord, Show, Read-#ifdef LANGUAGE_DeriveDataTypeable-  , Data, Typeable-#endif-  )--instance Hashable Count where-  hash = hash . getCount-  hashWithSalt n = hashWithSalt n . getCount--instance Semigroup Count where-  Count a <> Count b = Count (a + b)-  times1p n (Count a) = Count $ (fromIntegral n + 1) * a--instance Monoid Count where-  mempty = Count 0-  Count a `mappend` Count b = Count (a + b)--instance Reducer a Count where-  unit _ = Count 1-  Count n `snoc` _ = Count (n + 1)-  _ `cons` Count n = Count (n + 1)-  -instance (Reducer c m, Reducer c n) => Reducer c (m,n) where-  unit x = (unit x,unit x)-  (m,n) `snoc` x = (m `snoc` x, n `snoc` x)-  x `cons` (m,n) = (x `cons` m, x `cons` n)--instance (Reducer c m, Reducer c n, Reducer c o) => Reducer c (m,n,o) where-  unit x = (unit x,unit x, unit x)-  (m,n,o) `snoc` x = (m `snoc` x, n `snoc` x, o `snoc` x)-  x `cons` (m,n,o) = (x `cons` m, x `cons` n, x `cons` o)--instance (Reducer c m, Reducer c n, Reducer c o, Reducer c p) => Reducer c (m,n,o,p) where-  unit x = (unit x,unit x, unit x, unit x)-  (m,n,o,p) `snoc` x = (m `snoc` x, n `snoc` x, o `snoc` x, p `snoc` x)-  x `cons` (m,n,o,p) = (x `cons` m, x `cons` n, x `cons` o, x `cons` p)--instance Reducer c [c] where-  unit = return-  cons = (:)-  xs `snoc` x = xs ++ [x]--instance Reducer c () where-  unit _ = ()-  _ `snoc` _ = ()-  _ `cons` _ = ()--instance Reducer Bool Any where-  unit = Any--instance Reducer Bool All where-  unit = All--instance Reducer (a -> a) (Endo a) where-  unit = Endo--instance Semigroup a => Reducer a (Dual a) where-  unit = Dual-    -instance Num a => Reducer a (Sum a) where-  unit = Sum--instance Num a => Reducer a (Product a) where-  unit = Product--instance Ord a => Reducer a (Min a) where-  unit = Min--instance Ord a => Reducer a (Max a) where-  unit = Max--instance Reducer (Maybe a) (Monoid.First a) where-  unit = Monoid.First--instance Reducer a (Semigroup.First a) where-  unit = Semigroup.First--instance Reducer (Maybe a) (Monoid.Last a) where-  unit = Monoid.Last--instance Reducer a (Semigroup.Last a) where-  unit = Semigroup.Last--instance Measured v a => Reducer a (FingerTree v a) where-  unit = singleton-  cons = (<|)-  snoc = (|>) ----instance (Stream s m t, Reducer c a) => Reducer c (ParsecT s u m a) where---    unit = return . unit--instance Reducer a (Seq a) where-  unit = Seq.singleton-  cons = (Seq.<|)-  snoc = (Seq.|>)--instance Reducer Int IntSet where-  unit = IntSet.singleton-  cons = IntSet.insert-  snoc = flip IntSet.insert -- left bias irrelevant--instance Ord a => Reducer a (Set a) where-  unit = Set.singleton-  cons = Set.insert-  -- pedantic about order in case 'Eq' doesn't implement structural equality-  snoc s m | Set.member m s = s -           | otherwise = Set.insert m s--instance Reducer (Int, v) (IntMap v) where-  unit = uncurry IntMap.singleton-  cons = uncurry IntMap.insert-  snoc = flip . uncurry . IntMap.insertWith $ const id--instance Ord k => Reducer (k, v) (Map k v) where-  unit = uncurry Map.singleton-  cons = uncurry Map.insert-  snoc = flip . uncurry . Map.insertWith $ const id--instance Monoid m => Reducer m (WrappedMonoid m) where-  unit = WrapMonoid
− Data/Semigroup/Reducer/With.hs 
@@ -1,59 +0,0 @@-{-# LANGUAGE UndecidableInstances, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Semigroup.Reducer.With--- Copyright   :  (c) Edward Kmett 2009-2011--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  non-portable (MPTCs)-----------------------------------------------------------------------------------module Data.Semigroup.Reducer.With-    ( WithReducer(..)-    ) where--import Control.Applicative-import Data.FingerTree-import Data.Foldable-import Data.Traversable-import Data.Hashable-import Data.Monoid-import Data.Semigroup.Reducer-import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import Data.Semigroup.Instances ()---- | If @m@ is a @c@-"Reducer", then m is @(c `WithReducer` m)@-"Reducer"---   This can be used to quickly select a "Reducer" for use as a 'FingerTree'---   'measure'.--newtype WithReducer m c = WithReducer { withoutReducer :: c } -  deriving (Eq, Ord, Show, Read)--instance Hashable c => Hashable (WithReducer m c) where-  hash = hash . withoutReducer-  hashWithSalt n = hashWithSalt n . withoutReducer--instance Functor (WithReducer m) where-  fmap f = WithReducer . f . withoutReducer--instance Foldable (WithReducer m) where-  foldMap f = f . withoutReducer--instance Traversable (WithReducer m) where-  traverse f (WithReducer a) = WithReducer <$> f a--instance Foldable1 (WithReducer m) where-  foldMap1 f = f . withoutReducer--instance Traversable1 (WithReducer m) where-  traverse1 f (WithReducer a) = WithReducer <$> f a--instance Reducer c m => Reducer (WithReducer m c) m where-    unit = unit . withoutReducer --instance (Monoid m, Reducer c m) => Measured m (WithReducer m c) where-    measure = unit . withoutReducer
− Data/Semigroup/Self.hs 
@@ -1,51 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Semigroup.Self--- Copyright   :  (c) Edward Kmett 2009--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  portable------ A simple 'Monoid' transformer that takes a 'Monoid' m and produces a new @m@-Reducer named 'Self' @m@--- --- This is useful when you have a generator that already contains monoidal values or someone supplies--- the map to the monoid in the form of a function rather than as a "Reducer" instance. You can just--- @'getSelf' . `reduce`@ or @'getSelf' . 'mapReduce' f@ in those scenarios. These behaviors are encapsulated --- into the 'fold' and 'foldMap' combinators in "Data.Monoid.Combinators" respectively.-----------------------------------------------------------------------------------module Data.Semigroup.Self-    ( Self(..)-    )  where--import Control.Applicative-import Data.Foldable-import Data.Traversable-import Data.Semigroup-import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import Data.Semigroup.Reducer (Reducer(..))--newtype Self m = Self { getSelf :: m } deriving (Semigroup, Monoid)--instance Semigroup m => Reducer m (Self m) where-  unit = Self--instance Functor Self where-  fmap f (Self x) = Self (f x)--instance Foldable Self where-  foldMap f (Self x) = f x--instance Traversable Self where-  traverse f (Self x) = Self <$> f x--instance Foldable1 Self where-  foldMap1 f (Self x) = f x--instance Traversable1 Self where-  traverse1 f (Self x) = Self <$> f x
− Data/Semigroup/Union.hs 
@@ -1,174 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, GeneralizedNewtypeDeriving #-}-module Data.Semigroup.Union-    ( module Data.Semigroup.Reducer-    -- * Unions of Containers-    , HasUnion(..)-    , HasUnion0(..)-    , Union(Union,getUnion)-    -- * Unions of Containers of Semigroups-    , HasUnionWith(..)-    , HasUnionWith0(..)-    , UnionWith(UnionWith,getUnionWith)-    ) where--import qualified Data.HashMap.Lazy as HashMap-import Data.HashMap.Lazy (HashMap)--import qualified Data.IntMap as IntMap-import Data.IntMap (IntMap)--import qualified Data.IntSet as IntSet-import Data.IntSet (IntSet)--import qualified Data.HashSet as HashSet-import Data.HashSet (HashSet)--import qualified Data.Map as Map-import Data.Map (Map)--import qualified Data.Set as Set-import Data.Set (Set)--import qualified Data.List as List--import Data.Hashable-import Data.Functor-import Data.Foldable-import Data.Traversable-import Data.Semigroup-import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import Data.Semigroup.Reducer-import Data.Semigroup.Instances ()---- | A Container suitable for the 'Union' 'Monoid'-class HasUnion f where-  union :: f -> f -> f--{-# SPECIALIZE union :: IntMap a -> IntMap a -> IntMap a #-}-{-# SPECIALIZE union :: Ord k => Map k a -> Map k a -> Map k a #-}-{-# SPECIALIZE union :: Eq a => [a] -> [a] -> [a] #-}-{-# SPECIALIZE union :: Ord a => Set a -> Set a -> Set a #-}-{-# SPECIALIZE union :: IntSet -> IntSet -> IntSet #-}-{-# SPECIALIZE union :: Eq a => HashSet a -> HashSet a -> HashSet a #-}-{-# SPECIALIZE union :: Eq k => HashMap k a -> HashMap k a -> HashMap k a #-}--class HasUnion f => HasUnion0 f where-  empty :: f--instance HasUnion (IntMap a) where-  union = IntMap.union--instance HasUnion0 (IntMap a) where-  empty = IntMap.empty--instance (Eq k, Hashable k) => HasUnion (HashMap k a) where-  union = HashMap.union--instance (Eq k, Hashable k) => HasUnion0 (HashMap k a) where-  empty = HashMap.empty--instance Ord k => HasUnion (Map k a) where-  union = Map.union--instance Ord k => HasUnion0 (Map k a) where-  empty = Map.empty--instance Eq a => HasUnion [a] where-  union = List.union--instance Eq a => HasUnion0 [a] where-  empty = []--instance Ord a => HasUnion (Set a) where-  union = Set.union--instance Ord a => HasUnion0 (Set a) where-  empty = Set.empty--instance HasUnion IntSet where-  union = IntSet.union--instance HasUnion0 IntSet where-  empty = IntSet.empty--instance (Eq a, Hashable a) => HasUnion (HashSet a) where-  union = HashSet.union--instance (Eq a, Hashable a) => HasUnion0 (HashSet a) where-  empty = HashSet.empty----- | The 'Monoid' @('union','empty')@-newtype Union f = Union { getUnion :: f } -  deriving (Eq,Ord,Show,Read)--instance HasUnion f => Semigroup (Union f) where-  Union a <> Union b = Union (a `union` b)--instance HasUnion0 f => Monoid (Union f) where-  Union a `mappend` Union b = Union (a `union` b)-  mempty = Union empty--instance HasUnion f => Reducer f (Union f) where-  unit = Union--instance Functor Union where-  fmap f (Union a) = Union (f a)--instance Foldable Union where- foldMap f (Union a) = f a--instance Traversable Union where-  traverse f (Union a) = Union <$> f a--instance Foldable1 Union where-  foldMap1 f (Union a) = f a--instance Traversable1 Union where-  traverse1 f (Union a) = Union <$> f a---- | Polymorphic containers that we can supply an operation to handle unions with-class Functor f => HasUnionWith f where-  unionWith :: (a -> a -> a) -> f a -> f a -> f a--{-# SPECIALIZE unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a #-}-{-# SPECIALIZE unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a #-}-{-# SPECIALIZE unionWith :: Eq k => (a -> a -> a) -> HashMap k a -> HashMap k a -> HashMap k a #-}--class HasUnionWith f => HasUnionWith0 f where-  emptyWith :: f a --instance HasUnionWith IntMap where -  unionWith = IntMap.unionWith--instance HasUnionWith0 IntMap where -  emptyWith = IntMap.empty--instance Ord k => HasUnionWith (Map k) where -  unionWith = Map.unionWith--instance Ord k => HasUnionWith0 (Map k) where -  emptyWith = Map.empty---- TODO: add unionWith to unordered-containers----instance Eq k => HasUnionWith (HashMap k) where ---  unionWith = HashMap.unionWith----instance Ord k => HasUnionWith0 (Map k) where ---  emptyWith = Map.empty---- | The 'Monoid' @('unionWith mappend','empty')@ for containers full of monoids.-newtype UnionWith f m = UnionWith { getUnionWith :: f m } --instance (HasUnionWith f, Semigroup m) => Semigroup (UnionWith f m) where-    UnionWith a <> UnionWith b = UnionWith (unionWith (<>) a b)--instance (HasUnionWith0 f, Monoid m) => Monoid (UnionWith f m) where-    mempty = UnionWith emptyWith-    UnionWith a `mappend` UnionWith b = UnionWith (unionWith mappend a b)--instance (HasUnionWith f, Semigroup m, Monoid m) => Reducer (f m) (UnionWith f m) where-    unit = UnionWith-
reducers.cabal view
@@ -1,6 +1,6 @@ name:          reducers category:      Data, Math, Numerical, Semigroups-version:       0.3.0.1+version:       3.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -20,6 +20,8 @@   location: git://github.com/ekmett/reducers.git  library+  hs-source-dirs: src+   build-depends:     base                   >= 4        && < 5,     array                  >= 0.3      && < 0.5,@@ -31,12 +33,11 @@     text                   >= 0.11.1.5 && < 0.12,     unordered-containers   >= 0.1.4    && < 0.3,     semigroups             >= 0.8.3.1  && < 0.9,-    semigroupoids          >= 1.3.1.2  && < 1.4,-    comonad                >= 1.1.1.5  && < 1.2,-    pointed                >= 2.1.0.1  && < 2.2,-    keys                   >= 2.1.3.1  && < 2.2+    semigroupoids          >= 3.0      && < 3.1,+    comonad                >= 3.0      && < 3.1,+    pointed                >= 3.0      && < 3.1,+    keys                   >= 3.0      && < 3.1 ---  parallel               >= 3.2      && < 3.3,   exposed-modules:     Data.Generator     Data.Generator.Combinators
+ src/Data/Generator.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE UndecidableInstances, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, CPP #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Generator+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- A 'Generator' @c@ is a possibly-specialized container, which contains values of +-- type 'Elem' @c@, and which knows how to efficiently apply a 'Reducer' to extract+-- an answer.+--+-- Since a 'Generator' is not polymorphic in its contents, it is more specialized+-- than "Data.Foldable.Foldable", and a 'Reducer' may supply efficient left-to-right+-- and right-to-left reduction strategies that a 'Generator' may avail itself of.+-----------------------------------------------------------------------------++module Data.Generator+  (+  -- * Generators+    Generator(..)+  -- * Generator Transformers+  , Keys(Keys, getKeys)+  , Values(Values, getValues)+  , Char8(Char8, getChar8)+  -- * Combinators+  , reduce+  , mapReduceWith+  , reduceWith+  ) where++import Data.Monoid (Monoid, mappend, mempty)++import Data.Array +import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.ByteString as Strict (ByteString, foldl')+import qualified Data.ByteString.Char8 as Strict8 (foldl')+import qualified Data.ByteString.Lazy as Lazy (ByteString, toChunks)+import qualified Data.ByteString.Lazy.Char8 as Lazy8 (toChunks)+import Data.Word (Word8)+import Data.FingerTree (Measured, FingerTree)+import Data.Sequence (Seq)+import qualified Data.Set as Set+import Data.Set (Set)+import qualified Data.IntSet as IntSet+import Data.IntSet (IntSet)+import qualified Data.IntMap as IntMap+import Data.IntMap (IntMap)+import qualified Data.HashSet as HashSet+import Data.HashSet (HashSet)+import qualified Data.HashMap.Lazy as HashMap+import Data.HashMap.Lazy (HashMap)+import qualified Data.Map as Map+import Data.Map (Map)+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NonEmpty+-- import Control.Parallel.Strategies (rseq, parMap)+import Data.Foldable (fold,foldMap)+import Data.Semigroup.Reducer++-- | minimal definition 'mapReduce' or 'mapTo'+class Generator c where+  type Elem c+  mapReduce :: (Reducer e m, Monoid m) => (Elem c -> e) -> c -> m+  mapTo     :: (Reducer e m, Monoid m) => (Elem c -> e) -> m -> c -> m +  mapFrom   :: (Reducer e m, Monoid m) => (Elem c -> e) -> c -> m -> m++  mapReduce f = mapTo f mempty+  mapTo f m = mappend m . mapReduce f+  mapFrom f = mappend . mapReduce f+++instance Generator Strict.ByteString where+  type Elem Strict.ByteString = Word8+  mapTo f = Strict.foldl' (\a -> snoc a . f)++instance Generator Lazy.ByteString where+  type Elem Lazy.ByteString = Word8+  -- mapReduce f = fold . parMap rseq (mapReduce f) . Lazy.toChunks+  mapReduce f = fold . map (mapReduce f) . Lazy.toChunks++instance Generator Text where+  type Elem Text = Char+  mapTo f = Text.foldl' (\a -> snoc a . f)++instance Generator [c] where+  type Elem [c] = c+  mapReduce f = foldr (cons . f) mempty++instance Generator (NonEmpty c) where+  type Elem (NonEmpty c) = c+  mapReduce f = mapReduce f . NonEmpty.toList++instance Measured v e => Generator (FingerTree v e) where+  type Elem (FingerTree v e) = e+  mapReduce f = foldMap (unit . f)++instance Generator (Seq c) where+  type Elem (Seq c) = c+  mapReduce f = foldMap (unit . f)++instance Generator IntSet where+  type Elem IntSet = Int+  mapReduce f = mapReduce f . IntSet.toList++instance Generator (HashSet a) where+  type Elem (HashSet a) = a+  mapReduce f = mapReduce f . HashSet.toList++instance Generator (Set a) where+  type Elem (Set a) = a+  mapReduce f = mapReduce f . Set.toList++instance Generator (IntMap v) where+  type Elem (IntMap v) = (Int,v)+  mapReduce f = mapReduce f . IntMap.toList++instance Generator (Map k v) where+  type Elem (Map k v) = (k,v) +  mapReduce f = mapReduce f . Map.toList++instance Generator (HashMap k v) where+  type Elem (HashMap k v) = (k, v)+  mapReduce f = mapReduce f . HashMap.toList++instance Ix i => Generator (Array i e) where+  type Elem (Array i e) = (i,e)+  mapReduce f = mapReduce f . assocs++-- | a 'Generator' transformer that asks only for the keys of an indexed container+newtype Keys c = Keys { getKeys :: c } ++instance Generator (Keys (IntMap v)) where+  type Elem (Keys (IntMap v)) = Int+  mapReduce f = mapReduce f . IntMap.keys . getKeys++instance Generator (Keys (Map k v)) where+  type Elem (Keys (Map k v)) = k+  mapReduce f = mapReduce f . Map.keys . getKeys++instance Ix i => Generator (Keys (Array i e)) where+  type Elem (Keys (Array i e)) = i+  mapReduce f = mapReduce f . range . bounds . getKeys++-- | a 'Generator' transformer that asks only for the values contained in an indexed container+newtype Values c = Values { getValues :: c } ++instance Generator (Values (IntMap v)) where+  type Elem (Values (IntMap v)) = v+  mapReduce f = mapReduce f . IntMap.elems . getValues++instance Generator (Values (Map k v)) where+  type Elem (Values (Map k v)) = v+  mapReduce f = mapReduce f . Map.elems . getValues++instance Ix i => Generator (Values (Array i e)) where+  type Elem (Values (Array i e)) = e+  mapReduce f = mapReduce f . elems . getValues++-- | a 'Generator' transformer that treats 'Word8' as 'Char'+-- This lets you use a 'ByteString' as a 'Char' source without going through a 'Monoid' transformer like 'UTF8'+newtype Char8 c = Char8 { getChar8 :: c } ++instance Generator (Char8 Strict.ByteString) where+  type Elem (Char8 Strict.ByteString) = Char+  mapTo f m = Strict8.foldl' (\a -> snoc a . f) m . getChar8++instance Generator (Char8 Lazy.ByteString) where+  type Elem (Char8 Lazy.ByteString) = Char+  mapReduce f = fold . map (mapReduce f . Char8) . Lazy8.toChunks . getChar8++-- | Apply a 'Reducer' directly to the elements of a 'Generator'+reduce :: (Generator c, Reducer (Elem c) m, Monoid m) => c -> m+reduce = mapReduce id+{-# SPECIALIZE reduce :: (Reducer Word8 m, Monoid m) => Strict.ByteString -> m #-}+{-# SPECIALIZE reduce :: (Reducer Word8 m, Monoid m) => Lazy.ByteString -> m #-}+{-# SPECIALIZE reduce :: (Reducer Char m, Monoid m) => Char8 Strict.ByteString -> m #-}+{-# SPECIALIZE reduce :: (Reducer Char m, Monoid m) => Char8 Lazy.ByteString -> m #-}+{-# SPECIALIZE reduce :: (Reducer c m, Monoid m) => [c] -> m #-}+{-# SPECIALIZE reduce :: (Generator (FingerTree v e), Reducer e m, Monoid m) => FingerTree v e -> m #-}+{-# SPECIALIZE reduce :: (Reducer Char m, Monoid m) => Text -> m #-}+{-# SPECIALIZE reduce :: (Reducer e m, Monoid m) => Seq e -> m #-}+{-# SPECIALIZE reduce :: (Reducer Int m, Monoid m) => IntSet -> m #-}+{-# SPECIALIZE reduce :: (Reducer a m, Monoid m) => Set a -> m #-}+{-# SPECIALIZE reduce :: (Reducer a m, Monoid m) => HashSet a -> m #-}+{-# SPECIALIZE reduce :: (Reducer (Int,v) m, Monoid m) => IntMap v -> m #-}+{-# SPECIALIZE reduce :: (Reducer (k,v) m, Monoid m) => Map k v -> m #-}+{-# SPECIALIZE reduce :: (Reducer (k,v) m, Monoid m) => HashMap k v -> m #-}+{-# SPECIALIZE reduce :: (Reducer Int m, Monoid m) => Keys (IntMap v) -> m #-}+{-# SPECIALIZE reduce :: (Reducer k m, Monoid m) => Keys (Map k v) -> m #-}+{-# SPECIALIZE reduce :: (Reducer v m, Monoid m) => Values (IntMap v) -> m #-}+{-# SPECIALIZE reduce :: (Reducer v m, Monoid m) => Values (Map k v) -> m #-}++mapReduceWith :: (Generator c, Reducer e m, Monoid m) => (m -> n) -> (Elem c -> e) -> c -> n+mapReduceWith f g = f . mapReduce g+{-# INLINE mapReduceWith #-}++reduceWith :: (Generator c, Reducer (Elem c) m, Monoid m) => (m -> n) -> c -> n+reduceWith f = f . reduce+{-# INLINE reduceWith #-}
+ src/Data/Generator/Combinators.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Generator.Combinators+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable (type families, MPTCs)+--+-- Utilities for working with Monoids that conflict with names from the "Prelude",+-- "Data.Foldable", "Control.Monad" or elsewhere. Intended to be imported qualified.+--+-- > import Data.Generator.Combinators as Generator+--+-----------------------------------------------------------------------------++module Data.Generator.Combinators+    (+    -- * Monadic Reduction+      mapM_+    , forM_+    , msum+    -- * Applicative Reduction+    , traverse_+    , for_+    , asum+    -- * Logical Reduction+    , and+    , or+    , any+    , all+    -- * Monoidal Reduction+    , foldMap+    , fold+    , toList +    -- * List-Like Reduction+    , concatMap+    , elem+    , filter+    , filterWith+    --, find+    , sum+    , product+    , notElem+    ) where++import Prelude hiding +  ( mapM_, any, all, elem, filter, concatMap, and, or+  , sum, product, notElem, replicate, cycle, repeat+  )+import Control.Applicative+import Control.Monad (MonadPlus)+import Data.Generator+import Data.Monoid (Monoid(..))+import Data.Semigroup (Sum(..), Product(..), All(..), Any(..), WrappedMonoid(..))+import Data.Semigroup.Applicative (Traversal(..))+import Data.Semigroup.Alternative (Alternate(..))+import Data.Semigroup.Monad (Action(..))+import Data.Semigroup.MonadPlus (MonadSum(..))+import Data.Semigroup.Reducer (Reducer(..))++-- | Efficiently 'mapReduce' a 'Generator' using the 'Traversal' monoid. A specialized version of its namesake from "Data.Foldable"+--+-- @+--     'mapReduce' 'getTraversal'+-- @+traverse_ :: (Generator c, Applicative f) => (Elem c -> f b) -> c -> f ()+traverse_ = mapReduceWith getTraversal+{-# INLINE traverse_ #-}+    +-- | Convenience function as found in "Data.Foldable"+--+-- @+--     'flip' 'traverse_'+-- @+for_ :: (Generator c, Applicative f) => c -> (Elem c -> f b) -> f ()+for_ = flip traverse_+{-# INLINE for_ #-}++-- | The sum of a collection of actions, generalizing 'concat'+--+-- @+--    'reduceWith' 'getAlt'+-- @ +asum :: (Generator c, Alternative f, f a ~ Elem c) => c -> f a+asum = reduceWith getAlternate+{-# INLINE asum #-}++-- | Efficiently 'mapReduce' a 'Generator' using the 'Action' monoid. A specialized version of its namesake from "Data.Foldable" and "Control.Monad"+-- +-- @+--    'mapReduceWith' 'getAction'+-- @ +mapM_ :: (Generator c, Monad m) => (Elem c -> m b) -> c -> m ()+mapM_ = mapReduceWith getAction+{-# INLINE mapM_ #-}++-- | Convenience function as found in "Data.Foldable" and "Control.Monad"+--+-- @+--     'flip' 'mapM_'+-- @+forM_ :: (Generator c, Monad m) => c -> (Elem c -> m b) -> m ()+forM_ = flip mapM_+{-# INLINE forM_ #-}++-- | The sum of a collection of actions, generalizing 'concat'+--+-- @+--     'reduceWith' 'getMonadSum'+-- @+msum :: (Generator c, MonadPlus m, m a ~ Elem c) => c -> m a+msum = reduceWith getMonadSum+{-# INLINE msum #-}++-- | Efficiently 'mapReduce' a 'Generator' using the 'WrappedMonoid' monoid. A specialized version of its namesake from "Data.Foldable"+--+-- @+--     'mapReduceWith' 'unwrapMonoid'+-- @+foldMap :: (Monoid m, Generator c) => (Elem c -> m) -> c -> m+foldMap = mapReduceWith unwrapMonoid+{-# INLINE foldMap #-}++-- | Type specialization of "foldMap" above+concatMap :: Generator c => (Elem c -> [b]) -> c -> [b]+concatMap = foldMap+{-# INLINE concatMap #-}++-- | Efficiently 'reduce' a 'Generator' using the 'WrappedMonoid' monoid. A specialized version of its namesake from "Data.Foldable"+--+-- @+--     'reduceWith' 'unwrapMonoid'+-- @+fold :: (Monoid m, Generator c, Elem c ~ m) => c -> m+fold = reduceWith unwrapMonoid+{-# INLINE fold #-}++-- | Convert any 'Generator' to a list of its contents. Specialization of 'reduce'+toList :: Generator c => c -> [Elem c]+toList = reduce+{-# INLINE toList #-}++-- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool'+--+-- @+--     'reduceWith' 'getAll'+-- @+and :: (Generator c, Elem c ~ Bool) => c -> Bool+and = reduceWith getAll+{-# INLINE and #-}++-- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool'+--+-- @+--     'reduceWith' 'getAny'+-- @+or :: (Generator c, Elem c ~ Bool) => c -> Bool+or = reduceWith getAny+{-# INLINE or #-}++-- | Efficiently 'mapReduce' any 'Generator' checking to see if any of its values match the supplied predicate+--+-- @+--     'mapReduceWith' 'getAny'+-- @+any :: Generator c => (Elem c -> Bool) -> c -> Bool+any = mapReduceWith getAny+{-# INLINE any #-}++-- | Efficiently 'mapReduce' any 'Generator' checking to see if all of its values match the supplied predicate+--+-- @+--     'mapReduceWith' 'getAll'+-- @+all :: Generator c => (Elem c -> Bool) -> c -> Bool+all = mapReduceWith getAll+{-# INLINE all #-}++-- | Efficiently sum over the members of any 'Generator'+--+-- @+--     'reduceWith' 'getSum'+-- @+sum :: (Generator c, Num (Elem c)) => c -> Elem c+sum = reduceWith getSum+{-# INLINE sum #-}++-- | Efficiently take the product of every member of a 'Generator'+--+-- @+--     'reduceWith' 'getProduct'+-- @+product :: (Generator c, Num (Elem c)) => c -> Elem c+product = reduceWith getProduct+{-# INLINE product #-}++-- | Check to see if 'any' member of the 'Generator' matches the supplied value+elem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool+elem = any . (==)+{-# INLINE elem #-}++-- | Check to make sure that the supplied value is not a member of the 'Generator'+notElem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool+notElem x = not . elem x+{-# INLINE notElem #-}++-- | Efficiently 'mapReduce' a subset of the elements in a 'Generator'+filter :: (Generator c, Reducer (Elem c) m, Monoid m) => (Elem c -> Bool) -> c -> m+filter p = foldMap f where+    f x | p x = unit x+        | otherwise = mempty+{-# INLINE filter #-}++-- | Allows idiomatic specialization of filter by proving a function that will be used to transform the output+filterWith :: (Generator c, Reducer (Elem c) m, Monoid m) => (m -> n) -> (Elem c -> Bool) -> c -> n +filterWith f p = f . filter p+{-# INLINE filterWith #-}++{-++-- | A specialization of 'filter' using the 'First' 'Monoid', analogous to 'Data.List.find'+--+-- @+--     'filterWith' 'getFirst'+-- @+find :: Generator c => (Elem c -> Bool) -> c -> Maybe (Elem c)+find = filterWith getFirst+{-# INLINE find #-}++-}
+ src/Data/Semigroup/Alt.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup.Alt+-- Copyright   :  (c) Edward Kmett 2009-2011+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- A semigroup for working 'Alt' or 'Plus' +--+-----------------------------------------------------------------------------++module Data.Semigroup.Alt+    ( Alter(..)+    ) where++import Data.Functor.Plus+import Data.Monoid (Monoid(..))+import Data.Semigroup (Semigroup(..))+import Data.Semigroup.Reducer (Reducer(..))++-- | A 'Alter' turns any 'Alt' instance into a 'Semigroup'.++newtype Alter f a = Alter { getAlter :: f a } +    deriving (Functor,Alt,Plus)++instance Alt f => Semigroup (Alter f a) where+    Alter a <> Alter b = Alter (a <!> b) ++instance Plus f => Monoid (Alter f a) where+    mempty = zero+    Alter a `mappend` Alter b = Alter (a <!> b) ++instance Alt f => Reducer (f a) (Alter f a) where+    unit = Alter
+ src/Data/Semigroup/Alternative.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup.Alternative+-- Copyright   :  (c) Edward Kmett 2009-2011+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- A semigroup for working with 'Alternative' 'Functor's.+--+-----------------------------------------------------------------------------++module Data.Semigroup.Alternative+    ( Alternate(..)+    ) where++import Control.Applicative+import Data.Monoid (Monoid(..))+import Data.Semigroup (Semigroup(..))+import Data.Semigroup.Reducer (Reducer(..))++-- | A 'Alternate' turns any 'Alternative' instance into a 'Monoid'.++newtype Alternate f a = Alternate { getAlternate :: f a } +  deriving (Functor,Applicative,Alternative)++instance Alternative f => Semigroup (Alternate f a) where+  Alternate a <> Alternate b = Alternate (a <|> b)+   +instance Alternative f => Monoid (Alternate f a) where+  mempty = empty +  Alternate a `mappend` Alternate b = Alternate (a <|> b) ++instance Alternative f => Reducer (f a) (Alternate f a) where+  unit = Alternate +
+ src/Data/Semigroup/Applicative.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup.Applicative+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- Semigroups for working with 'Applicative' 'Functor's.+--+-----------------------------------------------------------------------------++module Data.Semigroup.Applicative +    ( Traversal(..)+    , Ap(..)+    ) where++import Control.Applicative+import Data.Monoid (Monoid(..))+import Data.Semigroup (Semigroup(..))+import Data.Semigroup.Reducer (Reducer(..))++-- | A 'Traversal' uses an glues together 'Applicative' actions with (*>)+--   in the manner of 'traverse_' from "Data.Foldable". Any values returned by +--   reduced actions are discarded.+newtype Traversal f = Traversal { getTraversal :: f () } ++instance Applicative f => Semigroup (Traversal f) where+  Traversal a <> Traversal b = Traversal (a *> b)++instance Applicative f => Monoid (Traversal f) where+  mempty = Traversal (pure ())+  Traversal a `mappend` Traversal b = Traversal (a *> b)++instance Applicative f => Reducer (f a) (Traversal f) where+  unit = Traversal . (() <$)+  a `cons` Traversal b = Traversal (a *> b)+  Traversal a `snoc` b = Traversal (() <$ (a *> b))++-- | Efficiently avoid needlessly rebinding when using 'snoc' on an action that already returns ()+--   A rewrite rule automatically applies this when possible+snocTraversal :: Reducer (f ()) (Traversal f) => Traversal f -> f () -> Traversal f+snocTraversal a = (<>) a . Traversal+{-# RULES "unitTraversal" unit = Traversal #-}+{-# RULES "snocTraversal" snoc = snocTraversal #-}++newtype Ap f m = Ap { getApp :: f m } +  deriving (Functor,Applicative)++instance (Applicative f, Semigroup m) => Semigroup (Ap f m) where+  (<>) = liftA2 (<>)++instance (Applicative f, Monoid m) => Monoid (Ap f m) where+  mempty = pure mempty+  mappend = liftA2 mappend++instance (Applicative f, Reducer c m) => Reducer (f c) (Ap f m) where+  unit = fmap unit . Ap
+ src/Data/Semigroup/Apply.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup.Apply+-- Copyright   :  (c) Edward Kmett 2009-2011+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- Semigroups for working with 'Apply'+--+-----------------------------------------------------------------------------++module Data.Semigroup.Apply+    ( Trav(..)+    , App(..)+    ) where++import Data.Functor+import Data.Functor.Apply+import Data.Semigroup (Semigroup(..))+import Data.Semigroup.Reducer (Reducer(..))++-- | A 'Trav' uses an glues together 'Applicative' actions with (*>)+--   in the manner of 'traverse_' from "Data.Foldable". Any values returned by +--   reduced actions are discarded.+newtype Trav f = Trav { getTrav :: f () } ++instance Apply f => Semigroup (Trav f) where+  Trav a <> Trav b = Trav (a .> b)++instance Apply f => Reducer (f a) (Trav f) where+    unit = Trav . (() <$)+    a `cons` Trav b = Trav (a .> b)+    Trav a `snoc` b = Trav (() <$ (a .> b))++-- | Efficiently avoid needlessly rebinding when using 'snoc' on an action that already returns ()+--   A rewrite rule automatically applies this when possible+snocTrav :: Reducer (f ()) (Trav f) => Trav f -> f () -> Trav f+snocTrav a = (<>) a . Trav+{-# RULES "unitTrav" unit = Trav #-}+{-# RULES "snocTrav" snoc = snocTrav #-}++-- | A 'App' turns any 'Apply' wrapped around a 'Semigroup' into a 'Semigroup'++newtype App f m = App { getApp :: f m } +  deriving (Functor,Apply)++instance (Apply f, Semigroup m) => Semigroup (App f m) where+  (<>) = liftF2 (<>)++instance (Apply f, Reducer c m) => Reducer (f c) (App f m) where+  unit = fmap unit . App
+ src/Data/Semigroup/Generator.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, CPP #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup.Generator+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- A 'Generator1' @c@ is a possibly-specialized container, which contains values of +-- type 'Elem' @c@, and which knows how to efficiently apply a 'Reducer' to extract+-- an answer.+--+-- 'Generator1' is to 'Generator' as 'Foldable1' is to 'Foldable'.+-----------------------------------------------------------------------------++module Data.Semigroup.Generator+  (+  -- * Generators+    Generator1(..)+  -- * Combinators+  , reduce1+  , mapReduceWith1+  , reduceWith1+  ) where++-- import Data.Monoid (Monoid(..))+-- import Data.Foldable (fold,foldMap)+import Data.List.NonEmpty+import Data.Semigroup (Semigroup(..)) -- , WrappedMonoid(..))+import Data.Semigroup.Foldable+import Data.Semigroup.Reducer+import Data.Generator++-- | minimal definition 'mapReduce1' or 'mapTo1'+class Generator c => Generator1 c where+  mapReduce1 :: Reducer e m => (Elem c -> e) -> c -> m+  mapTo1     :: Reducer e m => (Elem c -> e) -> m -> c -> m +  mapFrom1   :: Reducer e m => (Elem c -> e) -> c -> m -> m++  mapTo1 f m = (<>) m . mapReduce1 f+  mapFrom1 f = (<>) . mapReduce1 f++instance Generator1 (NonEmpty e) where+  mapReduce1 f = foldMap1 (unit . f)++{-+mapReduceDefault :: (Generator1 c, Reducer (Elem c) m, Monoid m) => (Elem c -> e) -> c -> m+mapReduceDefault f = unwrapMonoid . mapReduce1 f ++mapToDefault :: (Generator1 c, Reducer (Elem c) m, Monoid m) => (Elem c -> e) -> m -> c -> m+mapToDefault f = unwrapMonoid . mapTo1 f ++mapFromDefault :: (Generator1 c, Reducer (Elem c) m, Monoid m) => (Elem c -> e) -> m -> c -> m+mapFromDefault f = unwrapMonoid . mapFrom1 f +-}++-- | Apply a 'Reducer' directly to the elements of a 'Generator'+reduce1 :: (Generator1 c, Reducer (Elem c) m) => c -> m+reduce1 = mapReduce1 id+{-# SPECIALIZE reduce1 :: Reducer a m => NonEmpty a -> m #-}++mapReduceWith1 :: (Generator1 c, Reducer e m) => (m -> n) -> (Elem c -> e) -> c -> n+mapReduceWith1 f g = f . mapReduce1 g+{-# INLINE mapReduceWith1 #-}++reduceWith1 :: (Generator1 c, Reducer (Elem c) m) => (m -> n) -> c -> n+reduceWith1 f = f . reduce1+{-# INLINE reduceWith1 #-}
+ src/Data/Semigroup/Instances.hs view
@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Semigroup.Instances where++import Data.FingerTree+import Data.Semigroup++instance Measured v a => Semigroup (FingerTree v a) where+  (<>) = mappend
+ src/Data/Semigroup/Monad.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup.Monad+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- Semigroups for working with 'Monad's.+--+-----------------------------------------------------------------------------++module Data.Semigroup.Monad+    ( Action(..)+    , Mon(..)+    ) where++import Control.Monad (liftM, liftM2)+import Data.Monoid (Monoid(..))+import Data.Semigroup (Semigroup(..))+import Data.Semigroup.Reducer (Reducer(..))++-- | A 'Action' uses an glues together monadic actions with (>>)+--   in the manner of 'mapM_' from "Data.Foldable". Any values returned by +--   reduced actions are discarded.+newtype Action f = Action { getAction :: f () } ++instance Monad f => Semigroup (Action f) where+  Action a <> Action b = Action (a >> b)++instance Monad f => Monoid (Action f) where+  mempty = Action (return ())+  Action a `mappend` Action b = Action (a >> b)++instance Monad f => Reducer (f a) (Action f) where+  unit a            = Action (a >> return ())+  a `cons` Action b = Action (a >> b)+  Action a `snoc` b = Action (a >> b >> return ())++-- | Efficiently avoid needlessly rebinding when using 'snoc' on an action that already returns ()+--   A rewrite rule automatically applies this when possible+snocAction :: Reducer (f ()) (Action f) => Action f -> f () -> Action f+snocAction a = (<>) a . Action+{-# RULES "unitAction" unit = Action #-}+{-# RULES "snocAction" snoc = snocAction #-}++newtype Mon f m = Mon { getMon :: f m } +  deriving (Monad)++instance (Monad f, Semigroup m) => Semigroup (Mon f m) where+  (<>) = liftM2 (<>)++instance (Monad f, Monoid m) => Monoid (Mon f m) where+  mempty = return mempty+  mappend = liftM2 mappend++instance (Monad f, Reducer c m) => Reducer (f c) (Mon f m) where+  unit = liftM unit . Mon
+ src/Data/Semigroup/MonadPlus.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup.MonadPlus+-- Copyright   :  (c) Edward Kmett 2009-2011+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- A semigroup for working with instances of 'MonadPlus'+--+-----------------------------------------------------------------------------++module Data.Semigroup.MonadPlus+    ( MonadSum(..)+    ) where++import Control.Monad (MonadPlus(..))+import Data.Monoid (Monoid(..))+import Data.Semigroup (Semigroup(..))+import Data.Semigroup.Reducer (Reducer(..))++-- | A 'MonadSum' turns any 'MonadPlus' instance into a 'Monoid'.++newtype MonadSum f a = MonadSum { getMonadSum :: f a } +  deriving (Monad,MonadPlus)++instance MonadPlus f => Semigroup (MonadSum f a) where+  MonadSum a <> MonadSum b = MonadSum (mplus a b)+   +instance MonadPlus f => Monoid (MonadSum f a) where+  mempty = mzero+  MonadSum a `mappend` MonadSum b = MonadSum (mplus a b) ++instance MonadPlus f => Reducer (f a) (MonadSum f a) where+  unit = MonadSum +
+ src/Data/Semigroup/Reducer.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving, TypeOperators, ScopedTypeVariables, CPP #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup.Reducer+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD3+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- A @c@-'Reducer' is a 'Semigroup' with a canonical mapping from @c@ to the Semigroup.+--+-----------------------------------------------------------------------------++module Data.Semigroup.Reducer+    ( Reducer(..)+    , foldMapReduce, foldMapReduce1+    , foldReduce, foldReduce1+    , pureUnit+    , returnUnit+    , Count(..)+    ) where++import Control.Applicative++import qualified Data.Monoid as Monoid+import Data.Semigroup as Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Instances ()+import Data.Hashable+import Data.Foldable+import Data.FingerTree++import qualified Data.Sequence as Seq+import Data.Sequence (Seq)+import qualified Data.Set as Set+import Data.Set (Set)+import qualified Data.IntSet as IntSet+import Data.IntSet (IntSet)+import qualified Data.IntMap as IntMap+import Data.IntMap (IntMap)+import qualified Data.Map as Map+import Data.Map (Map)++#ifdef LANGUAGE_DeriveDataTypeable+import Data.Data+#endif++--import Text.Parsec.Prim++-- | This type may be best read infix. A @c `Reducer` m@ is a 'Semigroup' @m@ that maps+-- values of type @c@ through @unit@ to values of type @m@. A @c@-'Reducer' may also+-- supply operations which tack-on another @c@ to an existing 'Monoid' @m@ on the left+-- or right. These specialized reductions may be more efficient in some scenarios+-- and are used when appropriate by a 'Generator'. The names 'cons' and 'snoc' work+-- by analogy to the synonymous operations in the list monoid.+--+-- This class deliberately avoids functional-dependencies, so that () can be a @c@-Reducer+-- for all @c@, and so many common reducers can work over multiple types, for instance,+-- First and Last may reduce both @a@ and 'Maybe' @a@. Since a 'Generator' has a fixed element+-- type, the input to the reducer is generally known and extracting from the monoid usually+-- is sufficient to fix the result type. Combinators are available for most scenarios where+-- this is not the case, and the few remaining cases can be handled by using an explicit +-- type annotation.+--+-- Minimal definition: 'unit' or 'snoc'+class Semigroup m => Reducer c m where+  -- | Convert a value into a 'Semigroup'+  unit :: c -> m +  -- | Append a value to a 'Semigroup' for use in left-to-right reduction+  snoc :: m -> c -> m+  -- | Prepend a value onto a 'Semigroup' for use during right-to-left reduction+  cons :: c -> m -> m ++  snoc m = (<>) m . unit+  cons = (<>) . unit++-- | Apply a 'Reducer' to a 'Foldable' container, after mapping the contents into a suitable form for reduction.+foldMapReduce :: (Foldable f, Monoid m, Reducer e m) => (a -> e) -> f a -> m+foldMapReduce f = foldMap (unit . f)++foldMapReduce1 :: (Foldable1 f, Reducer e m) => (a -> e) -> f a -> m+foldMapReduce1 f = foldMap1 (unit . f)++-- | Apply a 'Reducer' to a 'Foldable' mapping each element through 'unit'+foldReduce :: (Foldable f, Monoid m, Reducer e m) => f e -> m+foldReduce = foldMap unit++-- | Apply a 'Reducer' to a 'Foldable1' mapping each element through 'unit'+foldReduce1 :: (Foldable1 f, Reducer e m) => f e -> m+foldReduce1 = foldMap1 unit++returnUnit :: (Monad m, Reducer c n) => c -> m n +returnUnit = return . unit++pureUnit :: (Applicative f, Reducer c n) => c -> f n+pureUnit = pure . unit++newtype Count = Count { getCount :: Int } deriving +  ( Eq, Ord, Show, Read+#ifdef LANGUAGE_DeriveDataTypeable+  , Data, Typeable+#endif+  )++instance Hashable Count where+  hash = hash . getCount+  hashWithSalt n = hashWithSalt n . getCount++instance Semigroup Count where+  Count a <> Count b = Count (a + b)+  times1p n (Count a) = Count $ (fromIntegral n + 1) * a++instance Monoid Count where+  mempty = Count 0+  Count a `mappend` Count b = Count (a + b)++instance Reducer a Count where+  unit _ = Count 1+  Count n `snoc` _ = Count (n + 1)+  _ `cons` Count n = Count (n + 1)+  +instance (Reducer c m, Reducer c n) => Reducer c (m,n) where+  unit x = (unit x,unit x)+  (m,n) `snoc` x = (m `snoc` x, n `snoc` x)+  x `cons` (m,n) = (x `cons` m, x `cons` n)++instance (Reducer c m, Reducer c n, Reducer c o) => Reducer c (m,n,o) where+  unit x = (unit x,unit x, unit x)+  (m,n,o) `snoc` x = (m `snoc` x, n `snoc` x, o `snoc` x)+  x `cons` (m,n,o) = (x `cons` m, x `cons` n, x `cons` o)++instance (Reducer c m, Reducer c n, Reducer c o, Reducer c p) => Reducer c (m,n,o,p) where+  unit x = (unit x,unit x, unit x, unit x)+  (m,n,o,p) `snoc` x = (m `snoc` x, n `snoc` x, o `snoc` x, p `snoc` x)+  x `cons` (m,n,o,p) = (x `cons` m, x `cons` n, x `cons` o, x `cons` p)++instance Reducer c [c] where+  unit = return+  cons = (:)+  xs `snoc` x = xs ++ [x]++instance Reducer c () where+  unit _ = ()+  _ `snoc` _ = ()+  _ `cons` _ = ()++instance Reducer Bool Any where+  unit = Any++instance Reducer Bool All where+  unit = All++instance Reducer (a -> a) (Endo a) where+  unit = Endo++instance Semigroup a => Reducer a (Dual a) where+  unit = Dual+    +instance Num a => Reducer a (Sum a) where+  unit = Sum++instance Num a => Reducer a (Product a) where+  unit = Product++instance Ord a => Reducer a (Min a) where+  unit = Min++instance Ord a => Reducer a (Max a) where+  unit = Max++instance Reducer (Maybe a) (Monoid.First a) where+  unit = Monoid.First++instance Reducer a (Semigroup.First a) where+  unit = Semigroup.First++instance Reducer (Maybe a) (Monoid.Last a) where+  unit = Monoid.Last++instance Reducer a (Semigroup.Last a) where+  unit = Semigroup.Last++instance Measured v a => Reducer a (FingerTree v a) where+  unit = singleton+  cons = (<|)+  snoc = (|>) ++--instance (Stream s m t, Reducer c a) => Reducer c (ParsecT s u m a) where+--    unit = return . unit++instance Reducer a (Seq a) where+  unit = Seq.singleton+  cons = (Seq.<|)+  snoc = (Seq.|>)++instance Reducer Int IntSet where+  unit = IntSet.singleton+  cons = IntSet.insert+  snoc = flip IntSet.insert -- left bias irrelevant++instance Ord a => Reducer a (Set a) where+  unit = Set.singleton+  cons = Set.insert+  -- pedantic about order in case 'Eq' doesn't implement structural equality+  snoc s m | Set.member m s = s +           | otherwise = Set.insert m s++instance Reducer (Int, v) (IntMap v) where+  unit = uncurry IntMap.singleton+  cons = uncurry IntMap.insert+  snoc = flip . uncurry . IntMap.insertWith $ const id++instance Ord k => Reducer (k, v) (Map k v) where+  unit = uncurry Map.singleton+  cons = uncurry Map.insert+  snoc = flip . uncurry . Map.insertWith $ const id++instance Monoid m => Reducer m (WrappedMonoid m) where+  unit = WrapMonoid
+ src/Data/Semigroup/Reducer/With.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE UndecidableInstances, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup.Reducer.With+-- Copyright   :  (c) Edward Kmett 2009-2011+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-----------------------------------------------------------------------------++module Data.Semigroup.Reducer.With+    ( WithReducer(..)+    ) where++import Control.Applicative+import Data.FingerTree+import Data.Foldable+import Data.Traversable+import Data.Hashable+import Data.Monoid+import Data.Semigroup.Reducer+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Semigroup.Instances ()++-- | If @m@ is a @c@-"Reducer", then m is @(c `WithReducer` m)@-"Reducer"+--   This can be used to quickly select a "Reducer" for use as a 'FingerTree'+--   'measure'.++newtype WithReducer m c = WithReducer { withoutReducer :: c } +  deriving (Eq, Ord, Show, Read)++instance Hashable c => Hashable (WithReducer m c) where+  hash = hash . withoutReducer+  hashWithSalt n = hashWithSalt n . withoutReducer++instance Functor (WithReducer m) where+  fmap f = WithReducer . f . withoutReducer++instance Foldable (WithReducer m) where+  foldMap f = f . withoutReducer++instance Traversable (WithReducer m) where+  traverse f (WithReducer a) = WithReducer <$> f a++instance Foldable1 (WithReducer m) where+  foldMap1 f = f . withoutReducer++instance Traversable1 (WithReducer m) where+  traverse1 f (WithReducer a) = WithReducer <$> f a++instance Reducer c m => Reducer (WithReducer m c) m where+    unit = unit . withoutReducer ++instance (Monoid m, Reducer c m) => Measured m (WithReducer m c) where+    measure = unit . withoutReducer
+ src/Data/Semigroup/Self.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup.Self+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- A simple 'Monoid' transformer that takes a 'Monoid' m and produces a new @m@-Reducer named 'Self' @m@+-- +-- This is useful when you have a generator that already contains monoidal values or someone supplies+-- the map to the monoid in the form of a function rather than as a "Reducer" instance. You can just+-- @'getSelf' . `reduce`@ or @'getSelf' . 'mapReduce' f@ in those scenarios. These behaviors are encapsulated +-- into the 'fold' and 'foldMap' combinators in "Data.Monoid.Combinators" respectively.+--+-----------------------------------------------------------------------------++module Data.Semigroup.Self+    ( Self(..)+    )  where++import Control.Applicative+import Data.Foldable+import Data.Traversable+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Semigroup.Reducer (Reducer(..))++newtype Self m = Self { getSelf :: m } deriving (Semigroup, Monoid)++instance Semigroup m => Reducer m (Self m) where+  unit = Self++instance Functor Self where+  fmap f (Self x) = Self (f x)++instance Foldable Self where+  foldMap f (Self x) = f x++instance Traversable Self where+  traverse f (Self x) = Self <$> f x++instance Foldable1 Self where+  foldMap1 f (Self x) = f x++instance Traversable1 Self where+  traverse1 f (Self x) = Self <$> f x
+ src/Data/Semigroup/Union.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, GeneralizedNewtypeDeriving #-}+module Data.Semigroup.Union+    ( module Data.Semigroup.Reducer+    -- * Unions of Containers+    , HasUnion(..)+    , HasUnion0(..)+    , Union(Union,getUnion)+    -- * Unions of Containers of Semigroups+    , HasUnionWith(..)+    , HasUnionWith0(..)+    , UnionWith(UnionWith,getUnionWith)+    ) where++import qualified Data.HashMap.Lazy as HashMap+import Data.HashMap.Lazy (HashMap)++import qualified Data.IntMap as IntMap+import Data.IntMap (IntMap)++import qualified Data.IntSet as IntSet+import Data.IntSet (IntSet)++import qualified Data.HashSet as HashSet+import Data.HashSet (HashSet)++import qualified Data.Map as Map+import Data.Map (Map)++import qualified Data.Set as Set+import Data.Set (Set)++import qualified Data.List as List++import Data.Hashable+import Data.Functor+import Data.Foldable+import Data.Traversable+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Semigroup.Reducer+import Data.Semigroup.Instances ()++-- | A Container suitable for the 'Union' 'Monoid'+class HasUnion f where+  union :: f -> f -> f++{-# SPECIALIZE union :: IntMap a -> IntMap a -> IntMap a #-}+{-# SPECIALIZE union :: Ord k => Map k a -> Map k a -> Map k a #-}+{-# SPECIALIZE union :: Eq a => [a] -> [a] -> [a] #-}+{-# SPECIALIZE union :: Ord a => Set a -> Set a -> Set a #-}+{-# SPECIALIZE union :: IntSet -> IntSet -> IntSet #-}+{-# SPECIALIZE union :: Eq a => HashSet a -> HashSet a -> HashSet a #-}+{-# SPECIALIZE union :: Eq k => HashMap k a -> HashMap k a -> HashMap k a #-}++class HasUnion f => HasUnion0 f where+  empty :: f++instance HasUnion (IntMap a) where+  union = IntMap.union++instance HasUnion0 (IntMap a) where+  empty = IntMap.empty++instance (Eq k, Hashable k) => HasUnion (HashMap k a) where+  union = HashMap.union++instance (Eq k, Hashable k) => HasUnion0 (HashMap k a) where+  empty = HashMap.empty++instance Ord k => HasUnion (Map k a) where+  union = Map.union++instance Ord k => HasUnion0 (Map k a) where+  empty = Map.empty++instance Eq a => HasUnion [a] where+  union = List.union++instance Eq a => HasUnion0 [a] where+  empty = []++instance Ord a => HasUnion (Set a) where+  union = Set.union++instance Ord a => HasUnion0 (Set a) where+  empty = Set.empty++instance HasUnion IntSet where+  union = IntSet.union++instance HasUnion0 IntSet where+  empty = IntSet.empty++instance (Eq a, Hashable a) => HasUnion (HashSet a) where+  union = HashSet.union++instance (Eq a, Hashable a) => HasUnion0 (HashSet a) where+  empty = HashSet.empty+++-- | The 'Monoid' @('union','empty')@+newtype Union f = Union { getUnion :: f } +  deriving (Eq,Ord,Show,Read)++instance HasUnion f => Semigroup (Union f) where+  Union a <> Union b = Union (a `union` b)++instance HasUnion0 f => Monoid (Union f) where+  Union a `mappend` Union b = Union (a `union` b)+  mempty = Union empty++instance HasUnion f => Reducer f (Union f) where+  unit = Union++instance Functor Union where+  fmap f (Union a) = Union (f a)++instance Foldable Union where+ foldMap f (Union a) = f a++instance Traversable Union where+  traverse f (Union a) = Union <$> f a++instance Foldable1 Union where+  foldMap1 f (Union a) = f a++instance Traversable1 Union where+  traverse1 f (Union a) = Union <$> f a++-- | Polymorphic containers that we can supply an operation to handle unions with+class Functor f => HasUnionWith f where+  unionWith :: (a -> a -> a) -> f a -> f a -> f a++{-# SPECIALIZE unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a #-}+{-# SPECIALIZE unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a #-}+{-# SPECIALIZE unionWith :: Eq k => (a -> a -> a) -> HashMap k a -> HashMap k a -> HashMap k a #-}++class HasUnionWith f => HasUnionWith0 f where+  emptyWith :: f a ++instance HasUnionWith IntMap where +  unionWith = IntMap.unionWith++instance HasUnionWith0 IntMap where +  emptyWith = IntMap.empty++instance Ord k => HasUnionWith (Map k) where +  unionWith = Map.unionWith++instance Ord k => HasUnionWith0 (Map k) where +  emptyWith = Map.empty++-- TODO: add unionWith to unordered-containers++--instance Eq k => HasUnionWith (HashMap k) where +--  unionWith = HashMap.unionWith++--instance Ord k => HasUnionWith0 (Map k) where +--  emptyWith = Map.empty++-- | The 'Monoid' @('unionWith mappend','empty')@ for containers full of monoids.+newtype UnionWith f m = UnionWith { getUnionWith :: f m } ++instance (HasUnionWith f, Semigroup m) => Semigroup (UnionWith f m) where+    UnionWith a <> UnionWith b = UnionWith (unionWith (<>) a b)++instance (HasUnionWith0 f, Monoid m) => Monoid (UnionWith f m) where+    mempty = UnionWith emptyWith+    UnionWith a `mappend` UnionWith b = UnionWith (unionWith mappend a b)++instance (HasUnionWith f, Semigroup m, Monoid m) => Reducer (f m) (UnionWith f m) where+    unit = UnionWith+