reducers-3.10.1.1/0000755000000000000000000000000012251247361011740 5ustar0000000000000000reducers-3.10.1.1/.travis.yml0000644000000000000000000000033512251247361014052 0ustar0000000000000000language: haskell notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313reducers\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" reducers-3.10.1.1/LICENSE0000644000000000000000000000266012251247361012751 0ustar0000000000000000Copyright 2008-2011 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. reducers-3.10.1.1/reducers.cabal0000644000000000000000000000367712251247361014555 0ustar0000000000000000name: reducers category: Data, Math, Numerical, Semigroups version: 3.10.1.1 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/reducers/ bug-reports: http://github.com/ekmett/reducers/issues copyright: Copyright (C) 2008-2013 Edward A. Kmett synopsis: Semigroups, specialized containers and a general map/reduce framework description: Semigroups, specialized containers and a general map/reduce framework build-type: Simple extra-source-files: .travis.yml source-repository head type: git location: git://github.com/ekmett/reducers.git library hs-source-dirs: src build-depends: base >= 4 && < 5, array >= 0.3 && < 0.6, transformers >= 0.2 && < 0.4, bytestring >= 0.9.1 && < 0.11, containers >= 0.3 && < 0.6, fingertree >= 0.1 && < 0.2, hashable >= 1.1.2.1 && < 1.3, text >= 0.11.1.5 && < 1.2, unordered-containers >= 0.1.4 && < 0.3, semigroups >= 0.8.3.1 && < 1, semigroupoids >= 4 && < 5, comonad >= 4 && < 5, pointed >= 4 && < 5, keys >= 3.10 && < 4 exposed-modules: Data.Generator Data.Generator.Combinators Data.Semigroup.Generator Data.Semigroup.Reducer Data.Semigroup.Reducer.With Data.Semigroup.Instances Data.Semigroup.Union Data.Semigroup.Apply Data.Semigroup.Applicative Data.Semigroup.Alt Data.Semigroup.Alternative Data.Semigroup.Monad Data.Semigroup.MonadPlus Data.Semigroup.Self if impl(ghc) extensions: DeriveDataTypeable cpp-options: -DLANGUAGE_DeriveDataTypeable ghc-options: -Wall reducers-3.10.1.1/Setup.lhs0000644000000000000000000000016512251247361013552 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain reducers-3.10.1.1/src/0000755000000000000000000000000012251247361012527 5ustar0000000000000000reducers-3.10.1.1/src/Data/0000755000000000000000000000000012251247361013400 5ustar0000000000000000reducers-3.10.1.1/src/Data/Generator.hs0000644000000000000000000001720312251247361015665 0ustar0000000000000000{-# LANGUAGE UndecidableInstances, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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 #-} reducers-3.10.1.1/src/Data/Generator/0000755000000000000000000000000012251247361015326 5ustar0000000000000000reducers-3.10.1.1/src/Data/Generator/Combinators.hs0000644000000000000000000001520212251247361020142 0ustar0000000000000000{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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 #-} -} reducers-3.10.1.1/src/Data/Semigroup/0000755000000000000000000000000012251247361015352 5ustar0000000000000000reducers-3.10.1.1/src/Data/Semigroup/Alt.hs0000644000000000000000000000235012251247361016426 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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 reducers-3.10.1.1/src/Data/Semigroup/Alternative.hs0000644000000000000000000000257212251247361020172 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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 reducers-3.10.1.1/src/Data/Semigroup/Applicative.hs0000644000000000000000000000444012251247361020151 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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 reducers-3.10.1.1/src/Data/Semigroup/Apply.hs0000644000000000000000000000365612251247361017005 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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 reducers-3.10.1.1/src/Data/Semigroup/Generator.hs0000644000000000000000000000502512251247361017636 0ustar0000000000000000{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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 #-} reducers-3.10.1.1/src/Data/Semigroup/Instances.hs0000644000000000000000000000047612251247361017644 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif {-# 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 reducers-3.10.1.1/src/Data/Semigroup/Monad.hs0000644000000000000000000000423112251247361016744 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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 reducers-3.10.1.1/src/Data/Semigroup/MonadPlus.hs0000644000000000000000000000252512251247361017614 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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 reducers-3.10.1.1/src/Data/Semigroup/Reducer.hs0000644000000000000000000001554412251247361017310 0ustar0000000000000000{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving, TypeOperators, ScopedTypeVariables, CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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' 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 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 reducers-3.10.1.1/src/Data/Semigroup/Self.hs0000644000000000000000000000340112251247361016575 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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 reducers-3.10.1.1/src/Data/Semigroup/Union.hs0000644000000000000000000001162012251247361016776 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif 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-3.10.1.1/src/Data/Semigroup/Reducer/0000755000000000000000000000000012251247361016743 5ustar0000000000000000reducers-3.10.1.1/src/Data/Semigroup/Reducer/With.hs0000644000000000000000000000363012251247361020214 0ustar0000000000000000{-# LANGUAGE UndecidableInstances, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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 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