semigroups-0.18.5/0000755000000000000000000000000013316521203012164 5ustar0000000000000000semigroups-0.18.5/CHANGELOG.markdown0000644000000000000000000001017413316521203015222 0ustar00000000000000000.18.5 [2018.07.02] ------------------- * Use a more efficient `sconcat` for the `Semigroup` instances for strict and lazy `ByteString`. 0.18.4 [2018.01.29] ------------------- * Backport `Semigroup` instances for `Data.Ord.Down` and strict `ST`, which were added in `base-4.11`. 0.18.3 ------ * Add `Semigroup` instance for `IO`, as well as for `Event` and `Lifetime` from `GHC.Event` * Add `Eq1`, `Ord1`, `Read1`, and `Show1` instances for `NonEmpty` * Define `Generic` and `Generic1` instances back to GHC 7.2, and expose the `Data.Semigroup.Generic` module on GHC 7.2 0.18.2 ------ * Depend on the `bytestring-builder` package to ensure `Semigroup` instances for bytestring `Builder` and `ShortByteString` are always defined * Allow building with `binary-0.8.3` and later 0.18.1 ------ * Add the missing instance for `Data.Binary.Builder.Builder`. 0.18.0.1 -------- * Added support for `base-4.9` 0.18 -------- * Removed the partial functions `words`, `unwords`, `lines`, `unlines` 0.17.0.1 -------- * Fixed the `@since` annotations 0.17 ---- * Added `groupWith`, `groupAllWith`, `groupWith1`, `groupAllWith1` * Renamed `sortOn` to `sortWith` to match the "Comprehensive comprehensions" paper and `TransformListComp` extension. * Add `Semigroup` instances for `Alt`, `Void`, `Proxy` and `Tagged` * Add `Num` instances for `Min` and `Max` * Removed `times1p` in favor of `stimes`. 0.16.2.2 -------- * Cleaned up imports to remove warnings on GHC 7.10. 0.16.2.1 -------- * Restored the ability to build on GHC < 7.6. (`Generic1` deriving was only added in GHC 7.6) 0.16.2 ------ * Added `genericMappend` and supporting `GSemigroup` class for generically deriving Semigroup instances. * Added `Arg a b` which only compares for equality/order on its first argument, which can be used to compute `argmin` and `argmax`. * Add `Bifunctor` `Arg` instance to avoid orphans for GHC 7.10+. * Added missing `Data.Monoid.Generic` module to source control. 0.16.1 ------ * Added `Semigroup` instances for various Builder constructions in `text` and `bytestring` where available. * Added `MonadFix` and `MonadPlus` instances for `NonEmpty`. 0.16.0.1 -------- * Bumped `deepseq` version bound for GHC 7.10 compatibility. 0.16 ---- * `times1p` and `timesN` are now reduced to accepting only a `Natural` argument. `Whole` doesn't exist in GHC 7.10's Numeric.Natural, and `nats` version 1 has removed support for the class. 0.15.4 ------ * Use `Data.Coerce.coerce` on GHC 7.8+ to reduce the number of eta-expansions in the resulting core. * Avoid conflict with pending `Foldable.length` in base. 0.15.3 ------ * `instance NFData a => NFData (NonEmpty a)` * Added `NFData` instances for the types in Data.Semigroup 0.15.2 ------ * Fixed a Trustworthiness problem for GHC 7.8+ 0.15.1 ------ * Nathan van Doorn fixed a number of embarrassing bugs in the `Enum` instances. 0.15 ---- * `instance IsList NonEmpty` 0.14 ---- * Allow for manual removal of dependencies to support advanced sandbox users who explicitly want to avoid compiling certain dependencies they know they aren't using. We will fix bugs caused by any combination of these package flags, but the API of the package should be considered the default build configuration with all of the package dependency flags enabled. * Will now build as full-fledged `Safe` Haskell if you configure with -f-hashable. * Added some missing `Generic`/`Generic`/`Hashable` instances 0.13.0.1 -------- * `Generic` support requires `ghc-prim` on GHC 7.4. 0.13 ---- * Added instances for 'Generic', 'Foldable', 'Traversable', 'Enum', 'Functor', 'Hashable', 'Applicative', 'Monad' and 'MonadFix' 0.12.2 ------ * Vastly widened the dependency bound on `text` and `bytestring`. 0.12.1 ------- * Updated to support the new version of `text`. * Added `transpose`, `sortBy` and `sortWith`. 0.12 ---- * Added an instance for `Const r`. * Added `some1` 0.11 ---- * Added the missing instance for `HashSet`. 0.10 ---- * Added support for `unordered-containers`, `bytestring` and `text`. 0.9.2 ----- * Added a `DefaultSignature` for `(<>)` in terms of `mappend`. 0.9.1 ----- * Added `timesN`. 0.9 --- * Moved `Numeric.Natural` to a separate `nats` package. semigroups-0.18.5/README.markdown0000644000000000000000000000240513316521203014666 0ustar0000000000000000semigroups ========== [![Hackage](https://img.shields.io/hackage/v/semigroups.svg)](https://hackage.haskell.org/package/semigroups) [![Build Status](https://secure.travis-ci.org/ekmett/semigroups.png?branch=master)](http://travis-ci.org/ekmett/semigroups) Haskellers are usually familiar with monoids. A monoid has an appending operation `<>` or `mappend` and an identity element `mempty`. A Semigroup has an append `<>`, but does not require an `mempty` element. A Monoid can be made a Semigroup with just `instance Semigroup MyMonoid` More formally, a semigroup is an algebraic structure consisting of a set together with an associative binary operation. A semigroup generalizes a monoid in that there might not exist an identity element. It also (originally) generalized a group (a monoid with all inverses) to a type where every element did not have to have an inverse, thus the name semigroup. `Data.Semigroup` and `Data.List.NonEmpty` were added to `base` as of 4.9.0.0. This package now offers a backwards-compatible API and some tools for deriving semigroups with generics. Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett semigroups-0.18.5/Setup.lhs0000644000000000000000000000016513316521203013776 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain semigroups-0.18.5/.travis.yml0000644000000000000000000001616313316521203014304 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: - "\x0313semigroups\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/semigroups-*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - "printf 'packages: semigroups-*/*.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 semigroups-* && 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 semigroups-0.18.5/LICENSE0000644000000000000000000000236413316521203013176 0ustar0000000000000000Copyright 2011-2015 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. 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. semigroups-0.18.5/semigroups.cabal0000644000000000000000000001326213316521203015351 0ustar0000000000000000name: semigroups category: Algebra, Data, Data Structures, Math version: 0.18.5 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/semigroups/ bug-reports: http://github.com/ekmett/semigroups/issues copyright: Copyright (C) 2011-2015 Edward A. Kmett synopsis: Anything that associates description: In mathematics, a semigroup is an algebraic structure consisting of a set together with an associative binary operation. A semigroup generalizes a monoid in that there might not exist an identity element. It also (originally) generalized a group (a monoid with all inverses) to a type where every element did not have to have an inverse, thus the name semigroup. build-type: Simple extra-source-files: .travis.yml README.markdown CHANGELOG.markdown 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/semigroups.git flag hashable description: You can disable the use of the `hashable` package using `-f-hashable`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. . If disabled we will not supply instances of `Hashable` . Note: `-f-hashable` implies `-f-unordered-containers`, as we are necessarily not able to supply those instances as well. default: True manual: True flag binary description: You can disable the use of the `binary` package using `-f-binary`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. default: True manual: True flag bytestring description: You can disable the use of the `bytestring` package using `-f-bytestring`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. default: True manual: True flag bytestring-builder description: Decides whether to use an older version of bytestring along with bytestring-builder or just a newer version of bytestring. . This flag normally toggles automatically but you can use `-fbytestring-builder` or `-f-bytestring-builder` to explicitly change it. default: False manual: False flag containers description: You can disable the use of the `containers` package using `-f-containers`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. default: True manual: True flag deepseq description: You can disable the use of the `deepseq` package using `-f-deepseq`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. default: True manual: True flag tagged description: You can disable the use of the `tagged` package using `-f-tagged`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. default: True manual: True flag text description: You can disable the use of the `text` package using `-f-text`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. default: True manual: True flag transformers description: You can disable the use of the `transformers` and `transformers-compat` packages using `-f-transformers`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. default: True manual: True flag unordered-containers description: You can disable the use of the `unordered-containers` package using `-f-unordered-containers`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. default: True manual: True library default-language: Haskell98 hs-source-dirs: src ghc-options: -Wall build-depends: base >= 2 && < 5 if impl(ghc >= 7.2) exposed-modules: Data.Semigroup.Generic -- legacy configuration if impl(ghc < 7.11.20151002) -- starting with GHC 8 these modules are provided by `base` hs-source-dirs: src-ghc7 exposed-modules: Data.Semigroup Data.List.NonEmpty -- Not needed anymore since GHC 7.10 if impl(ghc < 7.10) build-depends: nats >= 0.1 && < 2 if impl(ghc >= 7.2 && < 7.5) build-depends: ghc-prim if flag(binary) build-depends: binary if flag(bytestring) if flag(bytestring-builder) build-depends: bytestring >= 0.9 && < 0.10.4, bytestring-builder >= 0.10.4 && < 1 else build-depends: bytestring >= 0.10.4 && < 1 if flag(containers) build-depends: containers >= 0.3 && < 0.7 if flag(deepseq) build-depends: deepseq >= 1.1 && < 1.5 if flag(tagged) build-depends: tagged >= 0.4.4 && < 1 if flag(text) build-depends: text >= 0.10 && < 2 if flag(hashable) build-depends: hashable >= 1.1 && < 1.3 if flag(hashable) && flag(unordered-containers) build-depends: unordered-containers >= 0.2 && < 0.3 if flag(transformers) build-depends: transformers >= 0.2 && < 0.6 , transformers-compat >= 0.5 && < 1 semigroups-0.18.5/src/0000755000000000000000000000000013316521203012753 5ustar0000000000000000semigroups-0.18.5/src/Data/0000755000000000000000000000000013316521203013624 5ustar0000000000000000semigroups-0.18.5/src/Data/Semigroup/0000755000000000000000000000000013316521203015576 5ustar0000000000000000semigroups-0.18.5/src/Data/Semigroup/Generic.hs0000644000000000000000000000465213316521203017515 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #else {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Semigroup.Generic -- Copyright : (C) 2014-2015 Edward Kmett, Eric Mertens -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- This module provides generic deriving tools for monoids and semigroups for -- product-like structures. -- ---------------------------------------------------------------------------- module Data.Semigroup.Generic ( GSemigroup , gmappend , GMonoid , gmempty ) where #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup #endif import GHC.Generics -- | Generically generate a 'Semigroup' ('<>') operation for any type -- implementing 'Generic'. This operation will append two values -- by point-wise appending their component fields. It is only defined -- for product types. -- -- @ -- 'gmappend' a ('gmappend' b c) = 'gmappend' ('gmappend' a b) c -- @ gmappend :: (Generic a, GSemigroup (Rep a)) => a -> a -> a gmappend x y = to (gmappend' (from x) (from y)) class GSemigroup f where gmappend' :: f p -> f p -> f p instance GSemigroup U1 where gmappend' _ _ = U1 instance GSemigroup V1 where gmappend' x y = x `seq` y `seq` error "GSemigroup.V1: gmappend'" instance Semigroup a => GSemigroup (K1 i a) where gmappend' (K1 x) (K1 y) = K1 (x <> y) instance GSemigroup f => GSemigroup (M1 i c f) where gmappend' (M1 x) (M1 y) = M1 (gmappend' x y) instance (GSemigroup f, GSemigroup g) => GSemigroup (f :*: g) where gmappend' (x1 :*: x2) (y1 :*: y2) = gmappend' x1 y1 :*: gmappend' x2 y2 -- | Generically generate a 'Monoid' 'mempty' for any product-like type -- implementing 'Generic'. -- -- It is only defined for product types. -- -- @ -- 'gmappend' 'gmempty' a = a = 'gmappend' a 'gmempty' -- @ gmempty :: (Generic a, GMonoid (Rep a)) => a gmempty = to gmempty' class GSemigroup f => GMonoid f where gmempty' :: f p instance GMonoid U1 where gmempty' = U1 instance (Semigroup a, Monoid a) => GMonoid (K1 i a) where gmempty' = K1 mempty instance GMonoid f => GMonoid (M1 i c f) where gmempty' = M1 gmempty' instance (GMonoid f, GMonoid g) => GMonoid (f :*: g) where gmempty' = gmempty' :*: gmempty' semigroups-0.18.5/src-ghc7/0000755000000000000000000000000013316521203013601 5ustar0000000000000000semigroups-0.18.5/src-ghc7/Data/0000755000000000000000000000000013316521203014452 5ustar0000000000000000semigroups-0.18.5/src-ghc7/Data/Semigroup.hs0000644000000000000000000007617313316521203016776 0ustar0000000000000000{-# LANGUAGE CPP #-} #ifdef __GLASGOW_HASKELL__ #define LANGUAGE_DeriveDataTypeable {-# LANGUAGE DeriveDataTypeable #-} #endif #if __GLASGOW_HASKELL__ >= 702 #define LANGUAGE_DefaultSignatures {-# LANGUAGE DefaultSignatures #-} #if (defined(MIN_VERSION_hashable)) || __GLASGOW_HASKELL__ == 702 \ || __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE Trustworthy #-} #else {-# LANGUAGE Safe #-} #endif #endif #if __GLASGOW_HASKELL__ >= 702 #define LANGUAGE_DeriveGeneric {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 708 #define USE_COERCE {-# LANGUAGE ScopedTypeVariables #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Semigroup -- Copyright : (C) 2011-2015 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- In mathematics, a semigroup is an algebraic structure consisting of a -- set together with an associative binary operation. A semigroup -- generalizes a monoid in that there might not exist an identity -- element. It also (originally) generalized a group (a monoid with all -- inverses) to a type where every element did not have to have an inverse, -- thus the name semigroup. -- -- The use of @(\<\>)@ in this module conflicts with an operator with the same -- name that is being exported by Data.Monoid. However, this package -- re-exports (most of) the contents of Data.Monoid, so to use semigroups -- and monoids in the same package just -- -- > import Data.Semigroup -- ---------------------------------------------------------------------------- module Data.Semigroup ( Semigroup(..) , stimesMonoid , stimesIdempotent , stimesIdempotentMonoid , mtimesDefault -- * Semigroups , Min(..) , Max(..) , First(..) , Last(..) , WrappedMonoid(..) -- * Re-exported monoids from Data.Monoid , Monoid(..) , Dual(..) , Endo(..) , All(..) , Any(..) , Sum(..) , Product(..) -- * A better monoid for Maybe , Option(..) , option -- * Difference lists of a semigroup , diff , cycle1 -- * ArgMin, ArgMax , Arg(..) , ArgMin , ArgMax ) where import Prelude hiding (foldr1) #if MIN_VERSION_base(4,8,0) import Data.Bifunctor import Data.Void #else import Data.Monoid (Monoid(..)) import Data.Foldable import Data.Traversable #endif import Data.Monoid (Dual(..),Endo(..),All(..),Any(..),Sum(..),Product(..)) #if MIN_VERSION_base(4,8,0) import Data.Monoid (Alt(..)) #endif import Control.Applicative import Control.Monad import Control.Monad.Fix import qualified Control.Monad.ST as Strict import qualified Data.Monoid as Monoid import Data.List.NonEmpty #if MIN_VERSION_base(4,6,0) import Data.Ord (Down(..)) #else import GHC.Exts (Down(..)) #endif #if MIN_VERSION_base(4,4,0) && !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) && !defined(ETA_VERSION) import GHC.Event #endif #ifdef MIN_VERSION_deepseq import Control.DeepSeq (NFData(..)) #endif #ifdef MIN_VERSION_containers import Data.Sequence (Seq, (><)) import Data.Set (Set) import Data.IntSet (IntSet) import Data.Map (Map) import Data.IntMap (IntMap) #endif #ifdef MIN_VERSION_binary # if !(MIN_VERSION_binary(0,8,3)) import qualified Data.Binary.Builder as Builder # endif #endif #ifdef MIN_VERSION_bytestring import Data.ByteString as BS import Data.ByteString.Lazy as BL # if (MIN_VERSION_bytestring(0,10,2)) || defined(MIN_VERSION_bytestring_builder) import qualified Data.ByteString.Builder as ByteString # elif MIN_VERSION_bytestring(0,10,0) import qualified Data.ByteString.Lazy.Builder as ByteString # endif # if (MIN_VERSION_bytestring(0,10,4)) || defined(MIN_VERSION_bytestring_builder) import Data.ByteString.Short # endif #endif #if (MIN_VERSION_base(4,8,0)) || defined(MIN_VERSION_transformers) import Data.Functor.Identity #endif #if (MIN_VERSION_base(4,7,0)) || defined(MIN_VERSION_tagged) import Data.Proxy #endif #ifdef MIN_VERSION_tagged import Data.Tagged #endif #ifdef MIN_VERSION_text import qualified Data.Text as TS import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as Text #endif #ifdef MIN_VERSION_hashable import Data.Hashable #endif #ifdef MIN_VERSION_unordered_containers import Data.HashMap.Lazy as Lazy import Data.HashSet #endif #ifdef LANGUAGE_DeriveDataTypeable import Data.Data #endif #ifdef LANGUAGE_DeriveGeneric import GHC.Generics #endif #ifdef USE_COERCE import Data.Coerce #endif infixr 6 <> class Semigroup a where -- | An associative operation. -- -- @ -- (a '<>' b) '<>' c = a '<>' (b '<>' c) -- @ -- -- If @a@ is also a 'Monoid' we further require -- -- @ -- ('<>') = 'mappend' -- @ (<>) :: a -> a -> a #ifdef LANGUAGE_DefaultSignatures default (<>) :: Monoid a => a -> a -> a (<>) = mappend #endif -- | Reduce a non-empty list with @\<\>@ -- -- The default definition should be sufficient, but this can be overridden for efficiency. -- sconcat :: NonEmpty a -> a sconcat (a :| as) = go a as where go b (c:cs) = b <> go c cs go b [] = b -- | Repeat a value @n@ times. -- -- Given that this works on a 'Semigroup' it is allowed to fail if you request 0 or fewer -- repetitions, and the default definition will do so. -- -- By making this a member of the class, idempotent semigroups and monoids can upgrade this to execute in -- /O(1)/ by picking @stimes = stimesIdempotent@ or @stimes = stimesIdempotentMonoid@ respectively. -- -- @since 0.17 stimes :: Integral b => b -> a -> a stimes y0 x0 | y0 <= 0 = error "stimes: positive multiplier expected" | otherwise = f x0 y0 where f x y | even y = f (x <> x) (y `quot` 2) | y == 1 = x | otherwise = g (x <> x) (y `quot` 2) x -- See Note [Half of y - 1] g x y z | even y = g (x <> x) (y `quot` 2) z | y == 1 = x <> z | otherwise = g (x <> x) (y `quot` 2) (x <> z) -- See Note [Half of y - 1] {-# INLINE stimes #-} {- Note [Half of y - 1] ~~~~~~~~~~~~~~~~~~~~~ Since y is guaranteed to be odd and positive here, half of y - 1 can be computed as y `quot` 2, optimising subtraction away. -} -- | A generalization of 'Data.List.cycle' to an arbitrary 'Semigroup'. -- May fail to terminate for some values in some semigroups. cycle1 :: Semigroup m => m -> m cycle1 xs = xs' where xs' = xs <> xs' instance Semigroup () where _ <> _ = () sconcat _ = () stimes _ _ = () instance Semigroup b => Semigroup (a -> b) where f <> g = \a -> f a <> g a stimes n f e = stimes n (f e) instance Semigroup [a] where (<>) = (++) stimes n x | n < 0 = error "stimes: [], negative multiplier" | otherwise = rep n where rep 0 = [] rep i = x ++ rep (i - 1) instance Semigroup a => Semigroup (Maybe a) where Nothing <> b = b a <> Nothing = a Just a <> Just b = Just (a <> b) stimes _ Nothing = Nothing stimes n (Just a) = case compare n 0 of LT -> error "stimes: Maybe, negative multiplier" EQ -> Nothing GT -> Just (stimes n a) instance Semigroup (Either a b) where Left _ <> b = b a <> _ = a stimes = stimesIdempotent instance (Semigroup a, Semigroup b) => Semigroup (a, b) where (a,b) <> (a',b') = (a<>a',b<>b') stimes n (a,b) = (stimes n a, stimes n b) instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c') stimes n (a,b,c) = (stimes n a, stimes n b, stimes n c) instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) => Semigroup (a, b, c, d) where (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d') stimes n (a,b,c,d) = (stimes n a, stimes n b, stimes n c, stimes n d) instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) => Semigroup (a, b, c, d, e) where (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e') stimes n (a,b,c,d,e) = (stimes n a, stimes n b, stimes n c, stimes n d, stimes n e) instance Semigroup Ordering where LT <> _ = LT EQ <> y = y GT <> _ = GT stimes = stimesIdempotentMonoid instance Semigroup a => Semigroup (Dual a) where Dual a <> Dual b = Dual (b <> a) stimes n (Dual a) = Dual (stimes n a) instance Semigroup (Endo a) where #ifdef USE_COERCE (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> (a -> a)) #else Endo f <> Endo g = Endo (f . g) #endif stimes = stimesMonoid instance Semigroup All where #ifdef USE_COERCE (<>) = coerce (&&) #else All a <> All b = All (a && b) #endif stimes = stimesIdempotentMonoid instance Semigroup Any where #ifdef USE_COERCE (<>) = coerce (||) #else Any a <> Any b = Any (a || b) #endif stimes = stimesIdempotentMonoid instance Num a => Semigroup (Sum a) where #ifdef USE_COERCE (<>) = coerce ((+) :: a -> a -> a) #else Sum a <> Sum b = Sum (a + b) #endif stimes n (Sum a) = Sum (fromIntegral n * a) instance Num a => Semigroup (Product a) where #ifdef USE_COERCE (<>) = coerce ((*) :: a -> a -> a) #else Product a <> Product b = Product (a * b) #endif stimes n (Product a) = Product (a ^ n) instance Semigroup a => Semigroup (Down a) where #ifdef USE_COERCE (<>) = coerce ((<>) :: a -> a -> a) #else Down a <> Down b = Down (a <> b) #endif stimes n (Down a) = Down (stimes n a) -- | This is a valid definition of 'stimes' for a 'Monoid'. -- -- Unlike the default definition of 'stimes', it is defined for 0 -- and so it should be preferred where possible. stimesMonoid :: (Integral b, Monoid a) => b -> a -> a stimesMonoid n x0 = case compare n 0 of LT -> error "stimesMonoid: negative multiplier" EQ -> mempty GT -> f x0 n where f x y | even y = f (x `mappend` x) (y `quot` 2) | y == 1 = x | otherwise = g (x `mappend` x) (y `quot` 2) x -- See Note [Half of y - 1] g x y z | even y = g (x `mappend` x) (y `quot` 2) z | y == 1 = x `mappend` z | otherwise = g (x `mappend` x) (y `quot` 2) (x `mappend` z) -- See Note [Half of y - 1] -- | This is a valid definition of 'stimes' for an idempotent 'Monoid'. -- -- When @mappend x x = x@, this definition should be preferred, because it -- works in /O(1)/ rather than /O(log n)/ stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a stimesIdempotentMonoid n x = case compare n 0 of LT -> error "stimesIdempotentMonoid: negative multiplier" EQ -> mempty GT -> x {-# INLINE stimesIdempotentMonoid #-} -- | This is a valid definition of 'stimes' for an idempotent 'Semigroup'. -- -- When @x <> x = x@, this definition should be preferred, because it -- works in /O(1)/ rather than /O(log n)/. stimesIdempotent :: Integral b => b -> a -> a stimesIdempotent n x | n <= 0 = error "stimesIdempotent: positive multiplier expected" | otherwise = x {-# INLINE stimesIdempotent #-} instance Semigroup a => Semigroup (Const a b) where #ifdef USE_COERCE (<>) = coerce ((<>) :: a -> a -> a) #else Const a <> Const b = Const (a <> b) #endif stimes n (Const a) = Const (stimes n a) #if MIN_VERSION_base(3,0,0) instance Semigroup (Monoid.First a) where Monoid.First Nothing <> b = b a <> _ = a stimes = stimesIdempotentMonoid instance Semigroup (Monoid.Last a) where a <> Monoid.Last Nothing = a _ <> b = b stimes = stimesIdempotentMonoid #endif #if MIN_VERSION_base(4,8,0) instance Alternative f => Semigroup (Alt f a) where # ifdef USE_COERCE (<>) = coerce ((<|>) :: f a -> f a -> f a) # else Alt a <> Alt b = Alt (a <|> b) # endif stimes = stimesMonoid #endif #if MIN_VERSION_base(4,8,0) instance Semigroup Void where a <> _ = a stimes = stimesIdempotent #endif instance Semigroup (NonEmpty a) where (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs) newtype Min a = Min { getMin :: a } deriving ( Eq, Ord, Show, Read #ifdef LANGUAGE_DeriveDataTypeable , Data, Typeable #endif #ifdef LANGUAGE_DeriveGeneric , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) instance Bounded a => Bounded (Min a) where minBound = Min minBound maxBound = Min maxBound instance Enum a => Enum (Min a) where succ (Min a) = Min (succ a) pred (Min a) = Min (pred a) toEnum = Min . toEnum fromEnum = fromEnum . getMin enumFrom (Min a) = Min <$> enumFrom a enumFromThen (Min a) (Min b) = Min <$> enumFromThen a b enumFromTo (Min a) (Min b) = Min <$> enumFromTo a b enumFromThenTo (Min a) (Min b) (Min c) = Min <$> enumFromThenTo a b c #ifdef MIN_VERSION_hashable instance Hashable a => Hashable (Min a) where #if MIN_VERSION_hashable(1,2,0) hashWithSalt p (Min a) = hashWithSalt p a #else hash (Min a) = hash a #endif #endif instance Ord a => Semigroup (Min a) where #ifdef USE_COERCE (<>) = coerce (min :: a -> a -> a) #else Min a <> Min b = Min (a `min` b) #endif stimes = stimesIdempotent instance (Ord a, Bounded a) => Monoid (Min a) where mempty = maxBound mappend = (<>) instance Functor Min where fmap f (Min x) = Min (f x) instance Foldable Min where foldMap f (Min a) = f a instance Traversable Min where traverse f (Min a) = Min <$> f a instance Applicative Min where pure = Min a <* _ = a _ *> a = a Min f <*> Min x = Min (f x) instance Monad Min where return = Min _ >> a = a Min a >>= f = f a instance MonadFix Min where mfix f = fix (f . getMin) #ifdef MIN_VERSION_deepseq instance NFData a => NFData (Min a) where rnf (Min a) = rnf a #endif instance Num a => Num (Min a) where (Min a) + (Min b) = Min (a + b) (Min a) * (Min b) = Min (a * b) (Min a) - (Min b) = Min (a - b) negate (Min a) = Min (negate a) abs (Min a) = Min (abs a) signum (Min a) = Min (signum a) fromInteger = Min . fromInteger #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 instance Generic1 Min where type Rep1 Min = D1 D1Min (C1 C1_0Min (S1 S1_0_0Min Par1)) from1 (Min x) = M1 (M1 (M1 (Par1 x))) to1 (M1 (M1 (M1 x))) = Min (unPar1 x) instance Datatype D1Min where datatypeName _ = "Min" moduleName _ = "Data.Semigroup" instance Constructor C1_0Min where conName _ = "Min" conIsRecord _ = True instance Selector S1_0_0Min where selName _ = "getMin" data D1Min data C1_0Min data S1_0_0Min #endif newtype Max a = Max { getMax :: a } deriving ( Eq, Ord, Show, Read #ifdef LANGUAGE_DeriveDataTypeable , Data, Typeable #endif #ifdef LANGUAGE_DeriveGeneric , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) instance Bounded a => Bounded (Max a) where minBound = Max minBound maxBound = Max maxBound instance Enum a => Enum (Max a) where succ (Max a) = Max (succ a) pred (Max a) = Max (pred a) toEnum = Max . toEnum fromEnum = fromEnum . getMax enumFrom (Max a) = Max <$> enumFrom a enumFromThen (Max a) (Max b) = Max <$> enumFromThen a b enumFromTo (Max a) (Max b) = Max <$> enumFromTo a b enumFromThenTo (Max a) (Max b) (Max c) = Max <$> enumFromThenTo a b c #ifdef MIN_VERSION_hashable instance Hashable a => Hashable (Max a) where #if MIN_VERSION_hashable(1,2,0) hashWithSalt p (Max a) = hashWithSalt p a #else hash (Max a) = hash a #endif #endif instance Ord a => Semigroup (Max a) where #ifdef USE_COERCE (<>) = coerce (max :: a -> a -> a) #else Max a <> Max b = Max (a `max` b) #endif stimes = stimesIdempotent instance (Ord a, Bounded a) => Monoid (Max a) where mempty = minBound mappend = (<>) instance Functor Max where fmap f (Max x) = Max (f x) instance Foldable Max where foldMap f (Max a) = f a instance Traversable Max where traverse f (Max a) = Max <$> f a instance Applicative Max where pure = Max a <* _ = a _ *> a = a Max f <*> Max x = Max (f x) instance Monad Max where return = Max _ >> a = a Max a >>= f = f a instance MonadFix Max where mfix f = fix (f . getMax) #ifdef MIN_VERSION_deepseq instance NFData a => NFData (Max a) where rnf (Max a) = rnf a #endif instance Num a => Num (Max a) where (Max a) + (Max b) = Max (a + b) (Max a) * (Max b) = Max (a * b) (Max a) - (Max b) = Max (a - b) negate (Max a) = Max (negate a) abs (Max a) = Max (abs a) signum (Max a) = Max (signum a) fromInteger = Max . fromInteger #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 instance Generic1 Max where type Rep1 Max = D1 D1Max (C1 C1_0Max (S1 S1_0_0Max Par1)) from1 (Max x) = M1 (M1 (M1 (Par1 x))) to1 (M1 (M1 (M1 x))) = Max (unPar1 x) instance Datatype D1Max where datatypeName _ = "Max" moduleName _ = "Data.Semigroup" instance Constructor C1_0Max where conName _ = "Max" conIsRecord _ = True instance Selector S1_0_0Max where selName _ = "getMax" data D1Max data C1_0Max data S1_0_0Max #endif -- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be placed inside 'Min' and 'Max' -- to compute an arg min or arg max. data Arg a b = Arg a b deriving ( Show, Read #ifdef LANGUAGE_DeriveDataTypeable , Data, Typeable #endif #ifdef LANGUAGE_DeriveGeneric , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) type ArgMin a b = Min (Arg a b) type ArgMax a b = Max (Arg a b) instance Functor (Arg a) where fmap f (Arg x a) = Arg x (f a) instance Foldable (Arg a) where foldMap f (Arg _ a) = f a instance Traversable (Arg a) where traverse f (Arg x a) = Arg x <$> f a instance Eq a => Eq (Arg a b) where Arg a _ == Arg b _ = a == b instance Ord a => Ord (Arg a b) where Arg a _ `compare` Arg b _ = compare a b min x@(Arg a _) y@(Arg b _) | a <= b = x | otherwise = y max x@(Arg a _) y@(Arg b _) | a >= b = x | otherwise = y #ifdef MIN_VERSION_deepseq instance (NFData a, NFData b) => NFData (Arg a b) where rnf (Arg a b) = rnf a `seq` rnf b `seq` () #endif #ifdef MIN_VERSION_hashable instance (Hashable a, Hashable b) => Hashable (Arg a b) where #if MIN_VERSION_hashable(1,2,0) hashWithSalt p (Arg a b) = hashWithSalt p a `hashWithSalt` b #else hash (Arg a b) = hashWithSalt (hash a) b #endif #endif #if MIN_VERSION_base(4,8,0) instance Bifunctor Arg where bimap f g (Arg a b) = Arg (f a) (g b) #endif #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 instance Generic1 (Arg a) where type Rep1 (Arg a) = D1 D1Arg (C1 C1_0Arg (S1 NoSelector (Rec0 a) :*: S1 NoSelector Par1)) from1 (Arg a b) = M1 (M1 (M1 (K1 a) :*: M1 (Par1 b))) to1 (M1 (M1 (M1 a :*: M1 b))) = Arg (unK1 a) (unPar1 b) instance Datatype D1Arg where datatypeName _ = "Arg" moduleName _ = "Data.Semigroup" instance Constructor C1_0Arg where conName _ = "Arg" data D1Arg data C1_0Arg #endif -- | Use @'Option' ('First' a)@ to get the behavior of 'Data.Monoid.First' from @Data.Monoid@. newtype First a = First { getFirst :: a } deriving ( Eq, Ord, Show, Read #ifdef LANGUAGE_DeriveDataTypeable , Data , Typeable #endif #ifdef LANGUAGE_DeriveGeneric , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) instance Bounded a => Bounded (First a) where minBound = First minBound maxBound = First maxBound instance Enum a => Enum (First a) where succ (First a) = First (succ a) pred (First a) = First (pred a) toEnum = First . toEnum fromEnum = fromEnum . getFirst enumFrom (First a) = First <$> enumFrom a enumFromThen (First a) (First b) = First <$> enumFromThen a b enumFromTo (First a) (First b) = First <$> enumFromTo a b enumFromThenTo (First a) (First b) (First c) = First <$> enumFromThenTo a b c #ifdef MIN_VERSION_hashable instance Hashable a => Hashable (First a) where #if MIN_VERSION_hashable(1,2,0) hashWithSalt p (First a) = hashWithSalt p a #else hash (First a) = hash a #endif #endif instance Semigroup (First a) where a <> _ = a stimes = stimesIdempotent instance Functor First where fmap f (First x) = First (f x) instance Foldable First where foldMap f (First a) = f a instance Traversable First where traverse f (First a) = First <$> f a instance Applicative First where pure x = First x a <* _ = a _ *> a = a First f <*> First x = First (f x) instance Monad First where return = First _ >> a = a First a >>= f = f a instance MonadFix First where mfix f = fix (f . getFirst) #ifdef MIN_VERSION_deepseq instance NFData a => NFData (First a) where rnf (First a) = rnf a #endif #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 instance Generic1 First where type Rep1 First = D1 D1First (C1 C1_0First (S1 S1_0_0First Par1)) from1 (First x) = M1 (M1 (M1 (Par1 x))) to1 (M1 (M1 (M1 x))) = First (unPar1 x) instance Datatype D1First where datatypeName _ = "First" moduleName _ = "Data.Semigroup" instance Constructor C1_0First where conName _ = "First" conIsRecord _ = True instance Selector S1_0_0First where selName _ = "getFirst" data D1First data C1_0First data S1_0_0First #endif -- | Use @'Option' ('Last' a)@ to get the behavior of 'Data.Monoid.Last' from @Data.Monoid@ newtype Last a = Last { getLast :: a } deriving ( Eq, Ord, Show, Read #ifdef LANGUAGE_DeriveDataTypeable , Data, Typeable #endif #ifdef LANGUAGE_DeriveGeneric , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) instance Bounded a => Bounded (Last a) where minBound = Last minBound maxBound = Last maxBound instance Enum a => Enum (Last a) where succ (Last a) = Last (succ a) pred (Last a) = Last (pred a) toEnum = Last . toEnum fromEnum = fromEnum . getLast enumFrom (Last a) = Last <$> enumFrom a enumFromThen (Last a) (Last b) = Last <$> enumFromThen a b enumFromTo (Last a) (Last b) = Last <$> enumFromTo a b enumFromThenTo (Last a) (Last b) (Last c) = Last <$> enumFromThenTo a b c #ifdef MIN_VERSION_hashable instance Hashable a => Hashable (Last a) where #if MIN_VERSION_hashable(1,2,0) hashWithSalt p (Last a) = hashWithSalt p a #else hash (Last a) = hash a #endif #endif instance Semigroup (Last a) where _ <> b = b stimes = stimesIdempotent instance Functor Last where fmap f (Last x) = Last (f x) a <$ _ = Last a instance Foldable Last where foldMap f (Last a) = f a instance Traversable Last where traverse f (Last a) = Last <$> f a instance Applicative Last where pure = Last a <* _ = a _ *> a = a Last f <*> Last x = Last (f x) instance Monad Last where return = Last _ >> a = a Last a >>= f = f a instance MonadFix Last where mfix f = fix (f . getLast) #ifdef MIN_VERSION_deepseq instance NFData a => NFData (Last a) where rnf (Last a) = rnf a #endif #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 instance Generic1 Last where type Rep1 Last = D1 D1Last (C1 C1_0Last (S1 S1_0_0Last Par1)) from1 (Last x) = M1 (M1 (M1 (Par1 x))) to1 (M1 (M1 (M1 x))) = Last (unPar1 x) instance Datatype D1Last where datatypeName _ = "Last" moduleName _ = "Data.Semigroup" instance Constructor C1_0Last where conName _ = "Last" conIsRecord _ = True instance Selector S1_0_0Last where selName _ = "getLast" data D1Last data C1_0Last data S1_0_0Last #endif -- (==)/XNOR on Bool forms a 'Semigroup', but has no good name #ifdef MIN_VERSION_binary # if !(MIN_VERSION_binary(0,8,3)) instance Semigroup Builder.Builder where (<>) = mappend # endif #endif #ifdef MIN_VERSION_bytestring instance Semigroup BS.ByteString where (<>) = mappend sconcat (b:|bs) = BS.concat (b:bs) instance Semigroup BL.ByteString where (<>) = mappend sconcat (b:|bs) = BL.concat (b:bs) # if (MIN_VERSION_bytestring(0,10,0)) || defined(MIN_VERSION_bytestring_builder) instance Semigroup ByteString.Builder where (<>) = mappend # endif # if (MIN_VERSION_bytestring(0,10,4)) || defined(MIN_VERSION_bytestring_builder) instance Semigroup ShortByteString where (<>) = mappend # endif #endif #ifdef MIN_VERSION_text instance Semigroup TS.Text where (<>) = mappend instance Semigroup TL.Text where (<>) = mappend instance Semigroup Text.Builder where (<>) = mappend #endif #ifdef MIN_VERSION_unordered_containers instance (Hashable k, Eq k) => Semigroup (Lazy.HashMap k a) where (<>) = mappend stimes = stimesIdempotentMonoid instance (Hashable a, Eq a) => Semigroup (HashSet a) where (<>) = mappend stimes = stimesIdempotentMonoid #endif -- | Provide a Semigroup for an arbitrary Monoid. newtype WrappedMonoid m = WrapMonoid { unwrapMonoid :: m } deriving ( Eq, Ord, Show, Read #ifdef LANGUAGE_DeriveDataTypeable , Data, Typeable #endif #ifdef LANGUAGE_DeriveGeneric , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) #ifdef MIN_VERSION_hashable instance Hashable a => Hashable (WrappedMonoid a) where #if MIN_VERSION_hashable(1,2,0) hashWithSalt p (WrapMonoid a) = hashWithSalt p a #else hash (WrapMonoid a) = hash a #endif #endif instance Monoid m => Semigroup (WrappedMonoid m) where #ifdef USE_COERCE (<>) = coerce (mappend :: m -> m -> m) #else WrapMonoid a <> WrapMonoid b = WrapMonoid (a `mappend` b) #endif instance Monoid m => Monoid (WrappedMonoid m) where mempty = WrapMonoid mempty mappend = (<>) instance Bounded a => Bounded (WrappedMonoid a) where minBound = WrapMonoid minBound maxBound = WrapMonoid maxBound instance Enum a => Enum (WrappedMonoid a) where succ (WrapMonoid a) = WrapMonoid (succ a) pred (WrapMonoid a) = WrapMonoid (pred a) toEnum = WrapMonoid . toEnum fromEnum = fromEnum . unwrapMonoid enumFrom (WrapMonoid a) = WrapMonoid <$> enumFrom a enumFromThen (WrapMonoid a) (WrapMonoid b) = WrapMonoid <$> enumFromThen a b enumFromTo (WrapMonoid a) (WrapMonoid b) = WrapMonoid <$> enumFromTo a b enumFromThenTo (WrapMonoid a) (WrapMonoid b) (WrapMonoid c) = WrapMonoid <$> enumFromThenTo a b c #ifdef MIN_VERSION_deepseq instance NFData m => NFData (WrappedMonoid m) where rnf (WrapMonoid a) = rnf a #endif #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 instance Generic1 WrappedMonoid where type Rep1 WrappedMonoid = D1 D1WrappedMonoid (C1 C1_0WrappedMonoid (S1 S1_0_0WrappedMonoid Par1)) from1 (WrapMonoid x) = M1 (M1 (M1 (Par1 x))) to1 (M1 (M1 (M1 x))) = WrapMonoid (unPar1 x) instance Datatype D1WrappedMonoid where datatypeName _ = "WrappedMonoid" moduleName _ = "Data.Semigroup" instance Constructor C1_0WrappedMonoid where conName _ = "WrapMonoid" conIsRecord _ = True instance Selector S1_0_0WrappedMonoid where selName _ = "unwrapMonoid" data D1WrappedMonoid data C1_0WrappedMonoid data S1_0_0WrappedMonoid #endif -- | Repeat a value @n@ times. -- -- > mtimesDefault n a = a <> a <> ... <> a -- using <> (n-1) times -- -- Implemented using 'stimes' and 'mempty'. -- -- This is a suitable definition for an 'mtimes' member of 'Monoid'. -- -- @since 0.17 mtimesDefault :: (Integral b, Monoid a) => b -> a -> a mtimesDefault n x | n == 0 = mempty | otherwise = unwrapMonoid (stimes n (WrapMonoid x)) -- | 'Option' is effectively 'Maybe' with a better instance of 'Monoid', built off of an underlying 'Semigroup' -- instead of an underlying 'Monoid'. -- -- Ideally, this type would not exist at all and we would just fix the 'Monoid' instance of 'Maybe' newtype Option a = Option { getOption :: Maybe a } deriving ( Eq, Ord, Show, Read #ifdef LANGUAGE_DeriveDataTypeable , Data, Typeable #endif #ifdef LANGUAGE_DeriveGeneric , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) #ifdef MIN_VERSION_hashable instance Hashable a => Hashable (Option a) where #if MIN_VERSION_hashable(1,2,0) hashWithSalt p (Option a) = hashWithSalt p a #else hash (Option a) = hash a #endif #endif instance Functor Option where fmap f (Option a) = Option (fmap f a) instance Applicative Option where pure a = Option (Just a) Option a <*> Option b = Option (a <*> b) instance Monad Option where return = pure Option (Just a) >>= k = k a _ >>= _ = Option Nothing Option Nothing >> _ = Option Nothing _ >> b = b instance Alternative Option where empty = Option Nothing Option Nothing <|> b = b a <|> _ = a instance MonadPlus Option where mzero = Option Nothing mplus = (<|>) instance MonadFix Option where mfix f = Option (mfix (getOption . f)) instance Foldable Option where foldMap f (Option (Just m)) = f m foldMap _ (Option Nothing) = mempty instance Traversable Option where traverse f (Option (Just a)) = Option . Just <$> f a traverse _ (Option Nothing) = pure (Option Nothing) #ifdef MIN_VERSION_deepseq instance NFData a => NFData (Option a) where rnf (Option a) = rnf a #endif -- | Fold an 'Option' case-wise, just like 'maybe'. option :: b -> (a -> b) -> Option a -> b option n j (Option m) = maybe n j m instance Semigroup a => Semigroup (Option a) where #ifdef USE_COERCE (<>) = coerce ((<>) :: Maybe a -> Maybe a -> Maybe a) #else Option a <> Option b = Option (a <> b) #endif stimes _ (Option Nothing) = Option Nothing stimes n (Option (Just a)) = case compare n 0 of LT -> error "stimes: Option, negative multiplier" EQ -> Option Nothing GT -> Option (Just (stimes n a)) instance Semigroup a => Monoid (Option a) where mempty = Option Nothing mappend = (<>) #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 instance Generic1 Option where type Rep1 Option = D1 D1Option (C1 C1_0Option (S1 S1_0_0Option (Rec1 Maybe))) from1 (Option x) = M1 (M1 (M1 (Rec1 x))) to1 (M1 (M1 (M1 x))) = Option (unRec1 x) instance Datatype D1Option where datatypeName _ = "Option" moduleName _ = "Data.Semigroup" instance Constructor C1_0Option where conName _ = "Option" conIsRecord _ = True instance Selector S1_0_0Option where selName _ = "getOption" data D1Option data C1_0Option data S1_0_0Option #endif -- | This lets you use a difference list of a 'Semigroup' as a 'Monoid'. diff :: Semigroup m => m -> Endo m diff = Endo . (<>) #ifdef MIN_VERSION_containers instance Semigroup (Seq a) where (<>) = (><) instance Semigroup IntSet where (<>) = mappend stimes = stimesIdempotentMonoid instance Ord a => Semigroup (Set a) where (<>) = mappend stimes = stimesIdempotentMonoid instance Semigroup (IntMap v) where (<>) = mappend stimes = stimesIdempotentMonoid instance Ord k => Semigroup (Map k v) where (<>) = mappend stimes = stimesIdempotentMonoid #endif #if (MIN_VERSION_base(4,8,0)) || defined(MIN_VERSION_transformers) instance Semigroup a => Semigroup (Identity a) where # ifdef USE_COERCE (<>) = coerce ((<>) :: a -> a -> a) # else Identity a <> Identity b = Identity (a <> b) # endif stimes n (Identity a) = Identity (stimes n a) #endif #if (MIN_VERSION_base(4,7,0)) || defined(MIN_VERSION_tagged) instance Semigroup (Proxy s) where _ <> _ = Proxy sconcat _ = Proxy stimes _ _ = Proxy #endif #ifdef MIN_VERSION_tagged instance Semigroup a => Semigroup (Tagged s a) where # ifdef USE_COERCE (<>) = coerce ((<>) :: a -> a -> a) # else Tagged a <> Tagged b = Tagged (a <> b) # endif stimes n (Tagged a) = Tagged (stimes n a) #endif instance Semigroup a => Semigroup (IO a) where (<>) = liftA2 (<>) instance Semigroup a => Semigroup (Strict.ST s a) where #if MIN_VERSION_base(4,4,0) (<>) = liftA2 (<>) #else (<>) = liftM2 (<>) -- No Applicative instance for ST on GHC 7.0 #endif #if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) && !defined(ETA_VERSION) # if MIN_VERSION_base(4,4,0) instance Semigroup Event where (<>) = mappend stimes = stimesMonoid # endif # if MIN_VERSION_base(4,8,1) instance Semigroup Lifetime where (<>) = mappend stimes = stimesMonoid # endif #endif semigroups-0.18.5/src-ghc7/Data/List/0000755000000000000000000000000013316521203015365 5ustar0000000000000000semigroups-0.18.5/src-ghc7/Data/List/NonEmpty.hs0000644000000000000000000005427713316521203017511 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 #if defined(MIN_VERSION_hashable) || __GLASGOW_HASKELL__ == 702 \ || __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE Trustworthy #-} #else {-# LANGUAGE Safe #-} #endif #endif #ifdef __GLASGOW_HASKELL__ #define LANGUAGE_DeriveDataTypeable {-# LANGUAGE DeriveDataTypeable #-} #endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 #define LANGUAGE_DeriveGeneric {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ----------------------------------------------------------------------------- -- | -- Module : Data.List.NonEmpty -- Copyright : (C) 2011-2015 Edward Kmett, -- (C) 2010 Tony Morris, Oliver Taylor, Eelis van der Weegen -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- A NonEmpty list forms a monad as per list, but always contains at least -- one element. ---------------------------------------------------------------------------- module Data.List.NonEmpty ( -- * The type of non-empty streams NonEmpty(..) -- * Non-empty stream transformations , map -- :: (a -> b) -> NonEmpty a -> NonEmpty b , intersperse -- :: a -> NonEmpty a -> NonEmpty a , scanl -- :: Foldable f => (b -> a -> b) -> b -> f a -> NonEmpty b , scanr -- :: Foldable f => (a -> b -> b) -> b -> f a -> NonEmpty b , scanl1 -- :: (a -> a -> a) -> NonEmpty a -> NonEmpty a , scanr1 -- :: (a -> a -> a) -> NonEmpty a -> NonEmpty a , transpose -- :: NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a) , sortBy -- :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a , sortWith -- :: Ord o => (a -> o) -> NonEmpty a -> NonEmpty a -- * Basic functions , length -- :: NonEmpty a -> Int , head -- :: NonEmpty a -> a , tail -- :: NonEmpty a -> [a] , last -- :: NonEmpty a -> a , init -- :: NonEmpty a -> [a] , (<|), cons -- :: a -> NonEmpty a -> NonEmpty a , uncons -- :: NonEmpty a -> (a, Maybe (NonEmpty a)) , unfoldr -- :: (a -> (b, Maybe a)) -> a -> NonEmpty b , sort -- :: NonEmpty a -> NonEmpty a , reverse -- :: NonEmpty a -> NonEmpty a , inits -- :: Foldable f => f a -> NonEmpty a , tails -- :: Foldable f => f a -> NonEmpty a -- * Building streams , iterate -- :: (a -> a) -> a -> NonEmpty a , repeat -- :: a -> NonEmpty a , cycle -- :: NonEmpty a -> NonEmpty a , unfold -- :: (a -> (b, Maybe a) -> a -> NonEmpty b , insert -- :: (Foldable f, Ord a) => a -> f a -> NonEmpty a , some1 -- :: Alternative f => f a -> f (NonEmpty a) -- * Extracting sublists , take -- :: Int -> NonEmpty a -> [a] , drop -- :: Int -> NonEmpty a -> [a] , splitAt -- :: Int -> NonEmpty a -> ([a], [a]) , takeWhile -- :: Int -> NonEmpty a -> [a] , dropWhile -- :: Int -> NonEmpty a -> [a] , span -- :: Int -> NonEmpty a -> ([a],[a]) , break -- :: Int -> NonEmpty a -> ([a],[a]) , filter -- :: (a -> Bool) -> NonEmpty a -> [a] , partition -- :: (a -> Bool) -> NonEmpty a -> ([a],[a]) , group -- :: Foldable f => Eq a => f a -> [NonEmpty a] , groupBy -- :: Foldable f => (a -> a -> Bool) -> f a -> [NonEmpty a] , groupWith -- :: (Foldable f, Eq b) => (a -> b) -> f a -> [NonEmpty a] , groupAllWith -- :: (Foldable f, Ord b) => (a -> b) -> f a -> [NonEmpty a] , group1 -- :: Eq a => NonEmpty a -> NonEmpty (NonEmpty a) , groupBy1 -- :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a) , groupWith1 -- :: (Foldable f, Eq b) => (a -> b) -> f a -> NonEmpty (NonEmpty a) , groupAllWith1 -- :: (Foldable f, Ord b) => (a -> b) -> f a -> NonEmpty (NonEmpty a) -- * Sublist predicates , isPrefixOf -- :: Foldable f => f a -> NonEmpty a -> Bool -- * \"Set\" operations , nub -- :: Eq a => NonEmpty a -> NonEmpty a , nubBy -- :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a -- * Indexing streams , (!!) -- :: NonEmpty a -> Int -> a -- * Zipping and unzipping streams , zip -- :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b) , zipWith -- :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c , unzip -- :: NonEmpty (a, b) -> (NonEmpty a, NonEmpty b) -- * Converting to and from a list , fromList -- :: [a] -> NonEmpty a , toList -- :: NonEmpty a -> [a] , nonEmpty -- :: [a] -> Maybe (NonEmpty a) , xor -- :: NonEmpty a -> Bool ) where import qualified Prelude import Prelude hiding ( head, tail, map, reverse , scanl, scanl1, scanr, scanr1 , iterate, take, drop, takeWhile , dropWhile, repeat, cycle, filter , (!!), zip, unzip, zipWith, words , unwords, lines, unlines, break, span , splitAt, foldr, foldl, last, init , length ) import Control.Applicative #ifdef MIN_VERSION_deepseq import Control.DeepSeq (NFData(..)) #endif import Control.Monad import Control.Monad.Fix #if MIN_VERSION_base(4,4,0) import Control.Monad.Zip (MonadZip(..)) #endif #ifdef LANGUAGE_DeriveDataTypeable import Data.Data hiding (Infix) #endif #if MIN_VERSION_base(4,8,0) import Data.Foldable hiding (toList, length) #else import Data.Foldable hiding (toList) import Data.Monoid (mappend) import Data.Traversable #endif import qualified Data.Foldable as Foldable import Data.Function (on) #ifdef MIN_VERSION_hashable import Data.Hashable #endif #ifdef MIN_VERSION_transformers import Data.Functor.Classes (Eq1(..), Ord1(..), Read1(..), Show1(..)) #endif import qualified Data.List as List import Data.Ord (comparing) #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts #endif -- import Data.Semigroup hiding (Last) -- import Data.Semigroup.Foldable -- import Data.Semigroup.Traversable #ifdef LANGUAGE_DeriveGeneric import GHC.Generics #endif infixr 5 :|, <| data NonEmpty a = a :| [a] deriving ( Eq, Ord, Show, Read #ifdef LANGUAGE_DeriveDataTypeable , Data, Typeable #endif #ifdef LANGUAGE_DeriveGeneric , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) #ifdef MIN_VERSION_hashable instance Hashable a => Hashable (NonEmpty a) where #if MIN_VERSION_hashable(1,2,0) hashWithSalt p (a :| as) = p `hashWithSalt` a `hashWithSalt` as #else hash (a :| as) = hash a `combine` hash as #endif #endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 instance Exts.IsList (NonEmpty a) where type Item (NonEmpty a) = a fromList = fromList toList = toList #endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 instance Generic1 NonEmpty where type Rep1 NonEmpty = D1 D1NonEmpty (C1 C1_0NonEmpty (S1 NoSelector Par1 :*: S1 NoSelector (Rec1 []))) from1 (h :| t) = M1 (M1 (M1 (Par1 h) :*: M1 (Rec1 t))) to1 (M1 (M1 (M1 h :*: M1 t))) = unPar1 h :| unRec1 t instance Datatype D1NonEmpty where datatypeName _ = "NonEmpty" moduleName _ = "Data.List.NonEmpty" instance Constructor C1_0NonEmpty where conName _ = ":|" conFixity _ = Infix RightAssociative 5 data D1NonEmpty data C1_0NonEmpty #endif #ifdef MIN_VERSION_deepseq instance NFData a => NFData (NonEmpty a) where rnf (x :| xs) = rnf x `seq` rnf xs #endif instance MonadFix NonEmpty where mfix f = case fix (f . head) of ~(x :| _) -> x :| mfix (tail . f) #if MIN_VERSION_base(4,4,0) instance MonadZip NonEmpty where mzip = zip mzipWith = zipWith munzip = unzip #endif #ifdef MIN_VERSION_transformers # if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0) instance Eq1 NonEmpty where liftEq eq (a :| as) (b :| bs) = eq a b && liftEq eq as bs instance Ord1 NonEmpty where liftCompare cmp (a :| as) (b :| bs) = cmp a b `mappend` liftCompare cmp as bs instance Read1 NonEmpty where liftReadsPrec rdP rdL p s = readParen (p > 5) (\s' -> do (a, s'') <- rdP 6 s' (":|", s''') <- lex s'' (as, s'''') <- rdL s''' return (a :| as, s'''')) s instance Show1 NonEmpty where liftShowsPrec shwP shwL p (a :| as) = showParen (p > 5) $ shwP 6 a . showString " :| " . shwL as # else instance Eq1 NonEmpty where eq1 (a :| as) (b :| bs) = a == b && as == bs instance Ord1 NonEmpty where compare1 (a :| as) (b :| bs) = compare a b `mappend` compare as bs instance Read1 NonEmpty where readsPrec1 p s = readParen (p > 5) (\s' -> do (a, s'') <- readsPrec 6 s' (":|", s''') <- lex s'' (as, s'''') <- readList s''' return (a :| as, s'''')) s instance Show1 NonEmpty where showsPrec1 p (a :| as) = showParen (p > 5) $ showsPrec 6 a . showString " :| " . showList as # endif #endif length :: NonEmpty a -> Int length (_ :| xs) = 1 + Prelude.length xs {-# INLINE length #-} xor :: NonEmpty Bool -> Bool xor (x :| xs) = foldr xor' x xs where xor' True y = not y xor' False y = y -- | 'unfold' produces a new stream by repeatedly applying the unfolding -- function to the seed value to produce an element of type @b@ and a new -- seed value. When the unfolding function returns 'Nothing' instead of -- a new seed value, the stream ends. unfold :: (a -> (b, Maybe a)) -> a -> NonEmpty b unfold f a = case f a of (b, Nothing) -> b :| [] (b, Just c) -> b <| unfold f c -- | 'nonEmpty' efficiently turns a normal list into a 'NonEmpty' stream, -- producing 'Nothing' if the input is empty. nonEmpty :: [a] -> Maybe (NonEmpty a) nonEmpty [] = Nothing nonEmpty (a:as) = Just (a :| as) {-# INLINE nonEmpty #-} -- | 'uncons' produces the first element of the stream, and a stream of the -- remaining elements, if any. uncons :: NonEmpty a -> (a, Maybe (NonEmpty a)) uncons ~(a :| as) = (a, nonEmpty as) {-# INLINE uncons #-} unfoldr :: (a -> (b, Maybe a)) -> a -> NonEmpty b unfoldr f a = case f a of (b, mc) -> b :| maybe [] go mc where go c = case f c of (d, me) -> d : maybe [] go me instance Functor NonEmpty where fmap f ~(a :| as) = f a :| fmap f as #if MIN_VERSION_base(4,2,0) b <$ ~(_ :| as) = b :| (b <$ as) #endif instance Applicative NonEmpty where pure a = a :| [] (<*>) = ap instance Monad NonEmpty where return a = a :| [] ~(a :| as) >>= f = b :| (bs ++ bs') where b :| bs = f a bs' = as >>= toList . f instance Traversable NonEmpty where traverse f ~(a :| as) = (:|) <$> f a <*> traverse f as instance Foldable NonEmpty where foldr f z ~(a :| as) = f a (foldr f z as) foldl f z ~(a :| as) = foldl f (f z a) as foldl1 f ~(a :| as) = foldl f a as foldMap f ~(a :| as) = f a `mappend` foldMap f as fold ~(m :| ms) = m `mappend` fold ms #if MIN_VERSION_base(4,8,0) length = length toList = toList #endif -- | Extract the first element of the stream. head :: NonEmpty a -> a head ~(a :| _) = a {-# INLINE head #-} -- | Extract the possibly-empty tail of the stream. tail :: NonEmpty a -> [a] tail ~(_ :| as) = as {-# INLINE tail #-} -- | Extract the last element of the stream. last :: NonEmpty a -> a last ~(a :| as) = List.last (a : as) {-# INLINE last #-} -- | Extract everything except the last element of the stream. init :: NonEmpty a -> [a] init ~(a :| as) = List.init (a : as) {-# INLINE init #-} -- | Prepend an element to the stream. (<|) :: a -> NonEmpty a -> NonEmpty a a <| ~(b :| bs) = a :| b : bs {-# INLINE (<|) #-} -- | Synonym for '<|'. cons :: a -> NonEmpty a -> NonEmpty a cons = (<|) {-# INLINE cons #-} -- | Sort a stream. sort :: Ord a => NonEmpty a -> NonEmpty a sort = lift List.sort {-# INLINE sort #-} -- | Converts a normal list to a 'NonEmpty' stream. -- -- Raises an error if given an empty list. fromList :: [a] -> NonEmpty a fromList (a:as) = a :| as fromList [] = error "NonEmpty.fromList: empty list" {-# INLINE fromList #-} -- | Convert a stream to a normal list efficiently. toList :: NonEmpty a -> [a] toList ~(a :| as) = a : as {-# INLINE toList #-} -- | Lift list operations to work on a 'NonEmpty' stream. -- -- /Beware/: If the provided function returns an empty list, -- this will raise an error. lift :: Foldable f => ([a] -> [b]) -> f a -> NonEmpty b lift f = fromList . f . Foldable.toList {-# INLINE lift #-} -- | Map a function over a 'NonEmpty' stream. map :: (a -> b) -> NonEmpty a -> NonEmpty b map f ~(a :| as) = f a :| fmap f as {-# INLINE map #-} -- | The 'inits' function takes a stream @xs@ and returns all the -- finite prefixes of @xs@. inits :: Foldable f => f a -> NonEmpty [a] inits = fromList . List.inits . Foldable.toList {-# INLINE inits #-} -- | The 'tails' function takes a stream @xs@ and returns all the -- suffixes of @xs@. tails :: Foldable f => f a -> NonEmpty [a] tails = fromList . List.tails . Foldable.toList {-# INLINE tails #-} -- | @'insert' x xs@ inserts @x@ into the last position in @xs@ where it -- is still less than or equal to the next element. In particular, if the -- list is sorted beforehand, the result will also be sorted. insert :: (Foldable f, Ord a) => a -> f a -> NonEmpty a insert a = fromList . List.insert a . Foldable.toList {-# INLINE insert #-} -- | @'some1' x@ sequences @x@ one or more times. some1 :: Alternative f => f a -> f (NonEmpty a) some1 x = (:|) <$> x <*> many x {-# INLINE some1 #-} -- | 'scanl' is similar to 'foldl', but returns a stream of successive -- reduced values from the left: -- -- > scanl f z [x1, x2, ...] == z :| [z `f` x1, (z `f` x1) `f` x2, ...] -- -- Note that -- -- > last (scanl f z xs) == foldl f z xs. scanl :: Foldable f => (b -> a -> b) -> b -> f a -> NonEmpty b scanl f z = fromList . List.scanl f z . Foldable.toList {-# INLINE scanl #-} -- | 'scanr' is the right-to-left dual of 'scanl'. -- Note that -- -- > head (scanr f z xs) == foldr f z xs. scanr :: Foldable f => (a -> b -> b) -> b -> f a -> NonEmpty b scanr f z = fromList . List.scanr f z . Foldable.toList {-# INLINE scanr #-} -- | 'scanl1' is a variant of 'scanl' that has no starting value argument: -- -- > scanl1 f [x1, x2, ...] == x1 :| [x1 `f` x2, x1 `f` (x2 `f` x3), ...] scanl1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a scanl1 f ~(a :| as) = fromList (List.scanl f a as) {-# INLINE scanl1 #-} -- | 'scanr1' is a variant of 'scanr' that has no starting value argument. scanr1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a scanr1 f ~(a :| as) = fromList (List.scanr1 f (a:as)) {-# INLINE scanr1 #-} -- | 'intersperse x xs' alternates elements of the list with copies of @x@. -- -- > intersperse 0 (1 :| [2,3]) == 1 :| [0,2,0,3] intersperse :: a -> NonEmpty a -> NonEmpty a intersperse a ~(b :| bs) = b :| case bs of [] -> [] _ -> a : List.intersperse a bs {-# INLINE intersperse #-} -- | @'iterate' f x@ produces the infinite sequence -- of repeated applications of @f@ to @x@. -- -- > iterate f x = x :| [f x, f (f x), ..] iterate :: (a -> a) -> a -> NonEmpty a iterate f a = a :| List.iterate f (f a) {-# INLINE iterate #-} -- | @'cycle' xs@ returns the infinite repetition of @xs@: -- -- > cycle (1 :| [2,3]) = 1 :| [2,3,1,2,3,...] cycle :: NonEmpty a -> NonEmpty a cycle = fromList . List.cycle . toList {-# INLINE cycle #-} -- | 'reverse' a finite NonEmpty stream. reverse :: NonEmpty a -> NonEmpty a reverse = lift List.reverse {-# INLINE reverse #-} -- | @'repeat' x@ returns a constant stream, where all elements are -- equal to @x@. repeat :: a -> NonEmpty a repeat a = a :| List.repeat a {-# INLINE repeat #-} -- | @'take' n xs@ returns the first @n@ elements of @xs@. take :: Int -> NonEmpty a -> [a] take n = List.take n . toList {-# INLINE take #-} -- | @'drop' n xs@ drops the first @n@ elements off the front of -- the sequence @xs@. drop :: Int -> NonEmpty a -> [a] drop n = List.drop n . toList {-# INLINE drop #-} -- | @'splitAt' n xs@ returns a pair consisting of the prefix of @xs@ -- of length @n@ and the remaining stream immediately following this prefix. -- -- > 'splitAt' n xs == ('take' n xs, 'drop' n xs) -- > xs == ys ++ zs where (ys, zs) = 'splitAt' n xs splitAt :: Int -> NonEmpty a -> ([a],[a]) splitAt n = List.splitAt n . toList {-# INLINE splitAt #-} -- | @'takeWhile' p xs@ returns the longest prefix of the stream -- @xs@ for which the predicate @p@ holds. takeWhile :: (a -> Bool) -> NonEmpty a -> [a] takeWhile p = List.takeWhile p . toList {-# INLINE takeWhile #-} -- | @'dropWhile' p xs@ returns the suffix remaining after -- @'takeWhile' p xs@. dropWhile :: (a -> Bool) -> NonEmpty a -> [a] dropWhile p = List.dropWhile p . toList {-# INLINE dropWhile #-} -- | @'span' p xs@ returns the longest prefix of @xs@ that satisfies -- @p@, together with the remainder of the stream. -- -- > 'span' p xs == ('takeWhile' p xs, 'dropWhile' p xs) -- > xs == ys ++ zs where (ys, zs) = 'span' p xs span :: (a -> Bool) -> NonEmpty a -> ([a], [a]) span p = List.span p . toList {-# INLINE span #-} -- | The @'break' p@ function is equivalent to @'span' (not . p)@. break :: (a -> Bool) -> NonEmpty a -> ([a], [a]) break p = span (not . p) {-# INLINE break #-} -- | @'filter' p xs@ removes any elements from @xs@ that do not satisfy @p@. filter :: (a -> Bool) -> NonEmpty a -> [a] filter p = List.filter p . toList {-# INLINE filter #-} -- | The 'partition' function takes a predicate @p@ and a stream -- @xs@, and returns a pair of lists. The first list corresponds to the -- elements of @xs@ for which @p@ holds; the second corresponds to the -- elements of @xs@ for which @p@ does not hold. -- -- > 'partition' p xs = ('filter' p xs, 'filter' (not . p) xs) partition :: (a -> Bool) -> NonEmpty a -> ([a], [a]) partition p = List.partition p . toList {-# INLINE partition #-} -- | The 'group' function takes a stream and returns a list of -- streams such that flattening the resulting list is equal to the -- argument. Moreover, each stream in the resulting list -- contains only equal elements. For example, in list notation: -- -- > 'group' $ 'cycle' "Mississippi" = "M" : "i" : "ss" : "i" : "ss" : "i" : "pp" : "i" : "M" : "i" : ... group :: (Foldable f, Eq a) => f a -> [NonEmpty a] group = groupBy (==) {-# INLINE group #-} -- | 'groupBy' operates like 'group', but uses the provided equality -- predicate instead of `==`. groupBy :: Foldable f => (a -> a -> Bool) -> f a -> [NonEmpty a] groupBy eq0 = go eq0 . Foldable.toList where go _ [] = [] go eq (x : xs) = (x :| ys) : groupBy eq zs where (ys, zs) = List.span (eq x) xs -- | 'groupWith' operates like 'group', but uses the provided projection when -- comparing for equality groupWith :: (Foldable f, Eq b) => (a -> b) -> f a -> [NonEmpty a] groupWith f = groupBy ((==) `on` f) {-# INLINE groupWith #-} -- | 'groupAllWith' operates like 'groupWith', but sorts the list first so that each -- equivalence class has, at most, one list in the output groupAllWith :: (Ord b) => (a -> b) -> [a] -> [NonEmpty a] groupAllWith f = groupWith f . List.sortBy (compare `on` f) {-# INLINE groupAllWith #-} -- | 'group1' operates like 'group', but uses the knowledge that its -- input is non-empty to produce guaranteed non-empty output. group1 :: Eq a => NonEmpty a -> NonEmpty (NonEmpty a) group1 = groupBy1 (==) {-# INLINE group1 #-} -- | 'groupBy1' is to 'group1' as 'groupBy' is to 'group'. groupBy1 :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a) groupBy1 eq (x :| xs) = (x :| ys) :| groupBy eq zs where (ys, zs) = List.span (eq x) xs {-# INLINE groupBy1 #-} -- | 'groupWith1' is to 'group1' as 'groupWith' is to 'group' groupWith1 :: (Eq b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a) groupWith1 f = groupBy1 ((==) `on` f) {-# INLINE groupWith1 #-} -- | 'groupAllWith1' is to 'groupWith1' as 'groupAllWith' is to 'groupWith' groupAllWith1 :: (Ord b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a) groupAllWith1 f = groupWith1 f . sortWith f {-# INLINE groupAllWith1 #-} -- | The 'isPrefix' function returns @True@ if the first argument is -- a prefix of the second. isPrefixOf :: Eq a => [a] -> NonEmpty a -> Bool isPrefixOf [] _ = True isPrefixOf (y:ys) (x :| xs) = (y == x) && List.isPrefixOf ys xs {-# INLINE isPrefixOf #-} -- | @xs !! n@ returns the element of the stream @xs@ at index -- @n@. Note that the head of the stream has index 0. -- -- /Beware/: a negative or out-of-bounds index will cause an error. (!!) :: NonEmpty a -> Int -> a (!!) ~(x :| xs) n | n == 0 = x | n > 0 = xs List.!! (n - 1) | otherwise = error "NonEmpty.!! negative argument" {-# INLINE (!!) #-} infixl 9 !! -- | The 'zip' function takes two streams and returns a stream of -- corresponding pairs. zip :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b) zip ~(x :| xs) ~(y :| ys) = (x, y) :| List.zip xs ys {-# INLINE zip #-} -- | The 'zipWith' function generalizes 'zip'. Rather than tupling -- the elements, the elements are combined using the function -- passed as the first argument. zipWith :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys {-# INLINE zipWith #-} -- | The 'unzip' function is the inverse of the 'zip' function. unzip :: Functor f => f (a,b) -> (f a, f b) unzip xs = (fst <$> xs, snd <$> xs) {-# INLINE unzip #-} -- | The 'nub' function removes duplicate elements from a list. In -- particular, it keeps only the first occurrence of each element. -- (The name 'nub' means \'essence\'.) -- It is a special case of 'nubBy', which allows the programmer to -- supply their own inequality test. nub :: Eq a => NonEmpty a -> NonEmpty a nub = nubBy (==) -- | The 'nubBy' function behaves just like 'nub', except it uses a -- user-supplied equality predicate instead of the overloaded '==' -- function. nubBy :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a nubBy eq (a :| as) = a :| List.nubBy eq (List.filter (\b -> not (eq a b)) as) -- | 'transpose' for 'NonEmpty', behaves the same as 'Data.List.transpose' -- The rows/columns need not be the same length, in which case -- > transpose . transpose /= id transpose :: NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a) transpose = fmap fromList . fromList . List.transpose . toList . fmap toList -- | 'sortBy' for 'NonEmpty', behaves the same as 'Data.List.sortBy' sortBy :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a sortBy f = lift (List.sortBy f) -- | 'sortWith' for 'NonEmpty', behaves the same as: -- -- > sortBy . comparing sortWith :: Ord o => (a -> o) -> NonEmpty a -> NonEmpty a sortWith = sortBy . comparing