semigroups 0.18.4 → 0.20.1
raw patch · 7 files changed
Files
- .travis.yml +0/−146
- CHANGELOG.markdown +43/−0
- README.markdown +2/−2
- semigroups.cabal +21/−148
- src-ghc7/Data/List/NonEmpty.hs +0/−682
- src-ghc7/Data/Semigroup.hs +0/−1254
- src/Data/Semigroup/Generic.hs +38/−10
− .travis.yml
@@ -1,146 +0,0 @@-# This Travis job script has been generated by a script via-#-# runghc make_travis_yml_2.hs '-o' '.travis.yml' '--irc-channel=irc.freenode.org#haskell-lens' '--no-no-tests-no-bench' '--no-installed' '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-7.0.4"- # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.0.4], sources: [hvr-ghc]}}- - compiler: "ghc-7.2.2"- # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.2.2], sources: [hvr-ghc]}}- - compiler: "ghc-7.4.2"- # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.4.2], sources: [hvr-ghc]}}- - compiler: "ghc-7.6.3"- # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.6.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.0,ghc-7.8.4], sources: [hvr-ghc]}}- - compiler: "ghc-7.10.3"- # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.10.3], sources: [hvr-ghc]}}- - compiler: "ghc-8.0.2"- # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-8.0.2], sources: [hvr-ghc]}}- - compiler: "ghc-8.2.2"- # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}- - compiler: "ghc-8.4.1"- env: GHCHEAD=true- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], 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-7.0.4"- - compiler: "ghc-7.2.2"- - compiler: "ghc-8.4.1"- - compiler: "ghc-head"--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}- - INSTALLED=${INSTALLED-true}- - 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.bak 's/-- allow-newer:.*/allow-newer: *:base, *:template-haskell, *:ghc, *:Cabal/' ${HOME}/.cabal/config-- 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-- cabal new-update head.hackage -v- fi- - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'- - "printf 'packages: \".\"\\n' > cabal.project"- - cat cabal.project- - 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"- - cat cabal.project--- # 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","--irc-channel=irc.freenode.org#haskell-lens","--no-no-tests-no-bench","--no-installed","cabal.project"]-# EOF
CHANGELOG.markdown view
@@ -1,3 +1,46 @@+0.20.1 [2026.01.10]+-------------------+* Drop support for pre-8.0 versions of GHC.++0.20 [2021.11.15]+-----------------+* Support `hashable-1.4`. The `Hashable1` instances added in 0.19.2+ are removed for all types except `NonEmpty`, in accordance with the+ corresponding changes from `hashable-1.4`.++0.19.2 [2021.08.30]+-------------------+* Backport `Hashable1` instances for `NonEmpty`, `Min`, `Max`, `First`, `Last`,+ `WrappedMonoid`, and `Option`.++0.19.1 [2019.08.27]+-------------------+* Add `GenericSemigroupMonoid`, an adapter newtype suitable for `DerivingVia`,+ to `Data.Semigroup.Generic`.+* Work around a bug related to the backported `Generic(1)` instances in this+ package (that could only be triggered on GHC 7.2 or 7.4) in which the+ hand-written `Datatype`, `Constructor`, and `Selector` instances for internal+ data types could overlap with GHC-generated instances.++0.19 [2019.05.10]+-----------------+* The `(<>)` method of the backported `Semigroup` class no longer has a default+ implementation in terms of `mappend`. This mirrors the `Data.Semigroup` API+ that was introduced in `base-4.9`. This is a breaking change for any+ `Semigroup` instances that are defined in tandem with versions of `base`+ older than 4.9.+* Make the backported `Hashable Arg` instance reflect its respective variants+ in the `hashable` package. In `hashable-1.3`, the `Hashable Arg` instance+ only hashes the first argument, lest equal values have different hashes.+* Backport the `Lift (NonEmpty a)` instance introduced in+ `template-haskell-2.15.0.0`.+* `Data.List.NonEmpty` is now unconditionally `Trustworthy`.++0.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
README.markdown view
@@ -1,13 +1,13 @@ semigroups ========== -[](https://hackage.haskell.org/package/semigroups) [](http://travis-ci.org/ekmett/semigroups)+[](https://hackage.haskell.org/package/semigroups) [](https://github.com/ekmett/semigroups/actions?query=workflow%3AHaskell-CI) 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.+`Data.Semigroup` and `Data.List.NonEmpty` were added to `base` as of 4.9.0.0. This package now offers some tools for deriving semigroups with generics. Contact Information -------------------
semigroups.cabal view
@@ -1,6 +1,6 @@ name: semigroups category: Algebra, Data, Data Structures, Math-version: 0.18.4+version: 0.20.1 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE@@ -14,159 +14,32 @@ 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.1+extra-source-files: README.markdown CHANGELOG.markdown+tested-with:+ GHC == 9.14.1+ GHC == 9.12.2+ GHC == 9.10.3+ GHC == 9.8.4+ GHC == 9.6.7+ GHC == 9.4.8+ GHC == 9.2.8+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ GHC == 8.2.2+ GHC == 8.0.2 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+ location: https://github.com/ekmett/semigroups.git 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.6-- 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+ build-depends: base >= 4.9 && < 5+ exposed-modules:+ Data.Semigroup.Generic
− src-ghc7/Data/List/NonEmpty.hs
@@ -1,682 +0,0 @@-{-# 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 <ekmett@gmail.com>--- 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
− src-ghc7/Data/Semigroup.hs
@@ -1,1254 +0,0 @@-{-# 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 <ekmett@gmail.com>--- 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 Strict-import Data.ByteString.Lazy as Lazy--# 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 Strict-import qualified Data.Text.Lazy as Lazy-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 Strict.ByteString where- (<>) = mappend--instance Semigroup Lazy.ByteString where- (<>) = mappend--# 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 Strict.Text where- (<>) = mappend--instance Semigroup Lazy.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
src/Data/Semigroup/Generic.hs view
@@ -1,11 +1,8 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-}-#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-}-#else-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Semigroup.Generic@@ -21,13 +18,19 @@ -- ---------------------------------------------------------------------------- module Data.Semigroup.Generic- ( GSemigroup- , gmappend- , GMonoid- , gmempty+ ( -- * Generic method implementations+ gmappend, gmempty++ -- * Adapter newtype+ , GenericSemigroupMonoid(..)++ -- * Internal classes+ , GSemigroup, GMonoid ) where -import Data.Semigroup+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup(..))+#endif import GHC.Generics -- | Generically generate a 'Semigroup' ('<>') operation for any type@@ -85,3 +88,28 @@ instance (GMonoid f, GMonoid g) => GMonoid (f :*: g) where gmempty' = gmempty' :*: gmempty'++-- | An adapter newtype, suitable for @DerivingVia@. Its 'Semigroup' and+-- 'Monoid' instances leverage the 'Generic'-based defaults defined by+-- 'gmappend' and 'gmempty'. Here is an example of how to use it:+--+-- @+-- {-# LANGUAGE DerivingVia #-}+-- import "Data.Semigroup.Generic"+--+-- data Pair a = MkPair a a+-- deriving ('Semigroup', 'Monoid') via ('GenericSemigroupMonoid' (Pair a))+-- @+--+-- @since 0.19.1+newtype GenericSemigroupMonoid a =+ GenericSemigroupMonoid { getGenericSemigroupMonoid :: a }++instance (Generic a, GSemigroup (Rep a)) => Semigroup (GenericSemigroupMonoid a) where+ GenericSemigroupMonoid x <> GenericSemigroupMonoid y =+ GenericSemigroupMonoid (gmappend x y)+instance (Generic a, GMonoid (Rep a)) => Monoid (GenericSemigroupMonoid a) where+ mempty = GenericSemigroupMonoid gmempty+#if !(MIN_VERSION_base(4,11,0))+ mappend = (<>)+#endif