reducers-3.12.3/0000755000000000000000000000000013316711630011603 5ustar0000000000000000reducers-3.12.3/reducers.cabal0000644000000000000000000000434213316711630014406 0ustar0000000000000000name: reducers category: Data, Math, Numerical, Semigroups version: 3.12.3 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-2016 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 tested-with: GHC == 7.0.4 , GHC == 7.2.2 , GHC == 7.4.2 , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.3 , GHC == 8.6.1 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.6, bytestring >= 0.9.1 && < 0.11, containers >= 0.3 && < 0.7, fingertree >= 0.1 && < 0.2, hashable >= 1.1.2.1 && < 1.3, text >= 0.11.1.5 && < 1.3, unordered-containers >= 0.2 && < 0.3, semigroups >= 0.9 && < 1, semigroupoids >= 4 && < 6 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 -- hack around the buggy unused matches check for class associated types in ghc 8 rc1 if impl(ghc >= 8) ghc-options: -fno-warn-unused-matches reducers-3.12.3/Setup.lhs0000644000000000000000000000016513316711630013415 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain reducers-3.12.3/.travis.yml0000644000000000000000000001615313316711630013722 0ustar0000000000000000# This Travis job script has been generated by a script via # # runghc make_travis_yml_2.hs '-o' '.travis.yml' '--ghc-head' '--irc-channel=irc.freenode.org#haskell-lens' '--no-no-tests-no-bench' '--no-unconstrained' 'cabal.project' # # For more information, see https://github.com/hvr/multi-ghc-travis # language: c sudo: false git: submodules: false # whether to recursively clone submodules notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313reducers\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log # remove files that are regenerated by 'cabal update' - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx - rm -rfv $HOME/.cabal/packages/head.hackage matrix: include: - compiler: "ghc-8.6.1" env: GHCHEAD=true addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.6.1], sources: [hvr-ghc]}} - compiler: "ghc-8.4.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}} - compiler: "ghc-8.2.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}} - compiler: "ghc-8.0.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}} - compiler: "ghc-7.10.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}} - compiler: "ghc-7.8.4" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.8.4], sources: [hvr-ghc]}} - compiler: "ghc-7.6.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.6.3], sources: [hvr-ghc]}} - compiler: "ghc-7.4.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.4.2], sources: [hvr-ghc]}} - compiler: "ghc-7.2.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.2.2], sources: [hvr-ghc]}} - compiler: "ghc-7.0.4" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.0.4], sources: [hvr-ghc]}} - compiler: "ghc-head" env: GHCHEAD=true addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}} allow_failures: - compiler: "ghc-head" - compiler: "ghc-7.0.4" - compiler: "ghc-7.2.2" - compiler: "ghc-8.6.1" before_install: - HC=${CC} - HCPKG=${HC/ghc/ghc-pkg} - unset CC - ROOTDIR=$(pwd) - mkdir -p $HOME/.local/bin - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) - echo $HCNUMVER install: - cabal --version - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - BENCH=${BENCH---enable-benchmarks} - TEST=${TEST---enable-tests} - HADDOCK=${HADDOCK-true} - UNCONSTRAINED=${UNCONSTRAINED-true} - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false} - GHCHEAD=${GHCHEAD-false} - travis_retry cabal update -v - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" - rm -fv cabal.project cabal.project.local # Overlay Hackage Package Index for GHC HEAD: https://github.com/hvr/head.hackage - | if $GHCHEAD; then sed -i 's/-- allow-newer: .*/allow-newer: *:base/' ${HOME}/.cabal/config for pkg in $($HCPKG list --simple-output); do pkg=$(echo $pkg | sed 's/-[^-]*$//'); sed -i "s/allow-newer: /allow-newer: *:$pkg, /" ${HOME}/.cabal/config; done echo 'repository head.hackage' >> ${HOME}/.cabal/config echo ' url: http://head.hackage.haskell.org/' >> ${HOME}/.cabal/config echo ' secure: True' >> ${HOME}/.cabal/config echo ' root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740' >> ${HOME}/.cabal/config echo ' 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb' >> ${HOME}/.cabal/config echo ' 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e' >> ${HOME}/.cabal/config echo ' key-threshold: 3' >> ${HOME}/.cabal.config grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' cabal new-update head.hackage -v fi - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' - "printf 'packages: \".\"\\n' > cabal.project" - touch cabal.project.local - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi - rm -f cabal.project.freeze - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all - rm -rf .ghc.environment.* "."/dist - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. script: # test that source-distributions can be generated - (cd "." && cabal sdist) - mv "."/dist/reducers-*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - "printf 'packages: reducers-*/*.cabal\\n' > cabal.project" - touch cabal.project.local - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" - cat cabal.project || true - cat cabal.project.local || true # build & run tests, build benchmarks - cabal new-build -w ${HC} ${TEST} ${BENCH} all # cabal check - (cd reducers-* && cabal check) # haddock - rm -rf ./dist-newstyle - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi # REGENDATA ["-o",".travis.yml","--ghc-head","--irc-channel=irc.freenode.org#haskell-lens","--no-no-tests-no-bench","--no-unconstrained","cabal.project"] # EOF reducers-3.12.3/LICENSE0000644000000000000000000000266013316711630012614 0ustar0000000000000000Copyright 2008-2016 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.12.3/src/0000755000000000000000000000000013316711630012372 5ustar0000000000000000reducers-3.12.3/src/Data/0000755000000000000000000000000013316711630013243 5ustar0000000000000000reducers-3.12.3/src/Data/Generator.hs0000644000000000000000000001735613316711630015541 0ustar0000000000000000{-# LANGUAGE UndecidableInstances, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, CPP #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Generator -- Copyright : (c) Edward Kmett 2009-2016 -- 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 #if __GLASGOW_HASKELL__ < 710 import Data.Monoid (Monoid, mappend, mempty) #endif 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 (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) #if __GLASGOW_HASKELL__ < 710 import Data.Foldable (fold,foldMap) #else import Data.Foldable (fold) #endif 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 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 #if MIN_VERSION_base(4,9,0) instance Generator (Values (Array i e)) where #else instance Ix i => Generator (Values (Array i e)) where #endif 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 :: (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.12.3/src/Data/Generator/0000755000000000000000000000000013316711630015171 5ustar0000000000000000reducers-3.12.3/src/Data/Generator/Combinators.hs0000644000000000000000000001535413316711630020015 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710 {-# 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 #if __GLASGOW_HASKELL__ >= 710 , foldMap #endif ) import Control.Applicative import Control.Monad (MonadPlus) import Data.Generator #if __GLASGOW_HASKELL__ < 710 import Data.Monoid (Monoid(..)) #endif 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.12.3/src/Data/Semigroup/0000755000000000000000000000000013316711630015215 5ustar0000000000000000reducers-3.12.3/src/Data/Semigroup/MonadPlus.hs0000644000000000000000000000275213316711630017461 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-} {-# LANGUAGE CPP #-} #if __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(..)) #if __GLASGOW_HASKELL__ < 710 import Control.Applicative (Applicative(..),Alternative(..)) import Data.Monoid (Monoid(..)) #else import Control.Applicative (Alternative(..)) #endif 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 (Functor,Applicative,Alternative,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.12.3/src/Data/Semigroup/Union.hs0000644000000000000000000001163613316711630016650 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-} #if __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 #if __GLASGOW_HASKELL__ < 710 import Data.Functor import Data.Foldable import Data.Traversable #endif #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup #endif 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 instance (Eq k, Hashable k) => HasUnionWith (HashMap k) where unionWith = HashMap.unionWith instance (Eq k, Hashable k) => HasUnionWith0 (HashMap k) where emptyWith = HashMap.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.12.3/src/Data/Semigroup/Alternative.hs0000644000000000000000000000263013316711630020030 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 #if __GLASGOW_HASKELL__ < 710 import Data.Monoid (Monoid(..)) #endif 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.12.3/src/Data/Semigroup/Applicative.hs0000644000000000000000000000450013316711630020011 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MonoLocalBinds #-} #if __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 #if __GLASGOW_HASKELL__ < 710 import Data.Monoid (Monoid(..)) #endif 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 { getAp :: 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.12.3/src/Data/Semigroup/Instances.hs0000644000000000000000000000060213316711630017476 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710 {-# LANGUAGE Trustworthy #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} module Data.Semigroup.Instances where #if !(MIN_VERSION_fingertree(0,1,2) && MIN_VERSION_base(4,9,0)) import Data.FingerTree import Data.Semigroup instance Measured v a => Semigroup (FingerTree v a) where (<>) = mappend #endif reducers-3.12.3/src/Data/Semigroup/Apply.hs0000644000000000000000000000372013316711630016640 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MonoLocalBinds #-} #if __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 #if __GLASGOW_HASKELL__ < 710 import Data.Functor #endif 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.12.3/src/Data/Semigroup/Generator.hs0000644000000000000000000000501513316711630017500 0ustar0000000000000000{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, CPP #-} #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710 {-# 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.12.3/src/Data/Semigroup/Self.hs0000644000000000000000000000345513316711630016451 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-} #if __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 #if __GLASGOW_HASKELL__ < 710 import Control.Applicative import Data.Foldable import Data.Traversable #endif #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup #endif 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.12.3/src/Data/Semigroup/Alt.hs0000644000000000000000000000246613316711630016301 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-} {-# LANGUAGE CPP #-} #if __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 #if __GLASGOW_HASKELL__ < 710 import Data.Monoid (Monoid(..)) #endif 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,Plus) instance Alt f => Alt (Alter f) where Alter a Alter b = Alter (a b) 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.12.3/src/Data/Semigroup/Reducer.hs0000644000000000000000000001646613316711630017157 0ustar0000000000000000{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving, TypeOperators, ScopedTypeVariables, CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_semigroups #define MIN_VERSION_semigroups(x,y,z) 1 #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 #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import qualified Data.Monoid as Monoid import Data.Semigroup as Semigroup import Data.Semigroup.Foldable import Data.Semigroup.Instances () import Data.Hashable #if __GLASGOW_HASKELL__ < 710 import Data.Foldable #endif 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) import qualified Data.HashMap.Lazy as HashMap import Data.HashMap.Lazy (HashMap) #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) #if MIN_VERSION_semigroups(0,17,0) stimes n (Count a) = Count $ fromIntegral n * a #else times1p n (Count a) = Count $ (fromIntegral n + 1) * a #endif 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 (Eq k, Hashable k) => Reducer (k, v) (HashMap k v) where unit = uncurry HashMap.singleton cons = uncurry HashMap.insert snoc = flip . uncurry . HashMap.insertWith $ const id instance Monoid m => Reducer m (WrappedMonoid m) where unit = WrapMonoid reducers-3.12.3/src/Data/Semigroup/Monad.hs0000644000000000000000000000437713316711630016622 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MonoLocalBinds #-} #if __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) #if __GLASGOW_HASKELL__ < 710 import Control.Applicative (Applicative(..)) import Data.Monoid (Monoid(..)) #endif 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 (Functor,Applicative,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.12.3/src/Data/Semigroup/Reducer/0000755000000000000000000000000013316711630016606 5ustar0000000000000000reducers-3.12.3/src/Data/Semigroup/Reducer/With.hs0000644000000000000000000000377213316711630020066 0ustar0000000000000000{-# LANGUAGE UndecidableInstances, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-} {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710 {-# 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 #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Data.FingerTree #if __GLASGOW_HASKELL__ < 710 import Data.Foldable import Data.Traversable #endif import Data.Hashable #if __GLASGOW_HASKELL__ < 710 import Data.Monoid #endif 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