summaryrefslogtreecommitdiff
path: root/libraries
diff options
context:
space:
mode:
authorHerbert Valerio Riedel <hvr@gnu.org>2015-09-27 12:01:41 +0200
committerHerbert Valerio Riedel <hvr@gnu.org>2015-10-02 08:24:43 +0200
commit03b380428c128b12aef07a9b67341803ef0bea76 (patch)
treedc6b692bf37369969b06f3ec0ce6c6a8bd8d8870 /libraries
parente3ab25a4d2e159d7c83de7e94252cace2e76d2a1 (diff)
downloadhaskell-03b380428c128b12aef07a9b67341803ef0bea76.tar.gz
Add Data.Semigroup and Data.List.NonEmpty (re #10365)
This implements phase 1 of the semigroup-as-monoid-superclass proposal (https://ghc.haskell.org/wiki/Proposal/SemigroupMonoid). The modules were migrated from the `semigroups-0.17` release mostly as-is, except for dropping several trivial `{-# INLINE #-}`s, removing CPP usage, and instances for types & classes provided outside of `base` (e.g. `containers`, `deepseq`, `hashable`, `tagged`, `bytestring`, `text`) Differential Revision: https://phabricator.haskell.org/D1284
Diffstat (limited to 'libraries')
-rw-r--r--libraries/base/Data/List/NonEmpty.hs522
-rw-r--r--libraries/base/Data/Semigroup.hs640
-rw-r--r--libraries/base/base.cabal2
-rw-r--r--libraries/base/changelog.md4
4 files changed, 1168 insertions, 0 deletions
diff --git a/libraries/base/Data/List/NonEmpty.hs b/libraries/base/Data/List/NonEmpty.hs
new file mode 100644
index 0000000000..6698a0ba58
--- /dev/null
+++ b/libraries/base/Data/List/NonEmpty.hs
@@ -0,0 +1,522 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE Trustworthy #-} -- can't use Safe due to IsList instance
+{-# LANGUAGE TypeFamilies #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- 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 : libraries@haskell.org
+-- Stability : provisional
+-- Portability : portable
+--
+-- A 'NonEmpty' list is one which always has at least one element, but
+-- is otherwise identical to the traditional list type in complexity
+-- and in terms of API. You will almost certainly want to import this
+-- module @qualified@.
+--
+-- @since 4.8.2.0
+----------------------------------------------------------------------------
+
+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)
+ -- * Functions on streams of characters
+ , words -- :: NonEmpty Char -> NonEmpty String
+ , unwords -- :: NonEmpty String -> NonEmpty Char
+ , lines -- :: NonEmpty Char -> NonEmpty String
+ , unlines -- :: NonEmpty String -> NonEmpty Char
+ -- * 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 Prelude hiding (break, cycle, drop, dropWhile,
+ filter, foldl, foldr, head, init, iterate,
+ last, length, lines, map, repeat, reverse,
+ scanl, scanl1, scanr, scanr1, span,
+ splitAt, tail, take, takeWhile, unlines,
+ unwords, unzip, words, zip, zipWith, (!!))
+import qualified Prelude
+
+import Control.Applicative (Alternative, many)
+import Control.Monad (ap)
+import Control.Monad.Fix
+import Control.Monad.Zip (MonadZip(..))
+import Data.Data (Data)
+import Data.Foldable hiding (length, toList)
+import qualified Data.Foldable as Foldable
+import Data.Function (on)
+import qualified Data.List as List
+import Data.Ord (comparing)
+import qualified GHC.Exts as Exts (IsList(..))
+import GHC.Generics (Generic, Generic1)
+
+infixr 5 :|, <|
+
+-- | Non-empty (and non-strict) list type.
+--
+-- @since 4.8.2.0
+data NonEmpty a = a :| [a]
+ deriving ( Eq, Ord, Show, Read, Data, Generic, Generic1 )
+
+instance Exts.IsList (NonEmpty a) where
+ type Item (NonEmpty a) = a
+ fromList = fromList
+ toList = toList
+
+instance MonadFix NonEmpty where
+ mfix f = case fix (f . head) of
+ ~(x :| _) -> x :| mfix (tail . f)
+
+instance MonadZip NonEmpty where
+ mzip = zip
+ mzipWith = zipWith
+ munzip = unzip
+
+-- | Number of elements in 'NonEmpty' list.
+length :: NonEmpty a -> Int
+length (_ :| xs) = 1 + Prelude.length xs
+
+-- | Compute n-ary logic exclusive OR operation on 'NonEmpty' list.
+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)
+
+-- | '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)
+
+-- | The 'unfoldr' function is analogous to "Data.List"'s
+-- 'Data.List.unfoldr' operation.
+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
+ b <$ ~(_ :| as) = b :| (b <$ as)
+
+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
+
+-- | Extract the possibly-empty tail of the stream.
+tail :: NonEmpty a -> [a]
+tail ~(_ :| as) = as
+
+-- | Extract the last element of the stream.
+last :: NonEmpty a -> a
+last ~(a :| as) = List.last (a : as)
+
+-- | Extract everything except the last element of the stream.
+init :: NonEmpty a -> [a]
+init ~(a :| as) = List.init (a : as)
+
+-- | Prepend an element to the stream.
+(<|) :: a -> NonEmpty a -> NonEmpty a
+a <| ~(b :| bs) = a :| b : bs
+
+-- | Synonym for '<|'.
+cons :: a -> NonEmpty a -> NonEmpty a
+cons = (<|)
+
+-- | Sort a stream.
+sort :: Ord a => NonEmpty a -> NonEmpty a
+sort = lift List.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"
+
+-- | Convert a stream to a normal list efficiently.
+toList :: NonEmpty a -> [a]
+toList ~(a :| as) = a : as
+
+-- | 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
+
+-- | Map a function over a 'NonEmpty' stream.
+map :: (a -> b) -> NonEmpty a -> NonEmpty b
+map f ~(a :| as) = f a :| fmap f as
+
+-- | 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
+
+-- | 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
+
+-- | @'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
+
+-- | @'some1' x@ sequences @x@ one or more times.
+some1 :: Alternative f => f a -> f (NonEmpty a)
+some1 x = (:|) <$> x <*> many x
+
+-- | '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
+
+-- | '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
+
+-- | '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)
+
+-- | '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))
+
+-- | '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
+
+-- | @'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)
+
+-- | @'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
+
+-- | 'reverse' a finite NonEmpty stream.
+reverse :: NonEmpty a -> NonEmpty a
+reverse = lift List.reverse
+
+-- | @'repeat' x@ returns a constant stream, where all elements are
+-- equal to @x@.
+repeat :: a -> NonEmpty a
+repeat a = a :| List.repeat a
+
+-- | @'take' n xs@ returns the first @n@ elements of @xs@.
+take :: Int -> NonEmpty a -> [a]
+take n = List.take n . toList
+
+-- | @'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
+
+-- | @'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
+
+-- | @'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
+
+-- | @'dropWhile' p xs@ returns the suffix remaining after
+-- @'takeWhile' p xs@.
+dropWhile :: (a -> Bool) -> NonEmpty a -> [a]
+dropWhile p = List.dropWhile p . toList
+
+-- | @'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
+
+-- | The @'break' p@ function is equivalent to @'span' (not . p)@.
+break :: (a -> Bool) -> NonEmpty a -> ([a], [a])
+break p = span (not . p)
+
+-- | @'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
+
+-- | 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
+
+-- | 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 (==)
+
+-- | '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)
+
+-- | '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)
+
+-- | '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 (==)
+
+-- | '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
+
+-- | 'groupWith1' is to 'group1' as 'groupWith' is to 'group'
+groupWith1 :: (Eq b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a)
+groupWith1 f = groupBy1 ((==) `on` f)
+
+-- | '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
+
+-- | 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
+
+-- | @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"
+
+-- | 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
+
+-- | 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
+
+-- | 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)
+
+-- | The 'words' function breaks a stream of characters into a
+-- stream of words, which were delimited by white space.
+--
+-- /Beware/: if the input contains no words (i.e. is entirely
+-- whitespace), this will cause an error.
+words :: NonEmpty Char -> NonEmpty String
+words = lift List.words
+
+-- | The 'unwords' function is an inverse operation to 'words'. It
+-- joins words with separating spaces.
+--
+-- /Beware/: the input @(\"\" :| [])@ will cause an error.
+unwords :: NonEmpty String -> NonEmpty Char
+unwords = lift List.unwords
+
+-- | The 'lines' function breaks a stream of characters into a stream
+-- of strings at newline characters. The resulting strings do not
+-- contain newlines.
+lines :: NonEmpty Char -> NonEmpty String
+lines = lift List.lines
+
+-- | The 'unlines' function is an inverse operation to 'lines'. It
+-- joins lines, after appending a terminating newline to each.
+unlines :: NonEmpty String -> NonEmpty Char
+unlines = lift List.unlines
+
+-- | 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
diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs
new file mode 100644
index 0000000000..661e513cba
--- /dev/null
+++ b/libraries/base/Data/Semigroup.hs
@@ -0,0 +1,640 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeOperators #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Semigroup
+-- Copyright : (C) 2011-2015 Edward Kmett
+-- License : BSD-style (see the file LICENSE)
+--
+-- Maintainer : libraries@haskell.org
+-- 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
+--
+-- @since 4.8.2.0
+----------------------------------------------------------------------------
+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)
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Fix
+import Data.Bifunctor
+import Data.Coerce
+import Data.Data
+import Data.List.NonEmpty
+import Data.Monoid (All (..), Any (..), Dual (..), Endo (..),
+ Product (..), Sum (..))
+import Data.Monoid (Alt (..))
+import qualified Data.Monoid as Monoid
+import Data.Proxy
+import Data.Void
+import GHC.Generics
+
+infixr 6 <>
+
+-- | The class of semigroups (types with an associative binary operation).
+--
+-- @since 4.8.2.0
+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
+
+ default (<>) :: Monoid a => a -> a -> a
+ (<>) = mappend
+
+ -- | 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.
+ 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)
+
+-- | 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
+ (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> (a -> a))
+ stimes = stimesMonoid
+
+instance Semigroup All where
+ (<>) = coerce (&&)
+ stimes = stimesIdempotentMonoid
+
+instance Semigroup Any where
+ (<>) = coerce (||)
+ stimes = stimesIdempotentMonoid
+
+
+instance Num a => Semigroup (Sum a) where
+ (<>) = coerce ((+) :: a -> a -> a)
+ stimes n (Sum a) = Sum (fromIntegral n * a)
+
+instance Num a => Semigroup (Product a) where
+ (<>) = coerce ((*) :: a -> a -> a)
+ 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
+
+-- | 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
+
+instance Semigroup a => Semigroup (Const a b) where
+ (<>) = coerce ((<>) :: a -> a -> a)
+ stimes n (Const a) = Const (stimes n a)
+
+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
+
+instance Alternative f => Semigroup (Alt f a) where
+ (<>) = coerce ((<|>) :: f a -> f a -> f a)
+ stimes = stimesMonoid
+
+instance Semigroup Void where
+ a <> _ = a
+ stimes = stimesIdempotent
+
+instance Semigroup (NonEmpty a) where
+ (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs)
+
+
+newtype Min a = Min { getMin :: a }
+ deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1)
+
+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
+
+
+instance Ord a => Semigroup (Min a) where
+ (<>) = coerce (min :: a -> a -> a)
+ 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)
+
+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, Data, Typeable, Generic, Generic1)
+
+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
+
+instance Ord a => Semigroup (Max a) where
+ (<>) = coerce (max :: a -> a -> a)
+ 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)
+
+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, Data, Typeable, Generic, Generic1)
+
+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
+
+instance Bifunctor Arg where
+ bimap f g (Arg a b) = Arg (f a) (g b)
+
+-- | 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, Data, Typeable, Generic, Generic1)
+
+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
+
+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)
+
+-- | 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, Data, Typeable, Generic, Generic1)
+
+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
+
+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)
+
+-- | Provide a Semigroup for an arbitrary Monoid.
+newtype WrappedMonoid m = WrapMonoid { unwrapMonoid :: m }
+ deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1)
+
+instance Monoid m => Semigroup (WrappedMonoid m) where
+ (<>) = coerce (mappend :: m -> m -> m)
+
+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
+
+-- | 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'.
+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, Data, Typeable, Generic, Generic1)
+
+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)
+
+-- | 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
+ (<>) = coerce ((<>) :: Maybe a -> Maybe a -> Maybe a)
+
+ 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 . (<>)
+
+instance Semigroup (Proxy s) where
+ _ <> _ = Proxy
+ sconcat _ = Proxy
+ stimes _ _ = Proxy
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index 33734a00c7..662f2747d7 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -142,11 +142,13 @@ Library
Data.Int
Data.Ix
Data.List
+ Data.List.NonEmpty
Data.Maybe
Data.Monoid
Data.Ord
Data.Proxy
Data.Ratio
+ Data.Semigroup
Data.STRef
Data.STRef.Lazy
Data.STRef.Strict
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 51a1de9d58..b40bfefe91 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -58,6 +58,10 @@
* The `Generic` instance for `Proxy` is now poly-kinded (#10775)
+ * add `Data.List.NonEmpty` and `Data.Semigroup` (to become
+ super-class of `Monoid` in the future). These modules were
+ provided by the `semigroups` package previously. (#10365)
+
## 4.8.1.0 *Jul 2015*
* Bundled with GHC 7.10.2