1{-# LANGUAGE CPP #-} 2 3#ifdef __GLASGOW_HASKELL__ 4#define LANGUAGE_DeriveDataTypeable 5{-# LANGUAGE DeriveDataTypeable #-} 6#endif 7 8#if __GLASGOW_HASKELL__ >= 702 9{-# LANGUAGE Trustworthy #-} 10#endif 11 12#if __GLASGOW_HASKELL__ >= 702 13#define LANGUAGE_DeriveGeneric 14{-# LANGUAGE DeriveGeneric #-} 15{-# LANGUAGE EmptyDataDecls #-} 16{-# LANGUAGE FlexibleContexts #-} 17{-# LANGUAGE TypeFamilies #-} 18{-# LANGUAGE TypeOperators #-} 19#endif 20 21#if __GLASGOW_HASKELL__ >= 706 22{-# LANGUAGE PolyKinds #-} 23#endif 24 25#if __GLASGOW_HASKELL__ >= 708 26#define USE_COERCE 27{-# LANGUAGE ScopedTypeVariables #-} 28#endif 29 30#ifndef MIN_VERSION_base 31#define MIN_VERSION_base(x,y,z) 1 32#endif 33 34----------------------------------------------------------------------------- 35-- | 36-- Module : Data.Semigroup 37-- Copyright : (C) 2011-2015 Edward Kmett 38-- License : BSD-style (see the file LICENSE) 39-- 40-- Maintainer : Edward Kmett <ekmett@gmail.com> 41-- Stability : provisional 42-- Portability : portable 43-- 44-- In mathematics, a semigroup is an algebraic structure consisting of a 45-- set together with an associative binary operation. A semigroup 46-- generalizes a monoid in that there might not exist an identity 47-- element. It also (originally) generalized a group (a monoid with all 48-- inverses) to a type where every element did not have to have an inverse, 49-- thus the name semigroup. 50-- 51-- The use of @(\<\>)@ in this module conflicts with an operator with the same 52-- name that is being exported by Data.Monoid. However, this package 53-- re-exports (most of) the contents of Data.Monoid, so to use semigroups 54-- and monoids in the same package just 55-- 56-- > import Data.Semigroup 57-- 58---------------------------------------------------------------------------- 59module Data.Semigroup ( 60 Semigroup(..) 61 , stimesMonoid 62 , stimesIdempotent 63 , stimesIdempotentMonoid 64 , mtimesDefault 65 -- * Semigroups 66 , Min(..) 67 , Max(..) 68 , First(..) 69 , Last(..) 70 , WrappedMonoid(..) 71 -- * Re-exported monoids from Data.Monoid 72 , Monoid(..) 73 , Dual(..) 74 , Endo(..) 75 , All(..) 76 , Any(..) 77 , Sum(..) 78 , Product(..) 79 -- * A better monoid for Maybe 80 , Option(..) 81 , option 82 -- * Difference lists of a semigroup 83 , diff 84 , cycle1 85 -- * ArgMin, ArgMax 86 , Arg(..) 87 , ArgMin 88 , ArgMax 89 ) where 90 91import Prelude hiding (foldr1) 92 93#if MIN_VERSION_base(4,8,0) 94import Data.Bifunctor 95import Data.Void 96#else 97import Data.Monoid (Monoid(..)) 98import Data.Foldable 99import Data.Traversable 100#endif 101 102import Data.Monoid (Dual(..),Endo(..),All(..),Any(..),Sum(..),Product(..)) 103#if MIN_VERSION_base(4,8,0) 104import Data.Monoid (Alt(..)) 105#endif 106 107import Control.Applicative 108import Control.Monad 109import Control.Monad.Fix 110import qualified Control.Monad.ST as Strict 111import qualified Data.Monoid as Monoid 112import Data.List.NonEmpty 113#if MIN_VERSION_base(4,6,0) 114import Data.Ord (Down(..)) 115#else 116import GHC.Exts (Down(..)) 117#endif 118#if MIN_VERSION_base(4,4,0) && !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) && !defined(ETA_VERSION) 119import GHC.Event 120#endif 121 122#ifdef MIN_VERSION_deepseq 123import Control.DeepSeq (NFData(..)) 124#endif 125 126#ifdef MIN_VERSION_containers 127import Data.Sequence (Seq, (><)) 128import Data.Set (Set) 129import Data.IntSet (IntSet) 130import Data.Map (Map) 131import Data.IntMap (IntMap) 132#endif 133 134#ifdef MIN_VERSION_binary 135# if !(MIN_VERSION_binary(0,8,3)) 136import qualified Data.Binary.Builder as Builder 137# endif 138#endif 139 140#ifdef MIN_VERSION_bytestring 141import Data.ByteString as BS 142import Data.ByteString.Lazy as BL 143 144# if (MIN_VERSION_bytestring(0,10,2)) || defined(MIN_VERSION_bytestring_builder) 145import qualified Data.ByteString.Builder as ByteString 146# elif MIN_VERSION_bytestring(0,10,0) 147import qualified Data.ByteString.Lazy.Builder as ByteString 148# endif 149 150# if (MIN_VERSION_bytestring(0,10,4)) || defined(MIN_VERSION_bytestring_builder) 151import Data.ByteString.Short 152# endif 153#endif 154 155#if (MIN_VERSION_base(4,8,0)) || defined(MIN_VERSION_transformers) 156import Data.Functor.Identity 157#endif 158 159#if (MIN_VERSION_base(4,7,0)) || defined(MIN_VERSION_tagged) 160import Data.Proxy 161#endif 162 163#ifdef MIN_VERSION_tagged 164import Data.Tagged 165#endif 166 167#ifdef MIN_VERSION_text 168import qualified Data.Text as TS 169import qualified Data.Text.Lazy as TL 170import qualified Data.Text.Lazy.Builder as Text 171#endif 172 173#ifdef MIN_VERSION_hashable 174import Data.Hashable 175#endif 176 177#ifdef MIN_VERSION_unordered_containers 178import Data.HashMap.Lazy as Lazy 179import Data.HashSet 180#endif 181 182#ifdef LANGUAGE_DeriveDataTypeable 183import Data.Data 184#endif 185 186#ifdef LANGUAGE_DeriveGeneric 187import GHC.Generics 188#endif 189 190#ifdef USE_COERCE 191import Data.Coerce 192#endif 193 194infixr 6 <> 195 196class Semigroup a where 197 -- | An associative operation. 198 -- 199 -- @ 200 -- (a '<>' b) '<>' c = a '<>' (b '<>' c) 201 -- @ 202 -- 203 -- If @a@ is also a 'Monoid' we further require 204 -- 205 -- @ 206 -- ('<>') = 'mappend' 207 -- @ 208 (<>) :: a -> a -> a 209 210 -- | Reduce a non-empty list with @\<\>@ 211 -- 212 -- The default definition should be sufficient, but this can be overridden for efficiency. 213 -- 214 sconcat :: NonEmpty a -> a 215 sconcat (a :| as) = go a as where 216 go b (c:cs) = b <> go c cs 217 go b [] = b 218 219 -- | Repeat a value @n@ times. 220 -- 221 -- Given that this works on a 'Semigroup' it is allowed to fail if you request 0 or fewer 222 -- repetitions, and the default definition will do so. 223 -- 224 -- By making this a member of the class, idempotent semigroups and monoids can upgrade this to execute in 225 -- /O(1)/ by picking @stimes = stimesIdempotent@ or @stimes = stimesIdempotentMonoid@ respectively. 226 -- 227 -- @since 0.17 228 stimes :: Integral b => b -> a -> a 229 stimes y0 x0 230 | y0 <= 0 = error "stimes: positive multiplier expected" 231 | otherwise = f x0 y0 232 where 233 f x y 234 | even y = f (x <> x) (y `quot` 2) 235 | y == 1 = x 236 | otherwise = g (x <> x) (y `quot` 2) x -- See Note [Half of y - 1] 237 g x y z 238 | even y = g (x <> x) (y `quot` 2) z 239 | y == 1 = x <> z 240 | otherwise = g (x <> x) (y `quot` 2) (x <> z) -- See Note [Half of y - 1] 241 {-# INLINE stimes #-} 242 243{- Note [Half of y - 1] 244 ~~~~~~~~~~~~~~~~~~~~~ 245 Since y is guaranteed to be odd and positive here, 246 half of y - 1 can be computed as y `quot` 2, optimising subtraction away. 247-} 248 249-- | A generalization of 'Data.List.cycle' to an arbitrary 'Semigroup'. 250-- May fail to terminate for some values in some semigroups. 251cycle1 :: Semigroup m => m -> m 252cycle1 xs = xs' where xs' = xs <> xs' 253 254instance Semigroup () where 255 _ <> _ = () 256 sconcat _ = () 257 stimes _ _ = () 258 259instance Semigroup b => Semigroup (a -> b) where 260 f <> g = \a -> f a <> g a 261 stimes n f e = stimes n (f e) 262 263instance Semigroup [a] where 264 (<>) = (++) 265 stimes n x 266 | n < 0 = error "stimes: [], negative multiplier" 267 | otherwise = rep n 268 where 269 rep 0 = [] 270 rep i = x ++ rep (i - 1) 271 272instance Semigroup a => Semigroup (Maybe a) where 273 Nothing <> b = b 274 a <> Nothing = a 275 Just a <> Just b = Just (a <> b) 276 stimes _ Nothing = Nothing 277 stimes n (Just a) = case compare n 0 of 278 LT -> error "stimes: Maybe, negative multiplier" 279 EQ -> Nothing 280 GT -> Just (stimes n a) 281 282instance Semigroup (Either a b) where 283 Left _ <> b = b 284 a <> _ = a 285 stimes = stimesIdempotent 286 287instance (Semigroup a, Semigroup b) => Semigroup (a, b) where 288 (a,b) <> (a',b') = (a<>a',b<>b') 289 stimes n (a,b) = (stimes n a, stimes n b) 290 291instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where 292 (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c') 293 stimes n (a,b,c) = (stimes n a, stimes n b, stimes n c) 294 295instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) => Semigroup (a, b, c, d) where 296 (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d') 297 stimes n (a,b,c,d) = (stimes n a, stimes n b, stimes n c, stimes n d) 298 299instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) => Semigroup (a, b, c, d, e) where 300 (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e') 301 stimes n (a,b,c,d,e) = (stimes n a, stimes n b, stimes n c, stimes n d, stimes n e) 302 303instance Semigroup Ordering where 304 LT <> _ = LT 305 EQ <> y = y 306 GT <> _ = GT 307 stimes = stimesIdempotentMonoid 308 309instance Semigroup a => Semigroup (Dual a) where 310 Dual a <> Dual b = Dual (b <> a) 311 stimes n (Dual a) = Dual (stimes n a) 312 313instance Semigroup (Endo a) where 314#ifdef USE_COERCE 315 (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> (a -> a)) 316#else 317 Endo f <> Endo g = Endo (f . g) 318#endif 319 stimes = stimesMonoid 320 321instance Semigroup All where 322#ifdef USE_COERCE 323 (<>) = coerce (&&) 324#else 325 All a <> All b = All (a && b) 326#endif 327 328 stimes = stimesIdempotentMonoid 329 330instance Semigroup Any where 331#ifdef USE_COERCE 332 (<>) = coerce (||) 333#else 334 Any a <> Any b = Any (a || b) 335#endif 336 337 stimes = stimesIdempotentMonoid 338 339 340instance Num a => Semigroup (Sum a) where 341#ifdef USE_COERCE 342 (<>) = coerce ((+) :: a -> a -> a) 343#else 344 Sum a <> Sum b = Sum (a + b) 345#endif 346 stimes n (Sum a) = Sum (fromIntegral n * a) 347 348instance Num a => Semigroup (Product a) where 349#ifdef USE_COERCE 350 (<>) = coerce ((*) :: a -> a -> a) 351#else 352 Product a <> Product b = Product (a * b) 353#endif 354 stimes n (Product a) = Product (a ^ n) 355 356instance Semigroup a => Semigroup (Down a) where 357#ifdef USE_COERCE 358 (<>) = coerce ((<>) :: a -> a -> a) 359#else 360 Down a <> Down b = Down (a <> b) 361#endif 362 stimes n (Down a) = Down (stimes n a) 363 364-- | This is a valid definition of 'stimes' for a 'Monoid'. 365-- 366-- Unlike the default definition of 'stimes', it is defined for 0 367-- and so it should be preferred where possible. 368stimesMonoid :: (Integral b, Monoid a) => b -> a -> a 369stimesMonoid n x0 = case compare n 0 of 370 LT -> error "stimesMonoid: negative multiplier" 371 EQ -> mempty 372 GT -> f x0 n 373 where 374 f x y 375 | even y = f (x `mappend` x) (y `quot` 2) 376 | y == 1 = x 377 | otherwise = g (x `mappend` x) (y `quot` 2) x -- See Note [Half of y - 1] 378 g x y z 379 | even y = g (x `mappend` x) (y `quot` 2) z 380 | y == 1 = x `mappend` z 381 | otherwise = g (x `mappend` x) (y `quot` 2) (x `mappend` z) -- See Note [Half of y - 1] 382 383-- | This is a valid definition of 'stimes' for an idempotent 'Monoid'. 384-- 385-- When @mappend x x = x@, this definition should be preferred, because it 386-- works in /O(1)/ rather than /O(log n)/ 387stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a 388stimesIdempotentMonoid n x = case compare n 0 of 389 LT -> error "stimesIdempotentMonoid: negative multiplier" 390 EQ -> mempty 391 GT -> x 392{-# INLINE stimesIdempotentMonoid #-} 393 394-- | This is a valid definition of 'stimes' for an idempotent 'Semigroup'. 395-- 396-- When @x <> x = x@, this definition should be preferred, because it 397-- works in /O(1)/ rather than /O(log n)/. 398stimesIdempotent :: Integral b => b -> a -> a 399stimesIdempotent n x 400 | n <= 0 = error "stimesIdempotent: positive multiplier expected" 401 | otherwise = x 402{-# INLINE stimesIdempotent #-} 403 404instance Semigroup a => Semigroup (Const a b) where 405#ifdef USE_COERCE 406 (<>) = coerce ((<>) :: a -> a -> a) 407#else 408 Const a <> Const b = Const (a <> b) 409#endif 410 stimes n (Const a) = Const (stimes n a) 411 412#if MIN_VERSION_base(3,0,0) 413instance Semigroup (Monoid.First a) where 414 Monoid.First Nothing <> b = b 415 a <> _ = a 416 stimes = stimesIdempotentMonoid 417 418instance Semigroup (Monoid.Last a) where 419 a <> Monoid.Last Nothing = a 420 _ <> b = b 421 stimes = stimesIdempotentMonoid 422#endif 423 424#if MIN_VERSION_base(4,8,0) 425instance Alternative f => Semigroup (Alt f a) where 426# ifdef USE_COERCE 427 (<>) = coerce ((<|>) :: f a -> f a -> f a) 428# else 429 Alt a <> Alt b = Alt (a <|> b) 430# endif 431 stimes = stimesMonoid 432#endif 433 434#if MIN_VERSION_base(4,8,0) 435instance Semigroup Void where 436 a <> _ = a 437 stimes = stimesIdempotent 438#endif 439 440instance Semigroup (NonEmpty a) where 441 (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs) 442 443 444newtype Min a = Min { getMin :: a } deriving 445 ( Eq, Ord, Show, Read 446#ifdef LANGUAGE_DeriveDataTypeable 447 , Data, Typeable 448#endif 449#ifdef LANGUAGE_DeriveGeneric 450 , Generic 451#if __GLASGOW_HASKELL__ >= 706 452 , Generic1 453#endif 454#endif 455 ) 456 457instance Bounded a => Bounded (Min a) where 458 minBound = Min minBound 459 maxBound = Min maxBound 460 461instance Enum a => Enum (Min a) where 462 succ (Min a) = Min (succ a) 463 pred (Min a) = Min (pred a) 464 toEnum = Min . toEnum 465 fromEnum = fromEnum . getMin 466 enumFrom (Min a) = Min <$> enumFrom a 467 enumFromThen (Min a) (Min b) = Min <$> enumFromThen a b 468 enumFromTo (Min a) (Min b) = Min <$> enumFromTo a b 469 enumFromThenTo (Min a) (Min b) (Min c) = Min <$> enumFromThenTo a b c 470 471#ifdef MIN_VERSION_hashable 472instance Hashable a => Hashable (Min a) where 473 hashWithSalt p (Min a) = hashWithSalt p a 474#endif 475 476instance Ord a => Semigroup (Min a) where 477#ifdef USE_COERCE 478 (<>) = coerce (min :: a -> a -> a) 479#else 480 Min a <> Min b = Min (a `min` b) 481#endif 482 stimes = stimesIdempotent 483 484instance (Ord a, Bounded a) => Monoid (Min a) where 485 mempty = maxBound 486 mappend = (<>) 487 488instance Functor Min where 489 fmap f (Min x) = Min (f x) 490 491instance Foldable Min where 492 foldMap f (Min a) = f a 493 494instance Traversable Min where 495 traverse f (Min a) = Min <$> f a 496 497instance Applicative Min where 498 pure = Min 499 a <* _ = a 500 _ *> a = a 501 Min f <*> Min x = Min (f x) 502 503instance Monad Min where 504 return = Min 505 _ >> a = a 506 Min a >>= f = f a 507 508instance MonadFix Min where 509 mfix f = fix (f . getMin) 510 511#ifdef MIN_VERSION_deepseq 512instance NFData a => NFData (Min a) where 513 rnf (Min a) = rnf a 514#endif 515 516instance Num a => Num (Min a) where 517 (Min a) + (Min b) = Min (a + b) 518 (Min a) * (Min b) = Min (a * b) 519 (Min a) - (Min b) = Min (a - b) 520 negate (Min a) = Min (negate a) 521 abs (Min a) = Min (abs a) 522 signum (Min a) = Min (signum a) 523 fromInteger = Min . fromInteger 524 525#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 526instance Generic1 Min where 527 type Rep1 Min = D1 D1'Min (C1 C1'_0Min (S1 S1'_0_0Min Par1)) 528 from1 (Min x) = M1 (M1 (M1 (Par1 x))) 529 to1 (M1 (M1 (M1 x))) = Min (unPar1 x) 530 531instance Datatype D1'Min where 532 datatypeName _ = "Min" 533 moduleName _ = "Data.Semigroup" 534 535instance Constructor C1'_0Min where 536 conName _ = "Min" 537 conIsRecord _ = True 538 539instance Selector S1'_0_0Min where 540 selName _ = "getMin" 541 542data D1'Min 543data C1'_0Min 544data S1'_0_0Min 545#endif 546 547newtype Max a = Max { getMax :: a } deriving 548 ( Eq, Ord, Show, Read 549#ifdef LANGUAGE_DeriveDataTypeable 550 , Data, Typeable 551#endif 552#ifdef LANGUAGE_DeriveGeneric 553 , Generic 554#if __GLASGOW_HASKELL__ >= 706 555 , Generic1 556#endif 557#endif 558 ) 559 560instance Bounded a => Bounded (Max a) where 561 minBound = Max minBound 562 maxBound = Max maxBound 563 564instance Enum a => Enum (Max a) where 565 succ (Max a) = Max (succ a) 566 pred (Max a) = Max (pred a) 567 toEnum = Max . toEnum 568 fromEnum = fromEnum . getMax 569 enumFrom (Max a) = Max <$> enumFrom a 570 enumFromThen (Max a) (Max b) = Max <$> enumFromThen a b 571 enumFromTo (Max a) (Max b) = Max <$> enumFromTo a b 572 enumFromThenTo (Max a) (Max b) (Max c) = Max <$> enumFromThenTo a b c 573 574#ifdef MIN_VERSION_hashable 575instance Hashable a => Hashable (Max a) where 576 hashWithSalt p (Max a) = hashWithSalt p a 577#endif 578 579instance Ord a => Semigroup (Max a) where 580#ifdef USE_COERCE 581 (<>) = coerce (max :: a -> a -> a) 582#else 583 Max a <> Max b = Max (a `max` b) 584#endif 585 stimes = stimesIdempotent 586 587instance (Ord a, Bounded a) => Monoid (Max a) where 588 mempty = minBound 589 mappend = (<>) 590 591instance Functor Max where 592 fmap f (Max x) = Max (f x) 593 594instance Foldable Max where 595 foldMap f (Max a) = f a 596 597instance Traversable Max where 598 traverse f (Max a) = Max <$> f a 599 600instance Applicative Max where 601 pure = Max 602 a <* _ = a 603 _ *> a = a 604 Max f <*> Max x = Max (f x) 605 606instance Monad Max where 607 return = Max 608 _ >> a = a 609 Max a >>= f = f a 610 611instance MonadFix Max where 612 mfix f = fix (f . getMax) 613 614#ifdef MIN_VERSION_deepseq 615instance NFData a => NFData (Max a) where 616 rnf (Max a) = rnf a 617#endif 618 619instance Num a => Num (Max a) where 620 (Max a) + (Max b) = Max (a + b) 621 (Max a) * (Max b) = Max (a * b) 622 (Max a) - (Max b) = Max (a - b) 623 negate (Max a) = Max (negate a) 624 abs (Max a) = Max (abs a) 625 signum (Max a) = Max (signum a) 626 fromInteger = Max . fromInteger 627 628#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 629instance Generic1 Max where 630 type Rep1 Max = D1 D1'Max (C1 C1'_0Max (S1 S1'_0_0Max Par1)) 631 from1 (Max x) = M1 (M1 (M1 (Par1 x))) 632 to1 (M1 (M1 (M1 x))) = Max (unPar1 x) 633 634instance Datatype D1'Max where 635 datatypeName _ = "Max" 636 moduleName _ = "Data.Semigroup" 637 638instance Constructor C1'_0Max where 639 conName _ = "Max" 640 conIsRecord _ = True 641 642instance Selector S1'_0_0Max where 643 selName _ = "getMax" 644 645data D1'Max 646data C1'_0Max 647data S1'_0_0Max 648#endif 649 650-- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be placed inside 'Min' and 'Max' 651-- to compute an arg min or arg max. 652data Arg a b = Arg a b deriving 653 ( Show, Read 654#ifdef LANGUAGE_DeriveDataTypeable 655 , Data, Typeable 656#endif 657#ifdef LANGUAGE_DeriveGeneric 658 , Generic 659#if __GLASGOW_HASKELL__ >= 706 660 , Generic1 661#endif 662#endif 663 ) 664 665type ArgMin a b = Min (Arg a b) 666type ArgMax a b = Max (Arg a b) 667 668instance Functor (Arg a) where 669 fmap f (Arg x a) = Arg x (f a) 670 671instance Foldable (Arg a) where 672 foldMap f (Arg _ a) = f a 673 674instance Traversable (Arg a) where 675 traverse f (Arg x a) = Arg x <$> f a 676 677instance Eq a => Eq (Arg a b) where 678 Arg a _ == Arg b _ = a == b 679 680instance Ord a => Ord (Arg a b) where 681 Arg a _ `compare` Arg b _ = compare a b 682 min x@(Arg a _) y@(Arg b _) 683 | a <= b = x 684 | otherwise = y 685 max x@(Arg a _) y@(Arg b _) 686 | a >= b = x 687 | otherwise = y 688 689#ifdef MIN_VERSION_deepseq 690instance (NFData a, NFData b) => NFData (Arg a b) where 691 rnf (Arg a b) = rnf a `seq` rnf b `seq` () 692#endif 693 694#ifdef MIN_VERSION_hashable 695#if MIN_VERSION_hashable(1,3,0) 696-- | Instance like defined in @hashable-1.3@ 697instance Hashable a => Hashable (Arg a b) where 698 hashWithSalt p (Arg a _b) = hashWithSalt p a 699#else 700-- | Instance like defined in @hashable-1.2@ 701instance (Hashable a, Hashable b) => Hashable (Arg a b) where 702 hashWithSalt p (Arg a b) = hashWithSalt p a `hashWithSalt` b 703#endif 704#endif 705 706#if MIN_VERSION_base(4,8,0) 707instance Bifunctor Arg where 708 bimap f g (Arg a b) = Arg (f a) (g b) 709#endif 710 711#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 712instance Generic1 (Arg a) where 713 type Rep1 (Arg a) 714 = D1 D1'Arg 715 (C1 C1'_0Arg 716 (S1 NoSelector (Rec0 a) 717 :*: S1 NoSelector Par1)) 718 from1 (Arg a b) = M1 (M1 (M1 (K1 a) :*: M1 (Par1 b))) 719 to1 (M1 (M1 (M1 a :*: M1 b))) = Arg (unK1 a) (unPar1 b) 720 721instance Datatype D1'Arg where 722 datatypeName _ = "Arg" 723 moduleName _ = "Data.Semigroup" 724 725instance Constructor C1'_0Arg where 726 conName _ = "Arg" 727 728data D1'Arg 729data C1'_0Arg 730#endif 731 732-- | Use @'Option' ('First' a)@ to get the behavior of 'Data.Monoid.First' from @Data.Monoid@. 733newtype First a = First { getFirst :: a } deriving 734 ( Eq, Ord, Show, Read 735#ifdef LANGUAGE_DeriveDataTypeable 736 , Data 737 , Typeable 738#endif 739#ifdef LANGUAGE_DeriveGeneric 740 , Generic 741#if __GLASGOW_HASKELL__ >= 706 742 , Generic1 743#endif 744#endif 745 ) 746 747instance Bounded a => Bounded (First a) where 748 minBound = First minBound 749 maxBound = First maxBound 750 751instance Enum a => Enum (First a) where 752 succ (First a) = First (succ a) 753 pred (First a) = First (pred a) 754 toEnum = First . toEnum 755 fromEnum = fromEnum . getFirst 756 enumFrom (First a) = First <$> enumFrom a 757 enumFromThen (First a) (First b) = First <$> enumFromThen a b 758 enumFromTo (First a) (First b) = First <$> enumFromTo a b 759 enumFromThenTo (First a) (First b) (First c) = First <$> enumFromThenTo a b c 760 761#ifdef MIN_VERSION_hashable 762instance Hashable a => Hashable (First a) where 763 hashWithSalt p (First a) = hashWithSalt p a 764#endif 765 766instance Semigroup (First a) where 767 a <> _ = a 768 stimes = stimesIdempotent 769 770instance Functor First where 771 fmap f (First x) = First (f x) 772 773instance Foldable First where 774 foldMap f (First a) = f a 775 776instance Traversable First where 777 traverse f (First a) = First <$> f a 778 779instance Applicative First where 780 pure x = First x 781 a <* _ = a 782 _ *> a = a 783 First f <*> First x = First (f x) 784 785instance Monad First where 786 return = First 787 _ >> a = a 788 First a >>= f = f a 789 790instance MonadFix First where 791 mfix f = fix (f . getFirst) 792 793#ifdef MIN_VERSION_deepseq 794instance NFData a => NFData (First a) where 795 rnf (First a) = rnf a 796#endif 797 798#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 799instance Generic1 First where 800 type Rep1 First = D1 D1'First (C1 C1'_0First (S1 S1'_0_0First Par1)) 801 from1 (First x) = M1 (M1 (M1 (Par1 x))) 802 to1 (M1 (M1 (M1 x))) = First (unPar1 x) 803 804instance Datatype D1'First where 805 datatypeName _ = "First" 806 moduleName _ = "Data.Semigroup" 807 808instance Constructor C1'_0First where 809 conName _ = "First" 810 conIsRecord _ = True 811 812instance Selector S1'_0_0First where 813 selName _ = "getFirst" 814 815data D1'First 816data C1'_0First 817data S1'_0_0First 818#endif 819 820-- | Use @'Option' ('Last' a)@ to get the behavior of 'Data.Monoid.Last' from @Data.Monoid@ 821newtype Last a = Last { getLast :: a } deriving 822 ( Eq, Ord, Show, Read 823#ifdef LANGUAGE_DeriveDataTypeable 824 , Data, Typeable 825#endif 826#ifdef LANGUAGE_DeriveGeneric 827 , Generic 828#if __GLASGOW_HASKELL__ >= 706 829 , Generic1 830#endif 831#endif 832 ) 833 834instance Bounded a => Bounded (Last a) where 835 minBound = Last minBound 836 maxBound = Last maxBound 837 838instance Enum a => Enum (Last a) where 839 succ (Last a) = Last (succ a) 840 pred (Last a) = Last (pred a) 841 toEnum = Last . toEnum 842 fromEnum = fromEnum . getLast 843 enumFrom (Last a) = Last <$> enumFrom a 844 enumFromThen (Last a) (Last b) = Last <$> enumFromThen a b 845 enumFromTo (Last a) (Last b) = Last <$> enumFromTo a b 846 enumFromThenTo (Last a) (Last b) (Last c) = Last <$> enumFromThenTo a b c 847 848#ifdef MIN_VERSION_hashable 849instance Hashable a => Hashable (Last a) where 850 hashWithSalt p (Last a) = hashWithSalt p a 851#endif 852 853instance Semigroup (Last a) where 854 _ <> b = b 855 stimes = stimesIdempotent 856 857instance Functor Last where 858 fmap f (Last x) = Last (f x) 859 a <$ _ = Last a 860 861instance Foldable Last where 862 foldMap f (Last a) = f a 863 864instance Traversable Last where 865 traverse f (Last a) = Last <$> f a 866 867instance Applicative Last where 868 pure = Last 869 a <* _ = a 870 _ *> a = a 871 Last f <*> Last x = Last (f x) 872 873instance Monad Last where 874 return = Last 875 _ >> a = a 876 Last a >>= f = f a 877 878instance MonadFix Last where 879 mfix f = fix (f . getLast) 880 881#ifdef MIN_VERSION_deepseq 882instance NFData a => NFData (Last a) where 883 rnf (Last a) = rnf a 884#endif 885 886#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 887instance Generic1 Last where 888 type Rep1 Last = D1 D1'Last (C1 C1'_0Last (S1 S1'_0_0Last Par1)) 889 from1 (Last x) = M1 (M1 (M1 (Par1 x))) 890 to1 (M1 (M1 (M1 x))) = Last (unPar1 x) 891 892instance Datatype D1'Last where 893 datatypeName _ = "Last" 894 moduleName _ = "Data.Semigroup" 895 896instance Constructor C1'_0Last where 897 conName _ = "Last" 898 conIsRecord _ = True 899 900instance Selector S1'_0_0Last where 901 selName _ = "getLast" 902 903data D1'Last 904data C1'_0Last 905data S1'_0_0Last 906#endif 907 908-- (==)/XNOR on Bool forms a 'Semigroup', but has no good name 909 910#ifdef MIN_VERSION_binary 911# if !(MIN_VERSION_binary(0,8,3)) 912instance Semigroup Builder.Builder where 913 (<>) = mappend 914# endif 915#endif 916 917#ifdef MIN_VERSION_bytestring 918instance Semigroup BS.ByteString where 919 (<>) = mappend 920 sconcat (b:|bs) = BS.concat (b:bs) 921 922instance Semigroup BL.ByteString where 923 (<>) = mappend 924 sconcat (b:|bs) = BL.concat (b:bs) 925 926# if (MIN_VERSION_bytestring(0,10,0)) || defined(MIN_VERSION_bytestring_builder) 927instance Semigroup ByteString.Builder where 928 (<>) = mappend 929# endif 930 931# if (MIN_VERSION_bytestring(0,10,4)) || defined(MIN_VERSION_bytestring_builder) 932instance Semigroup ShortByteString where 933 (<>) = mappend 934# endif 935#endif 936 937#ifdef MIN_VERSION_text 938instance Semigroup TS.Text where 939 (<>) = mappend 940 941instance Semigroup TL.Text where 942 (<>) = mappend 943 944instance Semigroup Text.Builder where 945 (<>) = mappend 946#endif 947 948#ifdef MIN_VERSION_unordered_containers 949instance (Hashable k, Eq k) => Semigroup (Lazy.HashMap k a) where 950 (<>) = mappend 951 stimes = stimesIdempotentMonoid 952 953instance (Hashable a, Eq a) => Semigroup (HashSet a) where 954 (<>) = mappend 955 stimes = stimesIdempotentMonoid 956#endif 957 958-- | Provide a Semigroup for an arbitrary Monoid. 959newtype WrappedMonoid m = WrapMonoid 960 { unwrapMonoid :: m } deriving 961 ( Eq, Ord, Show, Read 962#ifdef LANGUAGE_DeriveDataTypeable 963 , Data, Typeable 964#endif 965#ifdef LANGUAGE_DeriveGeneric 966 , Generic 967#if __GLASGOW_HASKELL__ >= 706 968 , Generic1 969#endif 970#endif 971 ) 972 973#ifdef MIN_VERSION_hashable 974instance Hashable a => Hashable (WrappedMonoid a) where 975 hashWithSalt p (WrapMonoid a) = hashWithSalt p a 976#endif 977 978instance Monoid m => Semigroup (WrappedMonoid m) where 979#ifdef USE_COERCE 980 (<>) = coerce (mappend :: m -> m -> m) 981#else 982 WrapMonoid a <> WrapMonoid b = WrapMonoid (a `mappend` b) 983#endif 984 985instance Monoid m => Monoid (WrappedMonoid m) where 986 mempty = WrapMonoid mempty 987 mappend = (<>) 988 989instance Bounded a => Bounded (WrappedMonoid a) where 990 minBound = WrapMonoid minBound 991 maxBound = WrapMonoid maxBound 992 993instance Enum a => Enum (WrappedMonoid a) where 994 succ (WrapMonoid a) = WrapMonoid (succ a) 995 pred (WrapMonoid a) = WrapMonoid (pred a) 996 toEnum = WrapMonoid . toEnum 997 fromEnum = fromEnum . unwrapMonoid 998 enumFrom (WrapMonoid a) = WrapMonoid <$> enumFrom a 999 enumFromThen (WrapMonoid a) (WrapMonoid b) = WrapMonoid <$> enumFromThen a b 1000 enumFromTo (WrapMonoid a) (WrapMonoid b) = WrapMonoid <$> enumFromTo a b 1001 enumFromThenTo (WrapMonoid a) (WrapMonoid b) (WrapMonoid c) = WrapMonoid <$> enumFromThenTo a b c 1002 1003#ifdef MIN_VERSION_deepseq 1004instance NFData m => NFData (WrappedMonoid m) where 1005 rnf (WrapMonoid a) = rnf a 1006#endif 1007 1008#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 1009instance Generic1 WrappedMonoid where 1010 type Rep1 WrappedMonoid = D1 D1'WrappedMonoid (C1 C1'_0WrappedMonoid (S1 S1'_0_0WrappedMonoid Par1)) 1011 from1 (WrapMonoid x) = M1 (M1 (M1 (Par1 x))) 1012 to1 (M1 (M1 (M1 x))) = WrapMonoid (unPar1 x) 1013 1014instance Datatype D1'WrappedMonoid where 1015 datatypeName _ = "WrappedMonoid" 1016 moduleName _ = "Data.Semigroup" 1017 1018instance Constructor C1'_0WrappedMonoid where 1019 conName _ = "WrapMonoid" 1020 conIsRecord _ = True 1021 1022instance Selector S1'_0_0WrappedMonoid where 1023 selName _ = "unwrapMonoid" 1024 1025data D1'WrappedMonoid 1026data C1'_0WrappedMonoid 1027data S1'_0_0WrappedMonoid 1028#endif 1029 1030-- | Repeat a value @n@ times. 1031-- 1032-- > mtimesDefault n a = a <> a <> ... <> a -- using <> (n-1) times 1033-- 1034-- Implemented using 'stimes' and 'mempty'. 1035-- 1036-- This is a suitable definition for an 'mtimes' member of 'Monoid'. 1037-- 1038-- @since 0.17 1039mtimesDefault :: (Integral b, Monoid a) => b -> a -> a 1040mtimesDefault n x 1041 | n == 0 = mempty 1042 | otherwise = unwrapMonoid (stimes n (WrapMonoid x)) 1043 1044-- | 'Option' is effectively 'Maybe' with a better instance of 'Monoid', built off of an underlying 'Semigroup' 1045-- instead of an underlying 'Monoid'. 1046-- 1047-- Ideally, this type would not exist at all and we would just fix the 'Monoid' instance of 'Maybe' 1048newtype Option a = Option 1049 { getOption :: Maybe a } deriving 1050 ( Eq, Ord, Show, Read 1051#ifdef LANGUAGE_DeriveDataTypeable 1052 , Data, Typeable 1053#endif 1054#ifdef LANGUAGE_DeriveGeneric 1055 , Generic 1056#if __GLASGOW_HASKELL__ >= 706 1057 , Generic1 1058#endif 1059#endif 1060 ) 1061 1062#ifdef MIN_VERSION_hashable 1063instance Hashable a => Hashable (Option a) where 1064 hashWithSalt p (Option a) = hashWithSalt p a 1065#endif 1066 1067instance Functor Option where 1068 fmap f (Option a) = Option (fmap f a) 1069 1070instance Applicative Option where 1071 pure a = Option (Just a) 1072 Option a <*> Option b = Option (a <*> b) 1073 1074instance Monad Option where 1075 return = pure 1076 1077 Option (Just a) >>= k = k a 1078 _ >>= _ = Option Nothing 1079 1080 Option Nothing >> _ = Option Nothing 1081 _ >> b = b 1082 1083instance Alternative Option where 1084 empty = Option Nothing 1085 Option Nothing <|> b = b 1086 a <|> _ = a 1087 1088instance MonadPlus Option where 1089 mzero = Option Nothing 1090 mplus = (<|>) 1091 1092instance MonadFix Option where 1093 mfix f = Option (mfix (getOption . f)) 1094 1095instance Foldable Option where 1096 foldMap f (Option (Just m)) = f m 1097 foldMap _ (Option Nothing) = mempty 1098 1099instance Traversable Option where 1100 traverse f (Option (Just a)) = Option . Just <$> f a 1101 traverse _ (Option Nothing) = pure (Option Nothing) 1102 1103#ifdef MIN_VERSION_deepseq 1104instance NFData a => NFData (Option a) where 1105 rnf (Option a) = rnf a 1106#endif 1107 1108-- | Fold an 'Option' case-wise, just like 'maybe'. 1109option :: b -> (a -> b) -> Option a -> b 1110option n j (Option m) = maybe n j m 1111 1112instance Semigroup a => Semigroup (Option a) where 1113#ifdef USE_COERCE 1114 (<>) = coerce ((<>) :: Maybe a -> Maybe a -> Maybe a) 1115#else 1116 Option a <> Option b = Option (a <> b) 1117#endif 1118 stimes _ (Option Nothing) = Option Nothing 1119 stimes n (Option (Just a)) = case compare n 0 of 1120 LT -> error "stimes: Option, negative multiplier" 1121 EQ -> Option Nothing 1122 GT -> Option (Just (stimes n a)) 1123 1124instance Semigroup a => Monoid (Option a) where 1125 mempty = Option Nothing 1126 mappend = (<>) 1127 1128#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 706 1129instance Generic1 Option where 1130 type Rep1 Option = D1 D1'Option (C1 C1'_0Option (S1 S1'_0_0Option (Rec1 Maybe))) 1131 from1 (Option x) = M1 (M1 (M1 (Rec1 x))) 1132 to1 (M1 (M1 (M1 x))) = Option (unRec1 x) 1133 1134instance Datatype D1'Option where 1135 datatypeName _ = "Option" 1136 moduleName _ = "Data.Semigroup" 1137 1138instance Constructor C1'_0Option where 1139 conName _ = "Option" 1140 conIsRecord _ = True 1141 1142instance Selector S1'_0_0Option where 1143 selName _ = "getOption" 1144 1145data D1'Option 1146data C1'_0Option 1147data S1'_0_0Option 1148#endif 1149 1150-- | This lets you use a difference list of a 'Semigroup' as a 'Monoid'. 1151diff :: Semigroup m => m -> Endo m 1152diff = Endo . (<>) 1153 1154#ifdef MIN_VERSION_containers 1155instance Semigroup (Seq a) where 1156 (<>) = (><) 1157 1158instance Semigroup IntSet where 1159 (<>) = mappend 1160 stimes = stimesIdempotentMonoid 1161 1162instance Ord a => Semigroup (Set a) where 1163 (<>) = mappend 1164 stimes = stimesIdempotentMonoid 1165 1166instance Semigroup (IntMap v) where 1167 (<>) = mappend 1168 stimes = stimesIdempotentMonoid 1169 1170instance Ord k => Semigroup (Map k v) where 1171 (<>) = mappend 1172 stimes = stimesIdempotentMonoid 1173#endif 1174 1175#if (MIN_VERSION_base(4,8,0)) || defined(MIN_VERSION_transformers) 1176instance Semigroup a => Semigroup (Identity a) where 1177# ifdef USE_COERCE 1178 (<>) = coerce ((<>) :: a -> a -> a) 1179# else 1180 Identity a <> Identity b = Identity (a <> b) 1181# endif 1182 stimes n (Identity a) = Identity (stimes n a) 1183#endif 1184 1185#if (MIN_VERSION_base(4,7,0)) || defined(MIN_VERSION_tagged) 1186instance Semigroup (Proxy s) where 1187 _ <> _ = Proxy 1188 sconcat _ = Proxy 1189 stimes _ _ = Proxy 1190#endif 1191 1192#ifdef MIN_VERSION_tagged 1193instance Semigroup a => Semigroup (Tagged s a) where 1194# ifdef USE_COERCE 1195 (<>) = coerce ((<>) :: a -> a -> a) 1196# else 1197 Tagged a <> Tagged b = Tagged (a <> b) 1198# endif 1199 stimes n (Tagged a) = Tagged (stimes n a) 1200#endif 1201 1202instance Semigroup a => Semigroup (IO a) where 1203 (<>) = liftA2 (<>) 1204 1205instance Semigroup a => Semigroup (Strict.ST s a) where 1206#if MIN_VERSION_base(4,4,0) 1207 (<>) = liftA2 (<>) 1208#else 1209 (<>) = liftM2 (<>) -- No Applicative instance for ST on GHC 7.0 1210#endif 1211 1212#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) && !defined(ETA_VERSION) 1213# if MIN_VERSION_base(4,4,0) 1214instance Semigroup Event where 1215 (<>) = mappend 1216 stimes = stimesMonoid 1217# endif 1218 1219# if MIN_VERSION_base(4,8,1) 1220instance Semigroup Lifetime where 1221 (<>) = mappend 1222 stimes = stimesMonoid 1223# endif 1224#endif 1225