semigroups-0.18.0.1/0000755000000000000000000000000012617717606012337 5ustar0000000000000000semigroups-0.18.0.1/.travis.yml0000644000000000000000000000752612617717606014462 0ustar0000000000000000# This file has been generated -- see https://github.com/hvr/multi-ghc-travis language: c sudo: false 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/.cabsnap - $HOME/.cabal/packages before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar matrix: include: - env: CABALVER=1.16 GHCVER=7.0.4 compiler: ": #GHC 7.0.4" addons: {apt: {packages: [cabal-install-1.16,ghc-7.0.4], sources: [hvr-ghc]}} - env: CABALVER=1.16 GHCVER=7.4.2 compiler: ": #GHC 7.4.2" addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2], sources: [hvr-ghc]}} - env: CABALVER=1.16 GHCVER=7.6.3 compiler: ": #GHC 7.6.3" addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}} - env: CABALVER=1.18 GHCVER=7.8.4 compiler: ": #GHC 7.8.4" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - env: CABALVER=1.22 GHCVER=7.10.2 compiler: ": #GHC 7.10.2" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} - env: CABALVER=head GHCVER=head compiler: ": #GHC head" addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} allow_failures: - env: CABALVER=head GHCVER=head before_install: - unset CC - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH install: - cabal --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; then zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; fi - travis_retry cabal update -v - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt # check whether current requested install-plan matches cached package-db snapshot - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; then echo "cabal build-cache HIT"; rm -rfv .ghc; cp -a $HOME/.cabsnap/ghc $HOME/.ghc; cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; else echo "cabal build-cache MISS"; rm -rf $HOME/.cabsnap; mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; cabal install --only-dependencies --enable-tests --enable-benchmarks; fi # snapshot package-db on cache miss - if [ ! -d $HOME/.cabsnap ]; then echo "snapshotting package-db to build-cache"; mkdir $HOME/.cabsnap; cp -a $HOME/.ghc $HOME/.cabsnap/ghc; cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; fi # 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: - if [ -f configure.ac ]; then autoreconf -i; fi - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging - cabal build # this builds all libraries and executables (including tests/benchmarks) - cabal test - cabal check - cabal sdist # tests that a source-distribution can be generated # Check that the resulting source distribution can be built & installed. # If there are no other `.tar.gz` files in `dist`, this can be even simpler: # `cabal install --force-reinstalls dist/*-*.tar.gz` - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && (cd dist && cabal install --force-reinstalls "$SRC_TGZ") # EOF semigroups-0.18.0.1/CHANGELOG.markdown0000644000000000000000000000643212617717606015377 0ustar00000000000000000.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 embarassing 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.0.1/LICENSE0000644000000000000000000000236412617717606013351 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.0.1/README.markdown0000644000000000000000000000225612617717606015045 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. Semigroups appear all over the place, except in the Haskell Prelude, so they are packaged here. 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.0.1/semigroups.cabal0000644000000000000000000001022412617717606015517 0ustar0000000000000000name: semigroups category: Algebra, Data, Data Structures, Math version: 0.18.0.1 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 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 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 containers description: You can disable the use of the `containers` package using `-f-containers`. . Disabing 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`. . Disabing 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 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.4) 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.4 && < 7.5) build-depends: ghc-prim if flag(bytestring) build-depends: bytestring >= 0.9 && < 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 semigroups-0.18.0.1/Setup.lhs0000644000000000000000000000016512617717606014151 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain semigroups-0.18.0.1/src/0000755000000000000000000000000012617717606013126 5ustar0000000000000000semigroups-0.18.0.1/src/Data/0000755000000000000000000000000012617717606013777 5ustar0000000000000000semigroups-0.18.0.1/src/Data/Semigroup/0000755000000000000000000000000012617717606015751 5ustar0000000000000000semigroups-0.18.0.1/src/Data/Semigroup/Generic.hs0000644000000000000000000000444512617717606017670 0ustar0000000000000000{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- 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 import Data.Semigroup 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.0.1/src-ghc7/0000755000000000000000000000000012617717606013754 5ustar0000000000000000semigroups-0.18.0.1/src-ghc7/Data/0000755000000000000000000000000012617717606014625 5ustar0000000000000000semigroups-0.18.0.1/src-ghc7/Data/Semigroup.hs0000644000000000000000000006212712617717606017143 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__ >= 708 {-# LANGUAGE Trustworthy #-} #else {-# LANGUAGE Safe #-} #endif #endif #if __GLASGOW_HASKELL__ >= 704 #define LANGUAGE_DeriveGeneric {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} #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 Data.Monoid as Monoid import Data.List.NonEmpty #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_bytestring import Data.ByteString as Strict import Data.ByteString.Lazy as Lazy # if MIN_VERSION_bytestring(0,10,2) 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) import Data.ByteString.Short # endif #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) (pred y `quot` 2) x g x y z | even y = g (x <> x) (y `quot` 2) z | y == 1 = x <> z | otherwise = g (x <> x) (pred y `quot` 2) (x <> z) {-# INLINE stimes #-} -- | 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) -- | 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) (pred y `quot` 2) x g x y z | even y = g (x `mappend` x) (y `quot` 2) z | y == 1 = x `mappend` z | otherwise = g (x `mappend` x) (pred y `quot` 2) (x `mappend` z) -- | 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 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 -- | '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 -- | 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 -- | 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 -- (==)/XNOR on Bool forms a 'Semigroup', but has no good name #ifdef MIN_VERSION_bytestring instance Semigroup Strict.ByteString where (<>) = mappend instance Semigroup Lazy.ByteString where (<>) = mappend # if MIN_VERSION_bytestring(0,10,0) instance Semigroup ByteString.Builder where (<>) = mappend # endif # if MIN_VERSION_bytestring(0,10,4) 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 -- | 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 = (<>) -- | 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,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 #endif stimes n (Tagged a) = Tagged (stimes n a) semigroups-0.18.0.1/src-ghc7/Data/List/0000755000000000000000000000000012617717606015540 5ustar0000000000000000semigroups-0.18.0.1/src-ghc7/Data/List/NonEmpty.hs0000644000000000000000000005027312617717606017654 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 #if defined(MIN_VERSION_hashable) || __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__ >= 704 #define LANGUAGE_DeriveGeneric {-# LANGUAGE DeriveGeneric #-} #endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE TypeFamilies #-} #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 #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 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 #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 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 -- | 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 (!!) #-} -- | 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 occurence 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 . Foldable.toList . fmap Foldable.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