base 4.7.0.2 → 4.8.0.0

raw patch · 223 files changed

+20260/−17251 lines, 223 filesdep ~ghc-primdep ~integer-gmpsetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc-prim, integer-gmp

API changes (from Hackage documentation)

Files

• Control/Applicative.hs +32/−221
• Control/Arrow.hs +15/−5
• Control/Category.hs +7/−9
• Control/Concurrent.hs +9/−13
• Control/Concurrent/Chan.hs +1/−3
• Control/Concurrent/MVar.hs +4/−4
• Control/Concurrent/QSem.hs +2/−2
• Control/Concurrent/QSemN.hs +2/−2
• Control/Exception.hs +6/−6
• Control/Exception/Base.hs +4/−4
• Control/Monad.hs +65/−168
• Control/Monad/Fix.hs +8/−4
• Control/Monad/Instances.hs +0/−2
• Control/Monad/ST.hs +2/−2
• Control/Monad/ST/Lazy.hs +2/−2
• Control/Monad/ST/Lazy/Imp.hs +6/−4
• Control/Monad/ST/Lazy/Safe.hs +1/−1
• Control/Monad/ST/Safe.hs +1/−1
• Control/Monad/ST/Strict.hs +2/−0
• Control/Monad/Zip.hs +1/−2
• Data/Bifunctor.hs +101/−0
• Data/Bits.hs +221/−34
• Data/Bool.hs +29/−6
• Data/Char.hs +336/−17
• Data/Coerce.hs +7/−4
• Data/Complex.hs +21/−9
• Data/Data.hs +38/−33
• Data/Dynamic.hs +1/−1
• Data/Either.hs +186/−12
• Data/Fixed.hs +14/−23
• Data/Foldable.hs +225/−88
• Data/Function.hs +14/−2
• Data/Functor.hs +107/−5
• Data/Functor/Identity.hs +104/−0
• Data/IORef.hs +6/−6
• Data/Ix.hs +3/−5
• Data/List.hs +30/−945
• Data/Maybe.hs +191/−32
• Data/Monoid.hs +41/−115
• Data/OldList.hs +1179/−0
• Data/OldTypeable.hs +0/−179
• Data/OldTypeable/Internal.hs +0/−475
• Data/OldTypeable/Internal.hs-boot +0/−28
• Data/Ord.hs +1/−1
• Data/Proxy.hs +18/−2
• Data/Ratio.hs +0/−2
• Data/STRef.hs +1/−3
• Data/STRef/Lazy.hs +1/−2
• Data/Traversable.hs +31/−26
• Data/Tuple.hs +2/−15
• Data/Type/Bool.hs +16/−17
• Data/Type/Coercion.hs +2/−2
• Data/Type/Equality.hs +74/−19
• Data/Typeable.hs +10/−17
• Data/Typeable/Internal.hs +105/−115
• Data/Typeable/Internal.hs-boot +0/−30
• Data/Unique.hs +1/−3
• Data/Version.hs +35/−19
• Data/Void.hs +74/−0
• Data/Word.hs +2/−4
• Debug/Trace.hs +22/−17
• Foreign.hs +1/−1
• Foreign/C/Error.hs +37/−37
• Foreign/C/String.hs +2/−4
• Foreign/C/Types.hs +4/−8
• Foreign/ForeignPtr.hs +2/−2
• Foreign/ForeignPtr/Safe.hs +1/−1
• Foreign/Marshal.hs +13/−5
• Foreign/Marshal/Alloc.hs +19/−4
• Foreign/Marshal/Array.hs +18/−1
• Foreign/Marshal/Pool.hs +3/−4
• Foreign/Marshal/Safe.hs +1/−1
• Foreign/Marshal/Utils.hs +17/−2
• Foreign/Ptr.hs +2/−6
• Foreign/Safe.hs +5/−5
• Foreign/Storable.hs +17/−12
• GHC/Arr.hs +899/−0
• GHC/Arr.lhs +0/−849
• GHC/Base.hs +1199/−0
• GHC/Base.lhs +0/−741
• GHC/Char.hs +1/−1
• GHC/Conc.hs +119/−0
• GHC/Conc.lhs +0/−116
• GHC/Conc/Signal.hs +0/−1
• GHC/Conc/Sync.hs +897/−0
• GHC/Conc/Sync.lhs +0/−817
• GHC/Conc/Windows.hs +4/−5
• GHC/ConsoleHandler.hs +4/−0
• GHC/Constants.hs +2/−2
• GHC/Enum.hs +731/−0
• GHC/Enum.lhs +0/−739
• GHC/Environment.hs +4/−3
• GHC/Err.hs +47/−0
• GHC/Err.lhs +0/−68
• GHC/Event.hs +3/−2
• GHC/Event/Array.hs +1/−2
• GHC/Event/Control.hs +9/−7
• GHC/Event/EPoll.hsc +1/−4
• GHC/Event/IntTable.hs +9/−5
• GHC/Event/Internal.hs +49/−4
• GHC/Event/KQueue.hsc +0/−3
• GHC/Event/Manager.hs +126/−108
• GHC/Event/PSQ.hs +1/−2
• GHC/Event/Poll.hsc +11/−9
• GHC/Event/Thread.hs +42/−26
• GHC/Event/TimerManager.hs +2/−29
• GHC/Event/Unique.hs +2/−1
• GHC/Exception.hs +197/−0
• GHC/Exception.hs-boot +34/−0
• GHC/Exception.lhs +0/−210
• GHC/Exception.lhs-boot +0/−38
• GHC/Exts.hs +19/−12
• GHC/Fingerprint.hs +1/−2
• GHC/Fingerprint.hs-boot +2/−1
• GHC/Fingerprint/Type.hs +1/−0
• GHC/Float.hs +1153/−0
• GHC/Float.lhs +0/−1200
• GHC/Foreign.hs +5/−6
• GHC/ForeignPtr.hs +12/−12
• GHC/GHCi.hs +8/−1
• GHC/Generics.hs +5/−5
• GHC/IO.hs +28/−20
• GHC/IO/Buffer.hs +11/−11
• GHC/IO/BufferedIO.hs +2/−3
• GHC/IO/Device.hs +4/−5
• GHC/IO/Encoding.hs +12/−13
• GHC/IO/Encoding/CodePage.hs +1/−1
• GHC/IO/Encoding/CodePage/API.hs +14/−12
• GHC/IO/Encoding/Failure.hs +2/−5
• GHC/IO/Encoding/Iconv.hs +16/−16
• GHC/IO/Encoding/Latin1.hs +2/−2
• GHC/IO/Encoding/Types.hs +2/−2
• GHC/IO/Encoding/UTF16.hs +11/−12
• GHC/IO/Encoding/UTF32.hs +11/−12
• GHC/IO/Encoding/UTF8.hs +1/−1
• GHC/IO/Exception.hs +28/−6
• GHC/IO/FD.hs +23/−24
• GHC/IO/Handle.hs +53/−54
• GHC/IO/Handle/FD.hs +1/−1
• GHC/IO/Handle/Internals.hs +27/−28
• GHC/IO/Handle/Text.hs +30/−28
• GHC/IO/Handle/Types.hs +22/−23
• GHC/IOArray.hs +4/−1
• GHC/IORef.hs +1/−1
• GHC/IP.hs +3/−2
• GHC/Int.hs +24/−13
• GHC/List.hs +1005/−0
• GHC/List.lhs +0/−772
• GHC/MVar.hs +3/−4
• GHC/Natural.hs +644/−0
• GHC/Num.hs +99/−0
• GHC/Num.lhs +0/−135
• GHC/OldList.hs +29/−0
• GHC/PArr.hs +1/−0
• GHC/Pack.hs +101/−0
• GHC/Pack.lhs +0/−103
• GHC/Profiling.hs +6/−1
• GHC/Ptr.hs +174/−0
• GHC/Ptr.lhs +0/−169
• GHC/RTS/Flags.hsc +408/−0
• GHC/Read.hs +650/−0
• GHC/Read.lhs +0/−682
• GHC/Real.hs +664/−0
• GHC/Real.lhs +0/−729
• GHC/ST.hs +165/−0
• GHC/ST.lhs +0/−170
• GHC/STRef.hs +49/−0
• GHC/STRef.lhs +0/−52
• GHC/Show.hs +507/−0
• GHC/Show.lhs +0/−554
• GHC/Show.lhs-boot +0/−11
• GHC/Stable.hs +111/−0
• GHC/Stable.lhs +0/−113
• GHC/Stack.hsc +9/−6
• GHC/StaticPtr.hs +117/−0
• GHC/Stats.hsc +9/−5
• GHC/Storable.hs +158/−0
• GHC/Storable.lhs +0/−164
• GHC/TopHandler.hs +222/−0
• GHC/TopHandler.lhs +0/−227
• GHC/TypeLits.hs +38/−25
• GHC/Unicode.hs +43/−38
• GHC/Unicode.hs-boot +0/−20
• GHC/Weak.hs +157/−0
• GHC/Weak.lhs +0/−161
• GHC/Windows.hs +4/−3
• GHC/Word.hs +11/−5
• Numeric.hs +2/−3
• Numeric/Natural.hs +24/−0
• Prelude.hs +32/−28
• Setup.hs +1/−1
• System/CPUTime.hsc +1/−3
• System/Console/GetOpt.hs +0/−2
• System/Environment.hs +4/−6
• System/Environment/ExecutablePath.hsc +2/−2
• System/Exit.hs +8/−2
• System/IO.hs +26/−19
• System/IO/Error.hs +17/−21
• System/IO/Unsafe.hs +1/−1
• System/Info.hs +1/−2
• System/Mem.hs +2/−3
• System/Mem/StableName.hs +16/−18
• System/Mem/Weak.hs +23/−23
• System/Posix/Internals.hs +13/−16
• System/Posix/Types.hs +1/−1
• System/Timeout.hs +2/−2
• Text/ParserCombinators/ReadP.hs +55/−39
• Text/ParserCombinators/ReadPrec.hs +13/−7
• Text/Printf.hs +27/−43
• Text/Read.hs +4/−5
• Text/Read/Lex.hs +76/−29
• Text/Show/Functions.hs +3/−5
• base.cabal +36/−11
• cbits/PrelIOUtils.c +3/−10
• cbits/WCsubst.c +4742/−4392
• cbits/rts.c +42/−0
• changelog.md +150/−2
• config.guess +27/−165
• config.sub +13/−10
• configure +1/−1
• configure.ac +1/−1
• include/OldTypeable.h +0/−29
• include/WCsubst.h +13/−12

@@ -1,6 +1,9 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE ScopedTypeVariables #-}  ----------------------------------------------------------------------------- -- |@@ -46,210 +49,49 @@     optional,     ) where -import Prelude hiding (id,(.))--import Control.Category+import Control.Category hiding ((.), id) import Control.Arrow-import Control.Monad (liftM, ap, MonadPlus(..))-import Control.Monad.ST.Safe (ST)-import qualified Control.Monad.ST.Lazy.Safe as Lazy (ST)-import Data.Functor ((<$>), (<$))-import Data.Monoid (Monoid(..))-import Data.Proxy--import Text.ParserCombinators.ReadP (ReadP)-import Text.ParserCombinators.ReadPrec (ReadPrec)+import Data.Maybe+import Data.Tuple+import Data.Eq+import Data.Ord+import Data.Foldable (Foldable(..))+import Data.Functor ((<$>)) -import GHC.Conc (STM, retry, orElse)+import GHC.Base import GHC.Generics--infixl 3 <|>-infixl 4 <*>, <*, *>, <**>---- | A functor with application, providing operations to------ * embed pure expressions ('pure'), and------ * sequence computations and combine their results ('<*>').------ A minimal complete definition must include implementations of these--- functions satisfying the following laws:------ [/identity/]------      @'pure' 'id' '<*>' v = v@------ [/composition/]------      @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@------ [/homomorphism/]------      @'pure' f '<*>' 'pure' x = 'pure' (f x)@------ [/interchange/]------      @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@------ The other methods have the following default definitions, which may--- be overridden with equivalent specialized implementations:------   * @u '*>' v = 'pure' ('const' 'id') '<*>' u '<*>' v@------   * @u '<*' v = 'pure' 'const' '<*>' u '<*>' v@------ As a consequence of these laws, the 'Functor' instance for @f@ will satisfy------   * @'fmap' f x = 'pure' f '<*>' x@------ If @f@ is also a 'Monad', it should satisfy------   * @'pure' = 'return'@------   * @('<*>') = 'ap'@------ (which implies that 'pure' and '<*>' satisfy the applicative functor laws).--class Functor f => Applicative f where-    -- | Lift a value.-    pure :: a -> f a--    -- | Sequential application.-    (<*>) :: f (a -> b) -> f a -> f b--    -- | Sequence actions, discarding the value of the first argument.-    (*>) :: f a -> f b -> f b-    (*>) = liftA2 (const id)--    -- | Sequence actions, discarding the value of the second argument.-    (<*) :: f a -> f b -> f a-    (<*) = liftA2 const---- | A monoid on applicative functors.------ Minimal complete definition: 'empty' and '<|>'.------ If defined, 'some' and 'many' should be the least solutions--- of the equations:------ * @some v = (:) '<$>' v '<*>' many v@------ * @many v = some v '<|>' 'pure' []@-class Applicative f => Alternative f where-    -- | The identity of '<|>'-    empty :: f a-    -- | An associative binary operation-    (<|>) :: f a -> f a -> f a--    -- | One or more.-    some :: f a -> f [a]-    some v = some_v-      where-        many_v = some_v <|> pure []-        some_v = (:) <$> v <*> many_v--    -- | Zero or more.-    many :: f a -> f [a]-    many v = many_v-      where-        many_v = some_v <|> pure []-        some_v = (:) <$> v <*> many_v---- instances for Prelude types--instance Applicative Maybe where-    pure = return-    (<*>) = ap--instance Alternative Maybe where-    empty = Nothing-    Nothing <|> r = r-    l       <|> _ = l--instance Applicative [] where-    pure = return-    (<*>) = ap--instance Alternative [] where-    empty = []-    (<|>) = (++)--instance Applicative IO where-    pure = return-    (<*>) = ap--instance Applicative (ST s) where-    pure = return-    (<*>) = ap--instance Applicative (Lazy.ST s) where-    pure = return-    (<*>) = ap--instance Applicative STM where-    pure = return-    (<*>) = ap--instance Alternative STM where-    empty = retry-    (<|>) = orElse--instance Applicative ((->) a) where-    pure = const-    (<*>) f g x = f x (g x)--instance Monoid a => Applicative ((,) a) where-    pure x = (mempty, x)-    (u, f) <*> (v, x) = (u `mappend` v, f x)--instance Applicative (Either e) where-    pure          = Right-    Left  e <*> _ = Left e-    Right f <*> r = fmap f r--instance Applicative ReadP where-    pure = return-    (<*>) = ap--instance Alternative ReadP where-    empty = mzero-    (<|>) = mplus--instance Applicative ReadPrec where-    pure = return-    (<*>) = ap--instance Alternative ReadPrec where-    empty = mzero-    (<|>) = mplus+import GHC.List (repeat, zipWith)+import GHC.Read (Read(readsPrec), readParen, lex)+import GHC.Show (Show(showsPrec), showParen, showString) -instance Arrow a => Applicative (ArrowMonad a) where-   pure x = ArrowMonad (arr (const x))-   ArrowMonad f <*> ArrowMonad x = ArrowMonad (f &&& x >>> arr (uncurry id))+newtype Const a b = Const { getConst :: a }+                  deriving (Generic, Generic1, Monoid, Eq, Ord) -instance ArrowPlus a => Alternative (ArrowMonad a) where-   empty = ArrowMonad zeroArrow-   ArrowMonad x <|> ArrowMonad y = ArrowMonad (x <+> y)+instance Read a => Read (Const a b) where+    readsPrec d = readParen (d > 10)+        $ \r -> [(Const x,t) | ("Const", s) <- lex r, (x, t) <- readsPrec 11 s] --- new instances+instance Show a => Show (Const a b) where+    showsPrec d (Const x) = showParen (d > 10) $+                            showString "Const " . showsPrec 11 x -newtype Const a b = Const { getConst :: a }-                  deriving (Generic, Generic1)+instance Foldable (Const m) where+    foldMap _ _ = mempty  instance Functor (Const m) where     fmap _ (Const v) = Const v --- Added in base-4.7.0.0-instance Monoid a => Monoid (Const a b) where-    mempty = Const mempty-    mappend (Const a) (Const b) = Const (mappend a b)- instance Monoid m => Applicative (Const m) where     pure _ = Const mempty-    Const f <*> Const v = Const (f `mappend` v)+    (<*>) = coerce (mappend :: m -> m -> m)+-- This is pretty much the same as+-- Const f <*> Const v = Const (f `mappend` v)+-- but guarantees that mappend for Const a b will have the same arity+-- as the one for a; it won't create a closure to raise the arity+-- to 2.  newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }-                         deriving (Generic, Generic1)+                         deriving (Generic, Generic1, Monad)  instance Monad m => Functor (WrappedMonad m) where     fmap f (WrapMonad v) = WrapMonad (liftM f v)@@ -258,11 +100,6 @@     pure = WrapMonad . return     WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v) --- Added in base-4.7.0.0 (GHC Trac #8218)-instance Monad m => Monad (WrappedMonad m) where-    return = WrapMonad . return-    a >>= f = WrapMonad (unwrapMonad a >>= unwrapMonad . f)- instance MonadPlus m => Alternative (WrappedMonad m) where     empty = WrapMonad mzero     WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)@@ -286,39 +123,13 @@ -- @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@ -- newtype ZipList a = ZipList { getZipList :: [a] }-                  deriving (Show, Eq, Ord, Read, Generic, Generic1)--instance Functor ZipList where-    fmap f (ZipList xs) = ZipList (map f xs)+                  deriving (Show, Eq, Ord, Read, Functor, Generic, Generic1)  instance Applicative ZipList where     pure x = ZipList (repeat x)     ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs) -instance Applicative Proxy where-    pure _ = Proxy-    {-# INLINE pure #-}-    _ <*> _ = Proxy-    {-# INLINE (<*>) #-}- -- extra functions---- | A variant of '<*>' with the arguments reversed.-(<**>) :: Applicative f => f a -> f (a -> b) -> f b-(<**>) = liftA2 (flip ($))---- | Lift a function to actions.--- This function may be used as a value for `fmap` in a `Functor` instance.-liftA :: Applicative f => (a -> b) -> f a -> f b-liftA f a = pure f <*> a---- | Lift a binary function to actions.-liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c-liftA2 f a b = f <$> a <*> b---- | Lift a ternary function to actions.-liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d-liftA3 f a b c = f <$> a <*> b <*> c  -- | One or none. optional :: Alternative f => f a -> f (Maybe a)

@@ -1,4 +1,6 @@ {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Arrow@@ -41,11 +43,11 @@     ArrowLoop(..)     ) where -import Prelude hiding (id,(.))--import Control.Monad+import Data.Tuple ( fst, snd, uncurry )+import Data.Either import Control.Monad.Fix import Control.Category+import GHC.Base hiding ( (.), id )  infixr 5 <+> infixr 3 ***@@ -57,7 +59,7 @@  -- | The basic arrow class. ----- Minimal complete definition: 'arr' and 'first', satisfying the laws+-- Instances should satisfy the following laws: -- --  * @'arr' id = 'id'@ --@@ -191,7 +193,7 @@ -- | Choice, for arrows that support it.  This class underlies the -- @if@ and @case@ constructs in arrow notation. ----- Minimal complete definition: 'left', satisfying the laws+-- Instances should satisfy the following laws: -- --  * @'left' ('arr' f) = 'arr' ('left' f)@ --@@ -304,10 +306,18 @@ instance Arrow a => Functor (ArrowMonad a) where     fmap f (ArrowMonad m) = ArrowMonad $ m >>> arr f +instance Arrow a => Applicative (ArrowMonad a) where+   pure x = ArrowMonad (arr (const x))+   ArrowMonad f <*> ArrowMonad x = ArrowMonad (f &&& x >>> arr (uncurry id))+ instance ArrowApply a => Monad (ArrowMonad a) where     return x = ArrowMonad (arr (\_ -> x))     ArrowMonad m >>= f = ArrowMonad $         m >>> arr (\x -> let ArrowMonad h = f x in (h, ())) >>> app++instance ArrowPlus a => Alternative (ArrowMonad a) where+   empty = ArrowMonad zeroArrow+   ArrowMonad x <|> ArrowMonad y = ArrowMonad (x <+> y)  instance (ArrowApply a, ArrowPlus a) => MonadPlus (ArrowMonad a) where    mzero = ArrowMonad zeroArrow

@@ -1,9 +1,7 @@ {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE CPP #-}--#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE PolyKinds, GADTs #-}-#endif+{-# LANGUAGE GADTs #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE PolyKinds #-}  ----------------------------------------------------------------------------- -- |@@ -15,11 +13,11 @@ -- Stability   :  experimental -- Portability :  portable --- http://hackage.haskell.org/trac/ghc/ticket/1773+-- http://ghc.haskell.org/trac/ghc/ticket/1773  module Control.Category where -import qualified Prelude+import qualified GHC.Base (id,(.)) import Data.Type.Coercion import Data.Type.Equality import GHC.Prim (coerce)@@ -46,8 +44,8 @@  #-}  instance Category (->) where-    id = Prelude.id-    (.) = (Prelude..)+    id = GHC.Base.id+    (.) = (GHC.Base..)  instance Category (:~:) where   id          = Refl

@@ -4,7 +4,6 @@            , UnboxedTuples            , ScopedTypeVariables   #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} -- kludge for the Control.Concurrent.QSem, Control.Concurrent.QSemN -- and Control.Concurrent.SampleVar imports.@@ -104,27 +103,24 @@      ) where -import Prelude- import Control.Exception.Base as Exception -import GHC.Exception import GHC.Conc hiding (threadWaitRead, threadWaitWrite,                         threadWaitReadSTM, threadWaitWriteSTM)-import qualified GHC.Conc-import GHC.IO           ( IO(..), unsafeInterleaveIO, unsafeUnmask )+import GHC.IO           ( unsafeUnmask ) import GHC.IORef        ( newIORef, readIORef, writeIORef ) import GHC.Base  import System.Posix.Types ( Fd ) import Foreign.StablePtr import Foreign.C.Types-import Control.Monad  #ifdef mingw32_HOST_OS import Foreign.C import System.IO-import Data.Maybe (Maybe(..))+import Data.Functor ( void )+#else+import qualified GHC.Conc #endif  import Control.Concurrent.MVar@@ -195,7 +191,7 @@ -- This function is useful for informing the parent when a child -- terminates, for example. ----- /Since: 4.6.0.0/+-- @since 4.6.0.0 forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId forkFinally action and_then =   mask $ \restore ->@@ -361,8 +357,8 @@  Use this function /only/ in the rare case that you have actually observed a performance loss due to the use of bound threads. A program that-doesn't need it's main thread to be bound and makes /heavy/ use of concurrency-(e.g. a web server), might want to wrap it's @main@ action in+doesn't need its main thread to be bound and makes /heavy/ use of concurrency+(e.g. a web server), might want to wrap its @main@ action in @runInUnboundThread@.  Note that exceptions which are thrown to the current thread are thrown in turn@@ -435,7 +431,7 @@ -- is an IO action that can be used to deregister interest -- in the file descriptor. ----- /Since: 4.7.0.0/+-- @since 4.7.0.0 threadWaitReadSTM :: Fd -> IO (STM (), IO ()) threadWaitReadSTM fd #ifdef mingw32_HOST_OS@@ -459,7 +455,7 @@ -- is an IO action that can be used to deregister interest -- in the file descriptor. ----- /Since: 4.7.0.0/+-- @since 4.7.0.0 threadWaitWriteSTM :: Fd -> IO (STM (), IO ()) threadWaitWriteSTM fd #ifdef mingw32_HOST_OS

@@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}  ----------------------------------------------------------------------------- -- |@@ -33,8 +33,6 @@         getChanContents,         writeList2Chan,    ) where--import Prelude  import System.IO.Unsafe         ( unsafeInterleaveIO ) import Control.Concurrent.MVar

@@ -193,7 +193,7 @@   Like 'withMVar', but the @IO@ action in the second argument is executed   with asynchronous exceptions masked. -  /Since: 4.7.0.0/+  @since 4.7.0.0 -} {-# INLINE withMVarMasked #-} withMVarMasked :: MVar a -> (a -> IO b) -> IO b@@ -236,7 +236,7 @@   Like 'modifyMVar_', but the @IO@ action in the second argument is executed with   asynchronous exceptions masked. -  /Since: 4.6.0.0/+  @since 4.6.0.0 -} {-# INLINE modifyMVarMasked_ #-} modifyMVarMasked_ :: MVar a -> (a -> IO a) -> IO ()@@ -250,7 +250,7 @@   Like 'modifyMVar', but the @IO@ action in the second argument is executed with   asynchronous exceptions masked. -  /Since: 4.6.0.0/+  @since 4.6.0.0 -} {-# INLINE modifyMVarMasked #-} modifyMVarMasked :: MVar a -> (a -> IO (a,b)) -> IO b@@ -268,7 +268,7 @@ -- | Make a 'Weak' pointer to an 'MVar', using the second argument as -- a finalizer to run when 'MVar' is garbage-collected ----- /Since: 4.6.0.0/+-- @since 4.6.0.0 mkWeakMVar :: MVar a -> IO () -> IO (Weak (MVar a)) mkWeakMVar m@(MVar m#) f = IO $ \s ->   case mkWeak# m# m f s of (# s1, w #) -> (# s1, Weak w #)

@@ -1,5 +1,5 @@-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE DeriveDataTypeable, BangPatterns #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE AutoDeriveTypeable, BangPatterns #-} {-# OPTIONS_GHC -funbox-strict-fields #-}  -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE DeriveDataTypeable, BangPatterns #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE AutoDeriveTypeable, BangPatterns #-} {-# OPTIONS_GHC -funbox-strict-fields #-}  -----------------------------------------------------------------------------

@@ -48,6 +48,7 @@         NestedAtomically(..),         BlockedIndefinitelyOnMVar(..),         BlockedIndefinitelyOnSTM(..),+        AllocationLimitExceeded(..),         Deadlock(..),         NoMethodError(..),         PatternMatchFail(..),@@ -133,7 +134,6 @@  import GHC.Base import GHC.IO (unsafeUnmask)-import Data.Maybe  -- | You need this when using 'catches'. data Handler a = forall e . Exception e => Handler (e -> IO a)@@ -191,11 +191,11 @@    case use 'catch' or 'catchJust'.  The difference between using 'try' and 'catch' for recovery is that in-'catch' the handler is inside an implicit 'block' (see \"Asynchronous+'catch' the handler is inside an implicit 'mask' (see \"Asynchronous Exceptions\") which is important when catching asynchronous exceptions, but when catching other kinds of exception it is unnecessary.  Furthermore it is possible to accidentally stay inside-the implicit 'block' by tail-calling rather than returning from the+the implicit 'mask' by tail-calling rather than returning from the handler, which is why we recommend using 'try' rather than 'catch' for ordinary exception recovery. @@ -211,7 +211,7 @@ -- ----------------------------------------------------------------------------- -- Asynchronous exceptions --- | When invoked inside 'mask', this function allows a blocked+-- | When invoked inside 'mask', this function allows a masked -- asynchronous exception to be raised, if one exists.  It is -- equivalent to performing an interruptible operation (see -- #interruptible#), but does not involve any actual blocking.@@ -219,7 +219,7 @@ -- When called outside 'mask', or inside 'uninterruptibleMask', this -- function has no effect. ----- /Since: 4.4.0.0/+-- @since 4.4.0.0 allowInterrupt :: IO () allowInterrupt = unsafeUnmask $ return () @@ -259,7 +259,7 @@ >           catch (restore (...)) >                 (\e -> handler) -If you need to unblock asynchronous exceptions again in the exception+If you need to unmask asynchronous exceptions again in the exception handler, 'restore' can be used there too.  Note that 'try' and friends /do not/ have a similar default, because

@@ -1,13 +1,13 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, MagicHash #-}-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}  ----------------------------------------------------------------------------- -- | -- Module      :  Control.Exception.Base -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  experimental -- Portability :  non-portable (extended exceptions)@@ -31,6 +31,7 @@         NestedAtomically(..),         BlockedIndefinitelyOnMVar(..),         BlockedIndefinitelyOnSTM(..),+        AllocationLimitExceeded(..),         Deadlock(..),         NoMethodError(..),         PatternMatchFail(..),@@ -105,7 +106,6 @@  import Data.Dynamic import Data.Either-import Data.Maybe  ----------------------------------------------------------------------------- -- Catching exceptions@@ -388,7 +388,7 @@         :: Addr# -> a   -- All take a UTF8-encoded C string  recSelError              s = throw (RecSelError ("No match in record selector "-			                         ++ unpackCStringUtf8# s))  -- No location info unfortunately+                                                 ++ unpackCStringUtf8# s))  -- No location info unfortunately runtimeError             s = error (unpackCStringUtf8# s)                   -- No location info unfortunately absentError              s = error ("Oops!  Entered absent arg " ++ unpackCStringUtf8# s) 

@@ -6,7 +6,7 @@ -- Module      :  Control.Monad -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  provisional -- Portability :  portable@@ -20,11 +20,7 @@        Functor(fmap)     , Monad((>>=), (>>), return, fail)--    , MonadPlus (-          mzero-        , mplus-        )+    , MonadPlus(mzero, mplus)     -- * Functions      -- ** Naming conventions@@ -74,104 +70,37 @@      , ap -    ) where--import Data.Maybe--import GHC.List-import GHC.Base--infixr 1 =<<---- -------------------------------------------------------------------------------- Prelude monad functions---- | Same as '>>=', but with the arguments interchanged.-{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-}-(=<<)           :: Monad m => (a -> m b) -> m a -> m b-f =<< x         = x >>= f---- | Evaluate each action in the sequence from left to right,--- and collect the results.-sequence       :: Monad m => [m a] -> m [a] -{-# INLINE sequence #-}-sequence ms = foldr k (return []) ms-            where-              k m m' = do { x <- m; xs <- m'; return (x:xs) }---- | Evaluate each action in the sequence from left to right,--- and ignore the results.-sequence_        :: Monad m => [m a] -> m () -{-# INLINE sequence_ #-}-sequence_ ms     =  foldr (>>) (return ()) ms---- | @'mapM' f@ is equivalent to @'sequence' . 'map' f@.-mapM            :: Monad m => (a -> m b) -> [a] -> m [b]-{-# INLINE mapM #-}-mapM f as       =  sequence (map f as)---- | @'mapM_' f@ is equivalent to @'sequence_' . 'map' f@.-mapM_           :: Monad m => (a -> m b) -> [a] -> m ()-{-# INLINE mapM_ #-}-mapM_ f as      =  sequence_ (map f as)---- -------------------------------------------------------------------------------- The MonadPlus class definition---- | Monads that also support choice and failure.-class Monad m => MonadPlus m where-   -- | the identity of 'mplus'.  It should also satisfy the equations-   ---   -- > mzero >>= f  =  mzero-   -- > v >> mzero   =  mzero-   ---   mzero :: m a -   -- | an associative operation-   mplus :: m a -> m a -> m a+    -- ** Strict monadic functions -instance MonadPlus [] where-   mzero = []-   mplus = (++)+    , (<$!>)+    ) where -instance MonadPlus Maybe where-   mzero = Nothing+import Data.Foldable ( Foldable, sequence_, msum, mapM_, foldlM, forM_ )+import Data.Functor ( void )+import Data.Traversable ( forM, mapM, sequence ) -   Nothing `mplus` ys  = ys-   xs      `mplus` _ys = xs+import GHC.Base hiding ( mapM, sequence )+import GHC.List ( zipWith, unzip, replicate )  -- ----------------------------------------------------------------------------- -- Functions mandated by the Prelude --- | @'guard' b@ is @'return' ()@ if @b@ is 'True',--- and 'mzero' if @b@ is 'False'.-guard           :: (MonadPlus m) => Bool -> m ()-guard True      =  return ()-guard False     =  mzero+-- | @'guard' b@ is @'pure' ()@ if @b@ is 'True',+-- and 'empty' if @b@ is 'False'.+guard           :: (Alternative f) => Bool -> f ()+guard True      =  pure ()+guard False     =  empty  -- | This generalizes the list-based 'filter' function. +{-# INLINE filterM #-} filterM          :: (Monad m) => (a -> m Bool) -> [a] -> m [a]-filterM _ []     =  return []-filterM p (x:xs) =  do-   flg <- p x-   ys  <- filterM p xs-   return (if flg then x:ys else ys)---- | 'forM' is 'mapM' with its arguments flipped-forM            :: Monad m => [a] -> (a -> m b) -> m [b]-{-# INLINE forM #-}-forM            = flip mapM---- | 'forM_' is 'mapM_' with its arguments flipped-forM_           :: Monad m => [a] -> (a -> m b) -> m ()-{-# INLINE forM_ #-}-forM_           = flip mapM_---- | This generalizes the list-based 'concat' function.--msum        :: MonadPlus m => [m a] -> m a-{-# INLINE msum #-}-msum        =  foldr mplus mzero+filterM p        = foldr go (return [])+  where+    go x r = do+      flg <- p x+      ys <- r+      return (if flg then x:ys else ys)  infixr 1 <=<, >=> @@ -190,31 +119,24 @@ -- Use explicit sharing here, as it is prevents a space leak regardless of -- optimizations. --- | @'void' value@ discards or ignores the result of evaluation, such as the return value of an 'IO' action.-void :: Functor f => f a -> f ()-void = fmap (const ())- -- ----------------------------------------------------------------------------- -- Other monad functions --- | The 'join' function is the conventional monad join operator. It is used to--- remove one level of monadic structure, projecting its bound argument into the--- outer level.-join              :: (Monad m) => m (m a) -> m a-join x            =  x >>= id- -- | The 'mapAndUnzipM' function maps its first argument over a list, returning -- the result as a pair of lists. This function is mainly used with complicated -- data structures or a state-transforming monad. mapAndUnzipM      :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])+{-# INLINE mapAndUnzipM #-} mapAndUnzipM f xs =  sequence (map f xs) >>= return . unzip  -- | The 'zipWithM' function generalizes 'zipWith' to arbitrary monads. zipWithM          :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]+{-# INLINE zipWithM #-} zipWithM f xs ys  =  sequence (zipWith f xs ys)  -- | 'zipWithM_' is the extension of 'zipWithM' which ignores the final result. zipWithM_         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()+{-# INLINE zipWithM_ #-} zipWithM_ f xs ys =  sequence_ (zipWith f xs ys)  {- | The 'foldM' function is analogous to 'foldl', except that its result is@@ -225,7 +147,7 @@  >       foldM f a1 [x1, x2, ..., xm] -==  +==  >       do >         a2 <- f a1 x1@@ -234,82 +156,56 @@ >         f am xm  If right-to-left evaluation is required, the input list should be reversed.++Note: 'foldM' is the same as 'foldlM' -} -foldM             :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a-foldM _ a []      =  return a-foldM f a (x:xs)  =  f a x >>= \fax -> foldM f fax xs+foldM          :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b+{-# INLINEABLE foldM #-}+{-# SPECIALISE foldM :: (a -> b -> IO a) -> a -> [b] -> IO a #-}+{-# SPECIALISE foldM :: (a -> b -> Maybe a) -> a -> [b] -> Maybe a #-}+foldM          = foldlM  -- | Like 'foldM', but discards the result.-foldM_            :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()-foldM_ f a xs     = foldM f a xs >> return ()+foldM_         :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m ()+{-# INLINEABLE foldM_ #-}+{-# SPECIALISE foldM_ :: (a -> b -> IO a) -> a -> [b] -> IO () #-}+{-# SPECIALISE foldM_ :: (a -> b -> Maybe a) -> a -> [b] -> Maybe () #-}+foldM_ f a xs  = foldlM f a xs >> return ()  -- | @'replicateM' n act@ performs the action @n@ times, -- gathering the results. replicateM        :: (Monad m) => Int -> m a -> m [a]+{-# INLINEABLE replicateM #-}+{-# SPECIALISE replicateM :: Int -> IO a -> IO [a] #-}+{-# SPECIALISE replicateM :: Int -> Maybe a -> Maybe [a] #-} replicateM n x    = sequence (replicate n x)  -- | Like 'replicateM', but discards the result. replicateM_       :: (Monad m) => Int -> m a -> m ()+{-# INLINEABLE replicateM_ #-}+{-# SPECIALISE replicateM_ :: Int -> IO a -> IO () #-}+{-# SPECIALISE replicateM_ :: Int -> Maybe a -> Maybe () #-} replicateM_ n x   = sequence_ (replicate n x) -{- | Conditional execution of monadic expressions. For example, -->       when debug (putStr "Debugging\n")--will output the string @Debugging\\n@ if the Boolean value @debug@ is 'True',-and otherwise do nothing.--}--when              :: (Monad m) => Bool -> m () -> m ()-when p s          =  if p then s else return ()- -- | The reverse of 'when'.--unless            :: (Monad m) => Bool -> m () -> m ()-unless p s        =  if p then return () else s+unless            :: (Applicative f) => Bool -> f () -> f ()+{-# INLINEABLE unless #-}+{-# SPECIALISE unless :: Bool -> IO () -> IO () #-}+{-# SPECIALISE unless :: Bool -> Maybe () -> Maybe () #-}+unless p s        =  if p then pure () else s --- | Promote a function to a monad.-liftM   :: (Monad m) => (a1 -> r) -> m a1 -> m r-liftM f m1              = do { x1 <- m1; return (f x1) }+infixl 4 <$!> --- | Promote a function to a monad, scanning the monadic arguments from--- left to right.  For example,------ >    liftM2 (+) [0,1] [0,2] = [0,2,1,3]--- >    liftM2 (+) (Just 1) Nothing = Nothing+-- | Strict version of 'Data.Functor.<$>'. ---liftM2  :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r-liftM2 f m1 m2          = do { x1 <- m1; x2 <- m2; return (f x1 x2) }---- | Promote a function to a monad, scanning the monadic arguments from--- left to right (cf. 'liftM2').-liftM3  :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r-liftM3 f m1 m2 m3       = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) }---- | Promote a function to a monad, scanning the monadic arguments from--- left to right (cf. 'liftM2').-liftM4  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r-liftM4 f m1 m2 m3 m4    = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) }---- | Promote a function to a monad, scanning the monadic arguments from--- left to right (cf. 'liftM2').-liftM5  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r-liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) }--{- | In many situations, the 'liftM' operations can be replaced by uses of-'ap', which promotes function application. -->       return f `ap` x1 `ap` ... `ap` xn--is equivalent to -->       liftMn f x1 x2 ... xn---}--ap                :: (Monad m) => m (a -> b) -> m a -> m b-ap                =  liftM2 id+-- @since 4.8.0.0+(<$!>) :: Monad m => (a -> b) -> m a -> m b+{-# INLINE (<$!>) #-}+f <$!> m = do+  x <- m+  let z = f x+  z `seq` return z   -- -----------------------------------------------------------------------------@@ -322,29 +218,30 @@ -- @mfilter odd (Just 2) == Nothing@  mfilter :: (MonadPlus m) => (a -> Bool) -> m a -> m a+{-# INLINEABLE mfilter #-} mfilter p ma = do   a <- ma   if p a then return a else mzero  {- $naming -The functions in this library use the following naming conventions: +The functions in this library use the following naming conventions:  * A postfix \'@M@\' always stands for a function in the Kleisli category:   The monad type constructor @m@ is added to function results-  (modulo currying) and nowhere else.  So, for example, +  (modulo currying) and nowhere else.  So, for example,  >  filter  ::              (a ->   Bool) -> [a] ->   [a] >  filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]  * A postfix \'@_@\' changes the result type from @(m a)@ to @(m ())@.-  Thus, for example: +  Thus, for example: ->  sequence  :: Monad m => [m a] -> m [a] ->  sequence_ :: Monad m => [m a] -> m () +>  sequence  :: Monad m => [m a] -> m [a]+>  sequence_ :: Monad m => [m a] -> m ()  * A prefix \'@m@\' generalizes an existing function to a monadic form.-  Thus, for example: +  Thus, for example:  >  sum  :: Num a       => [a]   -> a >  msum :: MonadPlus m => [m a] -> m a

@@ -1,4 +1,5 @@ {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}  ----------------------------------------------------------------------------- -- |@@ -22,10 +23,13 @@         fix   ) where -import Prelude-import System.IO-import Data.Function (fix)+import Data.Either+import Data.Function ( fix )+import Data.Maybe+import GHC.Base ( Monad, error, (.) )+import GHC.List ( head, tail ) import GHC.ST+import System.IO  -- | Monads having fixed points with a \'knot-tying\' semantics. -- Instances of 'MonadFix' should satisfy the following laws:@@ -65,7 +69,7 @@                (x:_) -> x : mfix (tail . f)  instance MonadFix IO where-    mfix = fixIO +    mfix = fixIO  instance MonadFix ((->) r) where     mfix f = \ r -> let a = f a r in a

@@ -17,5 +17,3 @@  module Control.Monad.Instances {-# DEPRECATED "This module now contains no instances and will be removed in the future" #-} -- deprecated in 7.8     (Functor(..),Monad(..)) where--import Prelude

@@ -1,4 +1,4 @@-{-# LANGUAGE Unsafe #-}+{-# LANGUAGE Trustworthy #-}  ----------------------------------------------------------------------------- -- |@@ -31,5 +31,5 @@         stToIO,     ) where -import Control.Monad.ST.Safe+import Control.Monad.ST.Imp 

@@ -1,4 +1,4 @@-{-# LANGUAGE Unsafe #-}+{-# LANGUAGE Trustworthy #-}  ----------------------------------------------------------------------------- -- |@@ -30,5 +30,5 @@         stToIO,     ) where -import Control.Monad.ST.Lazy.Safe+import Control.Monad.ST.Lazy.Imp 

@@ -36,11 +36,9 @@         unsafeIOToST     ) where -import Prelude- import Control.Monad.Fix -import qualified Control.Monad.ST.Safe as ST+import qualified Control.Monad.ST as ST import qualified Control.Monad.ST.Unsafe as ST  import qualified GHC.ST as GHC.ST@@ -66,11 +64,15 @@  instance Functor (ST s) where     fmap f m = ST $ \ s ->-      let +      let        ST m_a = m        (r,new_s) = m_a s       in       (f r,new_s)++instance Applicative (ST s) where+    pure = return+    (<*>) = ap  instance Monad (ST s) where 

@@ -18,7 +18,7 @@ -- ----------------------------------------------------------------------------- -module Control.Monad.ST.Lazy.Safe (+module Control.Monad.ST.Lazy.Safe {-# DEPRECATED "Safe is now the default, please use Control.Monad.ST.Lazy instead" #-} (         -- * The 'ST' monad         ST,         runST,

@@ -18,7 +18,7 @@ -- ----------------------------------------------------------------------------- -module Control.Monad.ST.Safe (+module Control.Monad.ST.Safe {-# DEPRECATED "Safe is now the default, please use Control.Monad.ST instead" #-} (         -- * The 'ST' Monad         ST,             -- abstract         runST,

@@ -1,3 +1,5 @@+{-# LANGUAGE Safe #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Monad.ST.Strict

@@ -17,7 +17,6 @@  module Control.Monad.Zip where -import Prelude import Control.Monad (liftM)  -- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith`@@ -35,6 +34,7 @@ --   > munzip (mzip ma mb) = (ma, mb) -- class Monad m => MonadZip m where+    {-# MINIMAL mzip | mzipWith #-}      mzip :: m a -> m b -> m (a,b)     mzip = mzipWith (,)@@ -47,7 +47,6 @@     -- munzip is a member of the class because sometimes     -- you can implement it more efficiently than the     -- above default code.  See Trac #4370 comment by giorgidze-    {-# MINIMAL mzip | mzipWith #-}  instance MonadZip [] where     mzip     = zip

@@ -0,0 +1,101 @@+{-# LANGUAGE Safe #-}+{-# LANGUAGE CPP #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Bifunctor+-- Copyright   :  (C) 2008-2014 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- @since 4.8.0.0+----------------------------------------------------------------------------+module Data.Bifunctor+  ( Bifunctor(..)+  ) where++import Control.Applicative  ( Const(..) )++-- | Formally, the class 'Bifunctor' represents a bifunctor+-- from @Hask@ -> @Hask@.+--+-- Intuitively it is a bifunctor where both the first and second+-- arguments are covariant.+--+-- You can define a 'Bifunctor' by either defining 'bimap' or by+-- defining both 'first' and 'second'.+--+-- If you supply 'bimap', you should ensure that:+--+-- @'bimap' 'id' 'id' ≡ 'id'@+--+-- If you supply 'first' and 'second', ensure:+--+-- @+-- 'first' 'id' ≡ 'id'+-- 'second' 'id' ≡ 'id'+-- @+--+-- If you supply both, you should also ensure:+--+-- @'bimap' f g ≡ 'first' f '.' 'second' g@+--+-- These ensure by parametricity:+--+-- @+-- 'bimap'  (f '.' g) (h '.' i) ≡ 'bimap' f h '.' 'bimap' g i+-- 'first'  (f '.' g) ≡ 'first'  f '.' 'first'  g+-- 'second' (f '.' g) ≡ 'second' f '.' 'second' g+-- @+--+-- @since 4.8.0.0+class Bifunctor p where+    {-# MINIMAL bimap | first, second #-}++    -- | Map over both arguments at the same time.+    --+    -- @'bimap' f g ≡ 'first' f '.' 'second' g@+    bimap :: (a -> b) -> (c -> d) -> p a c -> p b d+    bimap f g = first f . second g++    -- | Map covariantly over the first argument.+    --+    -- @'first' f ≡ 'bimap' f 'id'@+    first :: (a -> b) -> p a c -> p b c+    first f = bimap f id++    -- | Map covariantly over the second argument.+    --+    -- @'second' ≡ 'bimap' 'id'@+    second :: (b -> c) -> p a b -> p a c+    second = bimap id+++instance Bifunctor (,) where+    bimap f g ~(a, b) = (f a, g b)++instance Bifunctor ((,,) x1) where+    bimap f g ~(x1, a, b) = (x1, f a, g b)++instance Bifunctor ((,,,) x1 x2) where+    bimap f g ~(x1, x2, a, b) = (x1, x2, f a, g b)++instance Bifunctor ((,,,,) x1 x2 x3) where+    bimap f g ~(x1, x2, x3, a, b) = (x1, x2, x3, f a, g b)++instance Bifunctor ((,,,,,) x1 x2 x3 x4) where+    bimap f g ~(x1, x2, x3, x4, a, b) = (x1, x2, x3, x4, f a, g b)++instance Bifunctor ((,,,,,,) x1 x2 x3 x4 x5) where+    bimap f g ~(x1, x2, x3, x4, x5, a, b) = (x1, x2, x3, x4, x5, f a, g b)+++instance Bifunctor Either where+    bimap f _ (Left a) = Left (f a)+    bimap _ g (Right b) = Right (g b)++instance Bifunctor Const where+    bimap f _ (Const a) = Const (f a)

@@ -39,11 +39,16 @@     rotateL, rotateR,     popCount   ),-  FiniteBits(finiteBitSize),+  FiniteBits(+    finiteBitSize,+    countLeadingZeros,+    countTrailingZeros+  ),    bitDefault,   testBitDefault,-  popCountDefault+  popCountDefault,+  toIntegralSized  ) where  -- Defines the @Bits@ class containing bit-based operations.@@ -52,11 +57,20 @@  #include "MachDeps.h" +#ifdef MIN_VERSION_integer_gmp+# define HAVE_INTEGER_GMP1 MIN_VERSION_integer_gmp(1,0,0)+#endif+ import Data.Maybe import GHC.Enum import GHC.Num import GHC.Base+import GHC.Real +#if HAVE_INTEGER_GMP1+import GHC.Integer.GMP.Internals (bitInteger, popCountInteger)+#endif+ infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR` infixl 7 .&. infixl 6 `xor`@@ -64,19 +78,16 @@  {-# DEPRECATED bitSize "Use 'bitSizeMaybe' or 'finiteBitSize' instead" #-} -- deprecated in 7.8 -{-|-The 'Bits' class defines bitwise operations over integral types.--* Bits are numbered from 0 with bit 0 being the least-  significant bit.--Minimal complete definition: '.&.', '.|.', 'xor', 'complement',-('shift' or ('shiftL' and 'shiftR')), ('rotate' or ('rotateL' and 'rotateR')),-'bitSize', 'isSigned', 'testBit', 'bit', and 'popCount'.  The latter three can-be implemented using `testBitDefault', 'bitDefault', and 'popCountDefault', if-@a@ is also an instance of 'Num'.--}+-- | The 'Bits' class defines bitwise operations over integral types.+--+-- * Bits are numbered from 0 with bit 0 being the least+--   significant bit. class Eq a => Bits a where+    {-# MINIMAL (.&.), (.|.), xor, complement,+                (shift | (shiftL, shiftR)),+                (rotate | (rotateL, rotateR)),+                bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-}+     -- | Bitwise \"and\"     (.&.) :: a -> a -> a @@ -145,12 +156,15 @@     -- implementation (which ought to be equivalent to 'zeroBits' for     -- types which possess a 0th bit).     ---    -- /Since: 4.7.0.0/+    -- @since 4.7.0.0     zeroBits :: a     zeroBits = clearBit (bit 0) 0      -- | @bit /i/@ is a value with the @/i/@th bit set and all other bits clear.     --+    -- Can be implemented using `bitDefault' if @a@ is also an+    -- instance of 'Num'.+    --     -- See also 'zeroBits'.     bit               :: Int -> a @@ -164,13 +178,16 @@     complementBit     :: a -> Int -> a      -- | Return 'True' if the @n@th bit of the argument is 1+    --+    -- Can be implemented using `testBitDefault' if @a@ is also an+    -- instance of 'Num'.     testBit           :: a -> Int -> Bool      {-| Return the number of bits in the type of the argument.  The actual         value of the argument is ignored.  Returns Nothing         for types that do not have a fixed bitsize, like 'Integer'. -        /Since: 4.7.0.0/+        @since 4.7.0.0         -}     bitSizeMaybe      :: a -> Maybe Int @@ -207,7 +224,7 @@          Defaults to 'shiftL' unless defined explicitly by an instance. -        /Since: 4.5.0.0/ -}+        @since 4.5.0.0 -}     unsafeShiftL            :: a -> Int -> a     {-# INLINE unsafeShiftL #-}     x `unsafeShiftL` i = x `shiftL` i@@ -236,7 +253,7 @@          Defaults to 'shiftR' unless defined explicitly by an instance. -        /Since: 4.5.0.0/ -}+        @since 4.5.0.0 -}     unsafeShiftR            :: a -> Int -> a     {-# INLINE unsafeShiftR #-}     x `unsafeShiftR` i = x `shiftR` i@@ -264,17 +281,15 @@     {-| Return the number of set bits in the argument.  This number is         known as the population count or the Hamming weight. -        /Since: 4.5.0.0/ -}-    popCount          :: a -> Int+        Can be implemented using `popCountDefault' if @a@ is also an+        instance of 'Num'. -    {-# MINIMAL (.&.), (.|.), xor, complement,-                (shift | (shiftL, shiftR)),-                (rotate | (rotateL, rotateR)),-                bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-}+        @since 4.5.0.0 -}+    popCount          :: a -> Int  -- |The 'FiniteBits' class denotes types with a finite, fixed number of bits. ----- /Since: 4.7.0.0/+-- @since 4.7.0.0 class Bits b => FiniteBits b where     -- | Return the number of bits in the type of the argument.     -- The actual value of the argument is ignored. Moreover, 'finiteBitSize'@@ -285,9 +300,67 @@     -- 'bitSizeMaybe' = 'Just' . 'finiteBitSize'     -- @     ---    -- /Since: 4.7.0.0/+    -- @since 4.7.0.0     finiteBitSize :: b -> Int +    -- | Count number of zero bits preceding the most significant set bit.+    --+    -- @+    -- 'countLeadingZeros' ('zeroBits' :: a) = finiteBitSize ('zeroBits' :: a)+    -- @+    --+    -- 'countLeadingZeros' can be used to compute log base 2 via+    --+    -- @+    -- logBase2 x = 'finiteBitSize' x - 1 - 'countLeadingZeros' x+    -- @+    --+    -- Note: The default implementation for this method is intentionally+    -- naive. However, the instances provided for the primitive+    -- integral types are implemented using CPU specific machine+    -- instructions.+    --+    -- @since 4.8.0.0+    countLeadingZeros :: b -> Int+    countLeadingZeros x = (w-1) - go (w-1)+      where+        go i | i < 0       = i -- no bit set+             | testBit x i = i+             | otherwise   = go (i-1)++        w = finiteBitSize x++    -- | Count number of zero bits following the least significant set bit.+    --+    -- @+    -- 'countTrailingZeros' ('zeroBits' :: a) = finiteBitSize ('zeroBits' :: a)+    -- 'countTrailingZeros' . 'negate' = 'countTrailingZeros'+    -- @+    --+    -- The related+    -- <http://en.wikipedia.org/wiki/Find_first_set find-first-set operation>+    -- can be expressed in terms of 'countTrailingZeros' as follows+    --+    -- @+    -- findFirstSet x = 1 + 'countTrailingZeros' x+    -- @+    --+    -- Note: The default implementation for this method is intentionally+    -- naive. However, the instances provided for the primitive+    -- integral types are implemented using CPU specific machine+    -- instructions.+    --+    -- @since 4.8.0.0+    countTrailingZeros :: b -> Int+    countTrailingZeros x = go 0+      where+        go i | i >= w      = i+             | testBit x i = i+             | otherwise   = go (i+1)++        w = finiteBitSize x++ -- The defaults below are written with lambdas so that e.g. --     bit = bitDefault -- is fully applied, so inlining will happen@@ -296,7 +369,7 @@ -- -- Note that: @bitDefault i = 1 `shiftL` i@ ----- /Since: 4.6.0.0/+-- @since 4.6.0.0 bitDefault :: (Bits a, Num a) => Int -> a bitDefault = \i -> 1 `shiftL` i {-# INLINE bitDefault #-}@@ -305,7 +378,7 @@ -- -- Note that: @testBitDefault x i = (x .&. bit i) /= 0@ ----- /Since: 4.6.0.0/+-- @since 4.6.0.0 testBitDefault ::  (Bits a, Num a) => a -> Int -> Bool testBitDefault = \x i -> (x .&. bit i) /= 0 {-# INLINE testBitDefault #-}@@ -315,7 +388,7 @@ -- This implementation is intentionally naive. Instances are expected to provide -- an optimized implementation for their size. ----- /Since: 4.6.0.0/+-- @since 4.6.0.0 popCountDefault :: (Bits a, Num a) => a -> Int popCountDefault = go 0  where@@ -324,7 +397,7 @@ {-# INLINABLE popCountDefault #-}  --- Interpret 'Bool' as 1-bit bit-field; /Since: 4.7.0.0/+-- Interpret 'Bool' as 1-bit bit-field; @since 4.7.0.0 instance Bits Bool where     (.&.) = (&&) @@ -356,7 +429,8 @@  instance FiniteBits Bool where     finiteBitSize _ = 1-+    countTrailingZeros x = if x then 0 else 1+    countLeadingZeros  x = if x then 0 else 1  instance Bits Int where     {-# INLINE shift #-}@@ -381,7 +455,7 @@     (I# x#) `shiftR` (I# i#)       = I# (x# `iShiftRA#` i#)     (I# x#) `unsafeShiftR` (I# i#) = I# (x# `uncheckedIShiftRA#` i#) -    {-# INLINE rotate #-} 	-- See Note [Constant folding for rotate]+    {-# INLINE rotate #-}       -- See Note [Constant folding for rotate]     (I# x#) `rotate` (I# i#) =         I# ((x# `uncheckedIShiftL#` i'#) `orI#` (x# `uncheckedIShiftRL#` (wsib -# i'#)))       where@@ -396,6 +470,8 @@  instance FiniteBits Int where     finiteBitSize _ = WORD_SIZE_IN_BITS+    countLeadingZeros  (I# x#) = I# (word2Int# (clz# (int2Word# x#)))+    countTrailingZeros (I# x#) = I# (word2Int# (ctz# (int2Word# x#)))  instance Bits Word where     {-# INLINE shift #-}@@ -429,6 +505,8 @@  instance FiniteBits Word where     finiteBitSize _ = WORD_SIZE_IN_BITS+    countLeadingZeros  (W# x#) = I# (word2Int# (clz# x#))+    countTrailingZeros (W# x#) = I# (word2Int# (ctz# x#))  instance Bits Integer where    (.&.) = andInteger@@ -437,11 +515,20 @@    complement = complementInteger    shift x i@(I# i#) | i >= 0    = shiftLInteger x i#                      | otherwise = shiftRInteger x (negateInt# i#)+   shiftL x (I# i#) = shiftLInteger x i#+   shiftR x (I# i#) = shiftRInteger x i#+    testBit x (I# i) = testBitInteger x i     zeroBits   = 0++#if HAVE_INTEGER_GMP1+   bit (I# i#) = bitInteger i#+   popCount x  = I# (popCountInteger x)+#else    bit        = bitDefault    popCount   = popCountDefault+#endif     rotate x i = shift x i   -- since an Integer never wraps around @@ -449,8 +536,84 @@    bitSize _  = error "Data.Bits.bitSize(Integer)"    isSigned _ = True -{- 	Note [Constant folding for rotate]-	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-----------------------------------------------------------------------------++-- | Attempt to convert an 'Integral' type @a@ to an 'Integral' type @b@ using+-- the size of the types as measured by 'Bits' methods.+--+-- A simpler version of this function is:+--+-- > toIntegral :: (Integral a, Integral b) => a -> Maybe b+-- > toIntegral x+-- >   | toInteger x == y = Just (fromInteger y)+-- >   | otherwise        = Nothing+-- >   where+-- >     y = toInteger x+--+-- This version requires going through 'Integer', which can be inefficient.+-- However, @toIntegralSized@ is optimized to allow GHC to statically determine+-- the relative type sizes (as measured by 'bitSizeMaybe' and 'isSigned') and+-- avoid going through 'Integer' for many types. (The implementation uses+-- 'fromIntegral', which is itself optimized with rules for @base@ types but may+-- go through 'Integer' for some type pairs.)+--+-- @since 4.8.0.0++toIntegralSized :: (Integral a, Integral b, Bits a, Bits b) => a -> Maybe b+toIntegralSized x                 -- See Note [toIntegralSized optimization]+  | maybe True (<= x) yMinBound+  , maybe True (x <=) yMaxBound = Just y+  | otherwise                   = Nothing+  where+    y = fromIntegral x++    xWidth = bitSizeMaybe x+    yWidth = bitSizeMaybe y++    yMinBound+      | isBitSubType x y = Nothing+      | isSigned x, not (isSigned y) = Just 0+      | isSigned x, isSigned y+      , Just yW <- yWidth = Just (negate $ bit (yW-1)) -- Assumes sub-type+      | otherwise = Nothing++    yMaxBound+      | isBitSubType x y = Nothing+      | isSigned x, not (isSigned y)+      , Just xW <- xWidth, Just yW <- yWidth+      , xW <= yW+1 = Nothing -- Max bound beyond a's domain+      | Just yW <- yWidth = if isSigned y+                            then Just (bit (yW-1)-1)+                            else Just (bit yW-1)+      | otherwise = Nothing+{-# INLINEABLE toIntegralSized #-}++-- | 'True' if the size of @a@ is @<=@ the size of @b@, where size is measured+-- by 'bitSizeMaybe' and 'isSigned'.+isBitSubType :: (Bits a, Bits b) => a -> b -> Bool+isBitSubType x y+  -- Reflexive+  | xWidth == yWidth, xSigned == ySigned = True++  -- Every integer is a subset of 'Integer'+  | ySigned, Nothing == yWidth                  = True+  | not xSigned, not ySigned, Nothing == yWidth = True++  -- Sub-type relations between fixed-with types+  | xSigned == ySigned,   Just xW <- xWidth, Just yW <- yWidth = xW <= yW+  | not xSigned, ySigned, Just xW <- xWidth, Just yW <- yWidth = xW <  yW++  | otherwise = False+  where+    xWidth  = bitSizeMaybe x+    xSigned = isSigned     x++    yWidth  = bitSizeMaybe y+    ySigned = isSigned     y+{-# INLINE isBitSubType #-}++{-      Note [Constant folding for rotate]+        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The INLINE on the Int instance of rotate enables it to be constant folded.  For example:      sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)@@ -474,3 +637,27 @@          } -} +-- Note [toIntegralSized optimization]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- The code in 'toIntegralSized' relies on GHC optimizing away statically+-- decidable branches.+--+-- If both integral types are statically known, GHC will be able optimize the+-- code significantly (for @-O1@ and better).+--+-- For instance (as of GHC 7.8.1) the following definitions:+--+-- > w16_to_i32 = toIntegralSized :: Word16 -> Maybe Int32+-- >+-- > i16_to_w16 = toIntegralSized :: Int16 -> Maybe Word16+--+-- are translated into the following (simplified) /GHC Core/ language:+--+-- > w16_to_i32 = \x -> Just (case x of _ { W16# x# -> I32# (word2Int# x#) })+-- >+-- > i16_to_w16 = \x -> case eta of _+-- >   { I16# b1 -> case tagToEnum# (<=# 0 b1) of _+-- >       { False -> Nothing+-- >       ; True -> Just (W16# (narrow16Word# (int2Word# b1)))+-- >       }+-- >   }

@@ -6,7 +6,7 @@ -- Module      :  Data.Bool -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  experimental -- Portability :  portable@@ -18,7 +18,7 @@ module Data.Bool (    -- * Booleans    Bool(..),-   -- ** Operations +   -- ** Operations    (&&),    (||),    not,@@ -28,11 +28,34 @@  import GHC.Base --- | Case analysis for the 'Bool' type.--- @bool a b p@ evaluates to @a@ when @p@ is @False@, and evaluates to @b@--- when @p@ is @True@.+-- | Case analysis for the 'Bool' type. @'bool' x y p@ evaluates to @x@+-- when @p@ is 'False', and evaluates to @y@ when @p@ is 'True'. ----- /Since: 4.7.0.0/+-- This is equivalent to @if p then y else x@; that is, one can+-- think of it as an if-then-else construct with its arguments+-- reordered.+--+-- @since 4.7.0.0+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bool "foo" "bar" True+-- "bar"+-- >>> bool "foo" "bar" False+-- "foo"+--+-- Confirm that @'bool' x y p@ and @if p then y else x@ are+-- equivalent:+--+-- >>> let p = True; x = "bar"; y = "foo"+-- >>> bool x y p == if p then y else x+-- True+-- >>> let p = False+-- >>> bool x y p == if p then y else x+-- True+-- bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True  = t

@@ -62,20 +62,104 @@ import GHC.Num import GHC.Enum --- | Convert a single digit 'Char' to the corresponding 'Int'.  --- This function fails unless its argument satisfies 'isHexDigit',--- but recognises both upper and lower-case hexadecimal digits--- (i.e. @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@).+-- $setup+-- Allow the use of Prelude in doctests.+-- >>> import Prelude++-- | Convert a single digit 'Char' to the corresponding 'Int'.  This+-- function fails unless its argument satisfies 'isHexDigit', but+-- recognises both upper- and lower-case hexadecimal digits (that+-- is, @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@).+--+-- ==== __Examples__+--+-- Characters @\'0\'@ through @\'9\'@ are converted properly to+-- @0..9@:+--+-- >>> map digitToInt ['0'..'9']+-- [0,1,2,3,4,5,6,7,8,9]+--+-- Both upper- and lower-case @\'A\'@ through @\'F\'@ are converted+-- as well, to @10..15@.+--+-- >>> map digitToInt ['a'..'f']+-- [10,11,12,13,14,15]+-- >>> map digitToInt ['A'..'F']+-- [10,11,12,13,14,15]+--+-- Anything else throws an exception:+--+-- >>> digitToInt 'G'+-- *** Exception: Char.digitToInt: not a digit 'G'+-- >>> digitToInt '♥'+-- *** Exception: Char.digitToInt: not a digit '\9829'+-- digitToInt :: Char -> Int digitToInt c- | isDigit c            =  ord c - ord '0'- | c >= 'a' && c <= 'f' =  ord c - ord 'a' + 10- | c >= 'A' && c <= 'F' =  ord c - ord 'A' + 10- | otherwise            =  error ("Char.digitToInt: not a digit " ++ show c) -- sigh---- | Unicode General Categories (column 2 of the UnicodeData table)--- in the order they are listed in the Unicode standard.+  | (fromIntegral dec::Word) <= 9 = dec+  | (fromIntegral hexl::Word) <= 5 = hexl + 10+  | (fromIntegral hexu::Word) <= 5 = hexu + 10+  | otherwise = error ("Char.digitToInt: not a digit " ++ show c) -- sigh+  where+    dec = ord c - ord '0'+    hexl = ord c - ord 'a'+    hexu = ord c - ord 'A' +-- | Unicode General Categories (column 2 of the UnicodeData table) in+-- the order they are listed in the Unicode standard (the Unicode+-- Character Database, in particular).+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> :t OtherLetter+-- OtherLetter :: GeneralCategory+--+-- 'Eq' instance:+--+-- >>> UppercaseLetter == UppercaseLetter+-- True+-- >>> UppercaseLetter == LowercaseLetter+-- False+--+-- 'Ord' instance:+--+-- >>> NonSpacingMark <= MathSymbol+-- True+--+-- 'Enum' instance:+--+-- >>> enumFromTo ModifierLetter SpacingCombiningMark+-- [ModifierLetter,OtherLetter,NonSpacingMark,SpacingCombiningMark]+--+-- 'Read' instance:+--+-- >>> read "DashPunctuation" :: GeneralCategory+-- DashPunctuation+-- >>> read "17" :: GeneralCategory+-- *** Exception: Prelude.read: no parse+--+-- 'Show' instance:+--+-- >>> show EnclosingMark+-- "EnclosingMark"+--+-- 'Bounded' instance:+--+-- >>> minBound :: GeneralCategory+-- UppercaseLetter+-- >>> maxBound :: GeneralCategory+-- NotAssigned+--+-- 'Ix' instance:+--+--  >>> import Data.Ix ( index )+--  >>> index (OtherLetter,Control) FinalQuote+--  12+--  >>> index (OtherLetter,Control) Format+--  *** Exception: Error in array index+-- data GeneralCategory         = UppercaseLetter       -- ^ Lu: Letter, Uppercase         | LowercaseLetter       -- ^ Ll: Letter, Lowercase@@ -109,15 +193,79 @@         | NotAssigned           -- ^ Cn: Other, Not Assigned         deriving (Eq, Ord, Enum, Read, Show, Bounded, Ix) --- | The Unicode general category of the character.+-- | The Unicode general category of the character. This relies on the+-- 'Enum' instance of 'GeneralCategory', which must remain in the+-- same order as the categories are presented in the Unicode+-- standard.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> generalCategory 'a'+-- LowercaseLetter+-- >>> generalCategory 'A'+-- UppercaseLetter+-- >>> generalCategory '0'+-- DecimalNumber+-- >>> generalCategory '%'+-- OtherPunctuation+-- >>> generalCategory '♥'+-- OtherSymbol+-- >>> generalCategory '\31'+-- Control+-- >>> generalCategory ' '+-- Space+-- generalCategory :: Char -> GeneralCategory generalCategory c = toEnum $ fromIntegral $ wgencat $ fromIntegral $ ord c  -- derived character classifiers  -- | Selects alphabetic Unicode characters (lower-case, upper-case and--- title-case letters, plus letters of caseless scripts and modifiers letters).--- This function is equivalent to 'Data.Char.isAlpha'.+-- title-case letters, plus letters of caseless scripts and+-- modifiers letters). This function is equivalent to+-- 'Data.Char.isAlpha'.+--+-- This function returns 'True' if its argument has one of the+-- following 'GeneralCategory's, or 'False' otherwise:+--+-- * 'UppercaseLetter'+-- * 'LowercaseLetter'+-- * 'TitlecaseLetter'+-- * 'ModifierLetter'+-- * 'OtherLetter'+--+-- These classes are defined in the+-- <http://www.unicode.org/reports/tr44/tr44-14.html#GC_Values_Table Unicode Character Database>,+-- part of the Unicode standard. The same document defines what is+-- and is not a \"Letter\".+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> isLetter 'a'+-- True+-- >>> isLetter 'A'+-- True+-- >>> isLetter '0'+-- False+-- >>> isLetter '%'+-- False+-- >>> isLetter '♥'+-- False+-- >>> isLetter '\31'+-- False+--+-- Ensure that 'isLetter' and 'isAlpha' are equivalent.+--+-- >>> let chars = [(chr 0)..]+-- >>> let letters = map isLetter chars+-- >>> let alphas = map isAlpha chars+-- >>> letters == alphas+-- True+-- isLetter :: Char -> Bool isLetter c = case generalCategory c of         UppercaseLetter         -> True@@ -127,8 +275,41 @@         OtherLetter             -> True         _                       -> False --- | Selects Unicode mark characters, e.g. accents and the like, which--- combine with preceding letters.+-- | Selects Unicode mark characters, for example accents and the+-- like, which combine with preceding characters.+--+-- This function returns 'True' if its argument has one of the+-- following 'GeneralCategory's, or 'False' otherwise:+--+-- * 'NonSpacingMark'+-- * 'SpacingCombiningMark'+-- * 'EnclosingMark'+--+-- These classes are defined in the+-- <http://www.unicode.org/reports/tr44/tr44-14.html#GC_Values_Table Unicode Character Database>,+-- part of the Unicode standard. The same document defines what is+-- and is not a \"Mark\".+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> isMark 'a'+-- False+-- >>> isMark '0'+-- False+--+-- Combining marks such as accent characters usually need to follow+-- another character before they become printable:+--+-- >>> map isMark "ò"+-- [False,True]+--+-- Puns are not necessarily supported:+--+-- >>> isMark '✓'+-- False+-- isMark :: Char -> Bool isMark c = case generalCategory c of         NonSpacingMark          -> True@@ -137,7 +318,41 @@         _                       -> False  -- | Selects Unicode numeric characters, including digits from various--- scripts, Roman numerals, etc.+-- scripts, Roman numerals, et cetera.+--+-- This function returns 'True' if its argument has one of the+-- following 'GeneralCategory's, or 'False' otherwise:+--+-- * 'DecimalNumber'+-- * 'LetterNumber'+-- * 'OtherNumber'+--+-- These classes are defined in the+-- <http://www.unicode.org/reports/tr44/tr44-14.html#GC_Values_Table Unicode Character Database>,+-- part of the Unicode standard. The same document defines what is+-- and is not a \"Number\".+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> isNumber 'a'+-- False+-- >>> isNumber '%'+-- False+-- >>> isNumber '3'+-- True+--+-- ASCII @\'0\'@ through @\'9\'@ are all numbers:+--+-- >>> and $ map isNumber ['0'..'9']+-- True+--+-- Unicode Roman numerals are \"numbers\" as well:+--+-- >>> isNumber 'Ⅸ'+-- True+-- isNumber :: Char -> Bool isNumber c = case generalCategory c of         DecimalNumber           -> True@@ -147,6 +362,40 @@  -- | Selects Unicode punctuation characters, including various kinds -- of connectors, brackets and quotes.+--+-- This function returns 'True' if its argument has one of the+-- following 'GeneralCategory's, or 'False' otherwise:+--+-- * 'ConnectorPunctuation'+-- * 'DashPunctuation'+-- * 'OpenPunctuation'+-- * 'ClosePunctuation'+-- * 'InitialQuote'+-- * 'FinalQuote'+-- * 'OtherPunctuation'+--+-- These classes are defined in the+-- <http://www.unicode.org/reports/tr44/tr44-14.html#GC_Values_Table Unicode Character Database>,+-- part of the Unicode standard. The same document defines what is+-- and is not a \"Punctuation\".+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> isPunctuation 'a'+-- False+-- >>> isPunctuation '7'+-- False+-- >>> isPunctuation '♥'+-- False+-- >>> isPunctuation '"'+-- True+-- >>> isPunctuation '?'+-- True+-- >>> isPunctuation '—'+-- True+-- isPunctuation :: Char -> Bool isPunctuation c = case generalCategory c of         ConnectorPunctuation    -> True@@ -160,6 +409,39 @@  -- | Selects Unicode symbol characters, including mathematical and -- currency symbols.+--+-- This function returns 'True' if its argument has one of the+-- following 'GeneralCategory's, or 'False' otherwise:+--+-- * 'MathSymbol'+-- * 'CurrencySymbol'+-- * 'ModifierSymbol'+-- * 'OtherSymbol'+--+-- These classes are defined in the+-- <http://www.unicode.org/reports/tr44/tr44-14.html#GC_Values_Table Unicode Character Database>,+-- part of the Unicode standard. The same document defines what is+-- and is not a \"Symbol\".+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> isSymbol 'a'+-- False+-- >>> isSymbol '6'+-- False+-- >>> isSymbol '='+-- True+--+-- The definition of \"math symbol\" may be a little+-- counter-intuitive depending on one's background:+--+-- >>> isSymbol '+'+-- True+-- >>> isSymbol '-'+-- False+-- isSymbol :: Char -> Bool isSymbol c = case generalCategory c of         MathSymbol              -> True@@ -169,6 +451,43 @@         _                       -> False  -- | Selects Unicode space and separator characters.+--+-- This function returns 'True' if its argument has one of the+-- following 'GeneralCategory's, or 'False' otherwise:+--+-- * 'Space'+-- * 'LineSeparator'+-- * 'ParagraphSeparator'+--+-- These classes are defined in the+-- <http://www.unicode.org/reports/tr44/tr44-14.html#GC_Values_Table Unicode Character Database>,+-- part of the Unicode standard. The same document defines what is+-- and is not a \"Separator\".+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> isSeparator 'a'+-- False+-- >>> isSeparator '6'+-- False+-- >>> isSeparator ' '+-- True+--+-- Warning: newlines and tab characters are not considered+-- separators.+--+-- >>> isSeparator '\n'+-- False+-- >>> isSeparator '\t'+-- False+--+-- But some more exotic characters are (like HTML's @&nbsp;@):+--+-- >>> isSeparator '\160'+-- True+-- isSeparator :: Char -> Bool isSeparator c = case generalCategory c of         Space                   -> True

@@ -1,6 +1,5 @@ {-# LANGUAGE Unsafe #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE NoImplicitPrelude #-}  ----------------------------------------------------------------------------- -- |@@ -17,11 +16,15 @@ -- More in-depth information can be found on the -- <https://ghc.haskell.org/trac/ghc/wiki/Roles Roles wiki page> ----- /Since: 4.7.0.0/+-- @since 4.7.0.0 -----------------------------------------------------------------------------  module Data.Coerce         ( -- * Safe coercions           coerce, Coercible,         ) where-import GHC.Prim (coerce, Coercible)+import GHC.Prim (coerce)+import GHC.Types (Coercible)++import GHC.Base () -- for build ordering+

@@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE StandaloneDeriving #-}  -----------------------------------------------------------------------------@@ -7,7 +7,7 @@ -- Module      :  Data.Complex -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  provisional -- Portability :  portable@@ -34,10 +34,10 @@          )  where -import Prelude- import Data.Typeable import Data.Data (Data)+import Foreign (Storable, castPtr, peek, poke, pokeElemOff, peekElemOff, sizeOf,+                alignment)  infix  6  :+ @@ -58,27 +58,27 @@ -- Functions over Complex  -- | Extracts the real part of a complex number.-realPart :: (RealFloat a) => Complex a -> a+realPart :: Complex a -> a realPart (x :+ _) =  x  -- | Extracts the imaginary part of a complex number.-imagPart :: (RealFloat a) => Complex a -> a+imagPart :: Complex a -> a imagPart (_ :+ y) =  y  -- | The conjugate of a complex number. {-# SPECIALISE conjugate :: Complex Double -> Complex Double #-}-conjugate        :: (RealFloat a) => Complex a -> Complex a+conjugate        :: Num a => Complex a -> Complex a conjugate (x:+y) =  x :+ (-y)  -- | Form a complex number from polar components of magnitude and phase. {-# SPECIALISE mkPolar :: Double -> Double -> Complex Double #-}-mkPolar          :: (RealFloat a) => a -> a -> Complex a+mkPolar          :: Floating a => a -> a -> Complex a mkPolar r theta  =  r * cos theta :+ r * sin theta  -- | @'cis' t@ is a complex value with magnitude @1@ -- and phase @t@ (modulo @2*'pi'@). {-# SPECIALISE cis :: Double -> Complex Double #-}-cis              :: (RealFloat a) => a -> Complex a+cis              :: Floating a => a -> Complex a cis theta        =  cos theta :+ sin theta  -- | The function 'polar' takes a complex number and@@ -174,3 +174,15 @@     acosh z        =  log (z + (z+1) * sqrt ((z-1)/(z+1)))     atanh z        =  0.5 * log ((1.0+z) / (1.0-z)) +instance Storable a => Storable (Complex a) where+    sizeOf a       = 2 * sizeOf (realPart a)+    alignment a    = alignment (realPart a)+    peek p           = do+                        q <- return $ castPtr p+                        r <- peek q+                        i <- peekElemOff q 1+                        return (r :+ i)+    poke p (r :+ i)  = do+                        q <-return $  (castPtr p)+                        poke q r+                        pokeElemOff q 1 i

@@ -1,26 +1,26 @@-{-# LANGUAGE Trustworthy, FlexibleInstances #-}-{-# LANGUAGE RankNTypes, ScopedTypeVariables, PolyKinds #-}-{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable, TypeOperators,-             GADTs #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE RankNTypes, ScopedTypeVariables, PolyKinds, StandaloneDeriving,+             AutoDeriveTypeable, TypeOperators, GADTs, FlexibleInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}  ----------------------------------------------------------------------------- -- | -- Module      :  Data.Data -- Copyright   :  (c) The University of Glasgow, CWI 2001--2004 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  experimental -- Portability :  non-portable (local universal quantification) ----- \"Scrap your boilerplate\" --- Generic programming in Haskell.--- See <http://www.cs.vu.nl/boilerplate/>. This module provides--- the 'Data' class with its primitives for generic programming, along--- with instances for many datatypes. It corresponds to a merge between--- the previous "Data.Generics.Basics" and almost all of --- "Data.Generics.Instances". The instances that are not present--- in this module were moved to the @Data.Generics.Instances@ module--- in the @syb@ package.+-- \"Scrap your boilerplate\" --- Generic programming in Haskell.  See+-- <http://www.haskell.org/haskellwiki/Research_papers/Generics#Scrap_your_boilerplate.21>.+-- This module provides the 'Data' class with its primitives for+-- generic programming, along with instances for many datatypes. It+-- corresponds to a merge between the previous "Data.Generics.Basics"+-- and almost all of "Data.Generics.Instances". The instances that are+-- not present in this module were moved to the+-- @Data.Generics.Instances@ module in the @syb@ package. -- -- For more information, please visit the new -- SYB wiki: <http://www.cs.uu.nl/wiki/bin/view/GenericProgramming/SYB>.@@ -40,7 +40,7 @@                 dataTypeOf,                 dataCast1,      -- mediate types and unary type constructors                 dataCast2,      -- mediate types and binary type constructors-                -- Generic maps defined in terms of gfoldl +                -- Generic maps defined in terms of gfoldl                 gmapT,                 gmapQ,                 gmapQl,@@ -106,20 +106,25 @@  ------------------------------------------------------------------------------ -import Prelude -- necessary to get dependencies right--import Data.Typeable+import Data.Either+import Data.Eq import Data.Maybe+import Data.Ord+import Data.Typeable import Data.Version( Version(..) )-import Control.Monad+import GHC.Base+import GHC.List+import GHC.Num+import GHC.Read+import GHC.Show+import Text.Read( reads )  -- Imports for the instances import Data.Int              -- So we can give Data instance for Int8, ... import Data.Type.Coercion import Data.Word             -- So we can give Data instance for Word8, ...-import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio+import GHC.Real              -- So we can give Data instance for Ratio --import GHC.IOBase            -- So we can give Data instance for IO, Handle-import GHC.Prim import GHC.Ptr               -- So we can give Data instance for Ptr import GHC.ForeignPtr        -- So we can give Data instance for ForeignPtr --import GHC.Stable            -- So we can give Data instance for StablePtr@@ -323,7 +328,7 @@    -- | A generic query that processes the immediate subterms and returns a list   -- of results.  The list is given in the same order as originally specified-  -- in the declaratoin of the data constructors.+  -- in the declaration of the data constructors.   gmapQ :: (forall d. Data d => d -> u) -> a -> [u]   gmapQ f = gmapQr (:) [] f @@ -345,10 +350,10 @@   -- injection and projection using 'return' and '>>='.   gmapM :: forall m. Monad m => (forall d. Data d => d -> m d) -> a -> m a -  -- Use immediately the monad datatype constructor +  -- Use immediately the monad datatype constructor   -- to instantiate the type constructor c in the type of gfoldl,   -- so injection and projection is done by return and >>=.-  --  +  --   gmapM f = gfoldl k return     where       k :: Data d => m (d -> b) -> d -> m b@@ -385,8 +390,8 @@  {- -We use the same pairing trick as for gmapMp, -i.e., we use an extra Bool component to keep track of the +We use the same pairing trick as for gmapMp,+i.e., we use an extra Bool component to keep track of the fact whether an immediate subterm was processed successfully. However, we cut of mapping over subterms once a first subterm was transformed successfully.@@ -449,7 +454,7 @@  where   k :: forall b r. Data b => ID (b -> r) -> ID r   k c = ID (unID c f)- +   z :: forall r. r -> ID r   z = ID @@ -619,7 +624,7 @@   -- | Gets the field labels of a constructor.  The list of labels--- is returned in the same order as they were given in the original +-- is returned in the same order as they were given in the original -- constructor declaration. constrFields :: Constr -> [String] constrFields = confields@@ -634,7 +639,7 @@ ------------------------------------------------------------------------------ -- --      From strings to constr's and vice versa: all data types---      +-- ------------------------------------------------------------------------------  @@ -777,12 +782,12 @@  ------------------------------------------------------------------------------ -----      Non-representations for non-presentable types+--      Non-representations for non-representable types -- ------------------------------------------------------------------------------  --- | Constructs a non-representation for a non-presentable type+-- | Constructs a non-representation for a non-representable type mkNoRepType :: String -> DataType mkNoRepType str = DataType                         { tycon   = str@@ -1060,9 +1065,9 @@ ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]  instance (Data a, Integral a) => Data (Ratio a) where-  gfoldl k z (a :% b) = z (:%) `k` a `k` b+  gfoldl k z (a :% b) = z (%) `k` a `k` b   toConstr _ = ratioConstr-  gunfold k z c | constrIndex c == 1 = k (k (z (:%)))+  gunfold k z c | constrIndex c == 1 = k (k (z (%)))   gunfold _ _ _ = error "Data.Data.gunfold(Ratio)"   dataTypeOf _  = ratioDataType @@ -1313,7 +1318,7 @@   dataCast1 x  = gcast1 x  --------------------------------------------------------------------------------- The Data instance for Array preserves data abstraction at the cost of +-- The Data instance for Array preserves data abstraction at the cost of -- inefficiency. We omit reflection services for the sake of data abstraction. instance (Typeable a, Data a, Data b, Ix a) => Data (Array a b)  where

@@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}  ----------------------------------------------------------------------------- -- |

@@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-} {-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, TypeOperators, UndecidableInstances #-}  -----------------------------------------------------------------------------@@ -34,6 +34,10 @@ import Data.Typeable import Data.Type.Equality +-- $setup+-- Allow the use of some Prelude functions in doctests.+-- >>> import Prelude ( (+), (*), length, putStrLn )+ {- -- just for testing import Test.QuickCheck@@ -48,6 +52,75 @@ either correct or an error; by convention, the 'Left' constructor is used to hold an error value and the 'Right' constructor is used to hold a correct value (mnemonic: \"right\" also means \"correct\").++==== __Examples__++The type @'Either' 'String' 'Int'@ is the type of values which can be either+a 'String' or an 'Int'. The 'Left' constructor can be used only on+'String's, and the 'Right' constructor can be used only on 'Int's:++>>> let s = Left "foo" :: Either String Int+>>> s+Left "foo"+>>> let n = Right 3 :: Either String Int+>>> n+Right 3+>>> :type s+s :: Either String Int+>>> :type n+n :: Either String Int++The 'fmap' from our 'Functor' instance will ignore 'Left' values, but+will apply the supplied function to values contained in a 'Right':++>>> let s = Left "foo" :: Either String Int+>>> let n = Right 3 :: Either String Int+>>> fmap (*2) s+Left "foo"+>>> fmap (*2) n+Right 6++The 'Monad' instance for 'Either' allows us to chain together multiple+actions which may fail, and fail overall if any of the individual+steps failed. First we'll write a function that can either parse an+'Int' from a 'Char', or fail.++>>> import Data.Char ( digitToInt, isDigit )+>>> :{+    let parseEither :: Char -> Either String Int+        parseEither c+          | isDigit c = Right (digitToInt c)+          | otherwise = Left "parse error"+>>> :}++The following should work, since both @\'1\'@ and @\'2\'@ can be+parsed as 'Int's.++>>> :{+    let parseMultiple :: Either String Int+        parseMultiple = do+          x <- parseEither '1'+          y <- parseEither '2'+          return (x + y)+>>> :}++>>> parseMultiple+Right 3++But the following should fail overall, since the first operation where+we attempt to parse @\'m\'@ as an 'Int' will fail:++>>> :{+    let parseMultiple :: Either String Int+        parseMultiple = do+          x <- parseEither 'm'+          y <- parseEither '2'+          return (x + y)+>>> :}++>>> parseMultiple+Left "parse error"+ -} data  Either a b  =  Left a | Right b   deriving (Eq, Ord, Read, Show, Typeable)@@ -56,6 +129,11 @@     fmap _ (Left x) = Left x     fmap f (Right y) = Right (f y) +instance Applicative (Either e) where+    pure          = Right+    Left  e <*> _ = Left e+    Right f <*> r = fmap f r+ instance Monad (Either e) where     return = Right     Left  l >>= _ = Left l@@ -64,27 +142,74 @@ -- | Case analysis for the 'Either' type. -- If the value is @'Left' a@, apply the first function to @a@; -- if it is @'Right' b@, apply the second function to @b@.+--+-- ==== __Examples__+--+-- We create two values of type @'Either' 'String' 'Int'@, one using the+-- 'Left' constructor and another using the 'Right' constructor. Then+-- we apply \"either\" the 'length' function (if we have a 'String')+-- or the \"times-two\" function (if we have an 'Int'):+--+-- >>> let s = Left "foo" :: Either String Int+-- >>> let n = Right 3 :: Either String Int+-- >>> either length (*2) s+-- 3+-- >>> either length (*2) n+-- 6+-- either                  :: (a -> c) -> (b -> c) -> Either a b -> c either f _ (Left x)     =  f x either _ g (Right y)    =  g y --- | Extracts from a list of 'Either' all the 'Left' elements--- All the 'Left' elements are extracted in order. +-- | Extracts from a list of 'Either' all the 'Left' elements.+-- All the 'Left' elements are extracted in order.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> let list = [ Left "foo", Right 3, Left "bar", Right 7, Left "baz" ]+-- >>> lefts list+-- ["foo","bar","baz"]+-- lefts   :: [Either a b] -> [a] lefts x = [a | Left a <- x] --- | Extracts from a list of 'Either' all the 'Right' elements+-- | Extracts from a list of 'Either' all the 'Right' elements. -- All the 'Right' elements are extracted in order.-+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> let list = [ Left "foo", Right 3, Left "bar", Right 7, Left "baz" ]+-- >>> rights list+-- [3,7]+-- rights   :: [Either a b] -> [b] rights x = [a | Right a <- x] --- | Partitions a list of 'Either' into two lists+-- | Partitions a list of 'Either' into two lists. -- All the 'Left' elements are extracted, in order, to the first -- component of the output.  Similarly the 'Right' elements are extracted -- to the second component of the output.-+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> let list = [ Left "foo", Right 3, Left "bar", Right 7, Left "baz" ]+-- >>> partitionEithers list+-- (["foo","bar","baz"],[3,7])+--+-- The pair returned by @'partitionEithers' x@ should be the same+-- pair as @('lefts' x, 'rights' x)@:+--+-- >>> let list = [ Left "foo", Right 3, Left "bar", Right 7, Left "baz" ]+-- >>> partitionEithers list == (lefts list, rights list)+-- True+-- partitionEithers :: [Either a b] -> ([a],[b]) partitionEithers = foldr (either left right) ([],[])  where@@ -93,23 +218,72 @@  -- | Return `True` if the given value is a `Left`-value, `False` otherwise. ----- /Since: 4.7.0.0/+-- @since 4.7.0.0+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> isLeft (Left "foo")+-- True+-- >>> isLeft (Right 3)+-- False+--+-- Assuming a 'Left' value signifies some sort of error, we can use+-- 'isLeft' to write a very simple error-reporting function that does+-- absolutely nothing in the case of success, and outputs \"ERROR\" if+-- any error occurred.+--+-- This example shows how 'isLeft' might be used to avoid pattern+-- matching when one does not care about the value contained in the+-- constructor:+--+-- >>> import Control.Monad ( when )+-- >>> let report e = when (isLeft e) $ putStrLn "ERROR"+-- >>> report (Right 1)+-- >>> report (Left "parse error")+-- ERROR+-- isLeft :: Either a b -> Bool isLeft (Left  _) = True isLeft (Right _) = False  -- | Return `True` if the given value is a `Right`-value, `False` otherwise. ----- /Since: 4.7.0.0/+-- @since 4.7.0.0+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> isRight (Left "foo")+-- False+-- >>> isRight (Right 3)+-- True+--+-- Assuming a 'Left' value signifies some sort of error, we can use+-- 'isRight' to write a very simple reporting function that only+-- outputs \"SUCCESS\" when a computation has succeeded.+--+-- This example shows how 'isRight' might be used to avoid pattern+-- matching when one does not care about the value contained in the+-- constructor:+--+-- >>> import Control.Monad ( when )+-- >>> let report e = when (isRight e) $ putStrLn "SUCCESS"+-- >>> report (Left "parse error")+-- >>> report (Right 1)+-- SUCCESS+-- isRight :: Either a b -> Bool isRight (Left  _) = False isRight (Right _) = True  -- instance for the == Boolean type-level equality operator type family EqEither a b where-  EqEither (Left x)  (Left y)  = x == y-  EqEither (Right x) (Right y) = x == y-  EqEither a         b         = False+  EqEither ('Left x)  ('Left y)  = x == y+  EqEither ('Right x) ('Right y) = x == y+  EqEither a         b           = 'False type instance a == b = EqEither a b  {-

@@ -1,14 +1,13 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# OPTIONS -Wall -fno-warn-unused-binds #-}+{-# LANGUAGE AutoDeriveTypeable #-}  ----------------------------------------------------------------------------- -- | -- Module      :  Data.Fixed -- Copyright   :  (c) Ashley Yakeley 2005, 2006, 2009 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  Ashley Yakeley <ashley@semantic.org> -- Stability   :  experimental -- Portability :  portable@@ -37,8 +36,6 @@     E12,Pico ) where -import Prelude -- necessary to get dependencies right-import Data.Typeable import Data.Data import GHC.Read import Text.ParserCombinators.ReadPrec@@ -61,8 +58,8 @@     f = div' n d  -- | The type parameter should be an instance of 'HasResolution'.-newtype Fixed a = MkFixed Integer -- ^ /Since: 4.7.0.0/-        deriving (Eq,Ord,Typeable)+newtype Fixed a = MkFixed Integer -- ^ @since 4.7.0.0+        deriving (Eq,Ord)  -- We do this because the automatically derived Data instance requires (Data a) context. -- Our manual instance has the more general (Typeable a) context.@@ -146,7 +143,9 @@     -- enough digits to be unambiguous     digits = ceiling (logBase 10 (fromInteger res) :: Double)     maxnum = 10 ^ digits-    fracNum = div (d * maxnum) res+    -- read floors, so show must ceil for `read . show = id` to hold. See #9240+    fracNum = divCeil (d * maxnum) res+    divCeil x y = (x + y - 1) `div` y  instance (HasResolution a) => Show (Fixed a) where     show = showFixed False@@ -167,52 +166,44 @@           e = ceiling (logBase 10 (fromInteger r) :: Double) convertFixed _ = pfail -data E0 = E0-     deriving (Typeable)+data E0 instance HasResolution E0 where     resolution _ = 1 -- | resolution of 1, this works the same as Integer type Uni = Fixed E0 -data E1 = E1-     deriving (Typeable)+data E1 instance HasResolution E1 where     resolution _ = 10 -- | resolution of 10^-1 = .1 type Deci = Fixed E1 -data E2 = E2-     deriving (Typeable)+data E2 instance HasResolution E2 where     resolution _ = 100 -- | resolution of 10^-2 = .01, useful for many monetary currencies type Centi = Fixed E2 -data E3 = E3-     deriving (Typeable)+data E3 instance HasResolution E3 where     resolution _ = 1000 -- | resolution of 10^-3 = .001 type Milli = Fixed E3 -data E6 = E6-     deriving (Typeable)+data E6 instance HasResolution E6 where     resolution _ = 1000000 -- | resolution of 10^-6 = .000001 type Micro = Fixed E6 -data E9 = E9-     deriving (Typeable)+data E9 instance HasResolution E9 where     resolution _ = 1000000000 -- | resolution of 10^-9 = .000000001 type Nano = Fixed E9 -data E12 = E12-     deriving (Typeable)+data E12 instance HasResolution E12 where     resolution _ = 1000000000000 -- | resolution of 10^-12 = .000000000001 type Pico = Fixed E12-

@@ -1,4 +1,6 @@ {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE ScopedTypeVariables #-}  ----------------------------------------------------------------------------- -- |@@ -12,12 +14,6 @@ -- -- Class of data structures that can be folded to a summary value. ----- Many of these functions generalize "Prelude", "Control.Monad" and--- "Data.List" functions of the same names from lists to any 'Foldable'--- functor.  To avoid ambiguity, either import those modules hiding--- these names or qualify uses of these function names with an alias--- for this module.--- -----------------------------------------------------------------------------  module Data.Foldable (@@ -38,43 +34,39 @@     sequence_,     msum,     -- ** Specialized folds-    toList,     concat,     concatMap,     and,     or,     any,     all,-    sum,-    product,-    maximum,     maximumBy,-    minimum,     minimumBy,     -- ** Searches-    elem,     notElem,     find     ) where -import Prelude hiding (foldl, foldr, foldl1, foldr1, mapM_, sequence_,-                elem, notElem, concat, concatMap, and, or, any, all,-                sum, product, maximum, minimum)-import qualified Prelude (foldl, foldr, foldl1, foldr1)-import qualified Data.List as List (foldl')-import Control.Applicative-import Control.Monad (MonadPlus(..))-import Data.Maybe (fromMaybe, listToMaybe)+import Data.Bool+import Data.Either+import Data.Eq+import qualified GHC.List as List+import Data.Maybe import Data.Monoid+import Data.Ord import Data.Proxy -import GHC.Exts (build)-import GHC.Arr+import GHC.Arr  ( Array(..), Ix(..), elems, numElements,+                  foldlElems, foldrElems,+                  foldlElems', foldrElems',+                  foldl1Elems, foldr1Elems)+import GHC.Base hiding ( foldr )+import GHC.Num  ( Num(..) ) +infix  4 `elem`, `notElem`+ -- | Data structures that can be folded. ----- Minimal complete definition: 'foldMap' or 'foldr'.--- -- For example, given a data type -- -- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)@@ -94,7 +86,32 @@ -- >    foldr f z (Leaf x) = f x z -- >    foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l --+-- @Foldable@ instances are expected to satisfy the following laws:+--+-- > foldr f z t = appEndo (foldMap (Endo . f) t ) z+--+-- > foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z+--+-- > fold = foldMap id+--+-- @sum@, @product@, @maximum@, and @minimum@ should all be essentially+-- equivalent to @foldMap@ forms, such as+--+-- > sum = getSum . foldMap Sum+--+-- but may be less defined.+--+-- If the type is also a 'Functor' instance, it should satisfy+--+-- > foldMap f = fold . fmap f+--+-- which implies that+--+-- > foldMap f . fmap g = foldMap (f . g)+ class Foldable t where+    {-# MINIMAL foldMap | foldr #-}+     -- | Combine the elements of a structure using a monoid.     fold :: Monoid m => t m -> m     fold = foldMap id@@ -108,9 +125,9 @@     --     -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@     foldr :: (a -> b -> b) -> b -> t a -> b-    foldr f z t = appEndo (foldMap (Endo . f) t) z+    foldr f z t = appEndo (foldMap (Endo #. f) t) z -    -- | Right-associative fold of a structure, +    -- | Right-associative fold of a structure,     -- but with strict application of the operator.     foldr' :: (a -> b -> b) -> b -> t a -> b     foldr' f z0 xs = foldl f' id xs z0@@ -121,6 +138,8 @@     -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@     foldl :: (b -> a -> b) -> b -> t a -> b     foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z+    -- There's no point mucking around with coercions here,+    -- because flip forces us to build a new function anyway.      -- | Left-associative fold of a structure.     -- but with strict application of the operator.@@ -138,8 +157,9 @@     foldr1 f xs = fromMaybe (error "foldr1: empty structure")                     (foldr mf Nothing xs)       where-        mf x Nothing = Just x-        mf x (Just y) = Just (f x y)+        mf x m = Just (case m of+                         Nothing -> x+                         Just y  -> f x y)      -- | A variant of 'foldl' that has no base case,     -- and thus may only be applied to non-empty structures.@@ -149,10 +169,50 @@     foldl1 f xs = fromMaybe (error "foldl1: empty structure")                     (foldl mf Nothing xs)       where-        mf Nothing y = Just y-        mf (Just x) y = Just (f x y)-    {-# MINIMAL foldMap | foldr #-}+        mf m y = Just (case m of+                         Nothing -> y+                         Just x  -> f x y) +    -- | List of elements of a structure, from left to right.+    toList :: t a -> [a]+    {-# INLINE toList #-}+    toList t = build (\ c n -> foldr c n t)++    -- | Test whether the structure is empty. The default implementation is+    -- optimized for structures that are similar to cons-lists, because there+    -- is no general way to do better.+    null :: t a -> Bool+    null = foldr (\_ _ -> False) True++    -- | Returns the size/length of a finite structure as an 'Int'.  The+    -- default implementation is optimized for structures that are similar to+    -- cons-lists, because there is no general way to do better.+    length :: t a -> Int+    length = foldl' (\c _ -> c+1) 0++    -- | Does the element occur in the structure?+    elem :: Eq a => a -> t a -> Bool+    elem = any . (==)++    -- | The largest element of a non-empty structure.+    maximum :: forall a . Ord a => t a -> a+    maximum = fromMaybe (error "maximum: empty structure") .+       getMax . foldMap (Max #. (Just :: a -> Maybe a))++    -- | The least element of a non-empty structure.+    minimum :: forall a . Ord a => t a -> a+    minimum = fromMaybe (error "minimum: empty structure") .+       getMin . foldMap (Min #. (Just :: a -> Maybe a))++    -- | The 'sum' function computes the sum of the numbers of a structure.+    sum :: Num a => t a -> a+    sum = getSum #. foldMap Sum++    -- | The 'product' function computes the product of the numbers of a+    -- structure.+    product :: Num a => t a -> a+    product = getProduct #. foldMap Product+ -- instances for Prelude types  instance Foldable Maybe where@@ -163,11 +223,19 @@     foldl f z (Just x) = f z x  instance Foldable [] where-    foldr = Prelude.foldr-    foldl = Prelude.foldl-    foldl' = List.foldl'-    foldr1 = Prelude.foldr1-    foldl1 = Prelude.foldl1+    elem    = List.elem+    foldl   = List.foldl+    foldl'  = List.foldl'+    foldl1  = List.foldl1+    foldr   = List.foldr+    foldr1  = List.foldr1+    length  = List.length+    maximum = List.maximum+    minimum = List.minimum+    null    = List.null+    product = List.product+    sum     = List.sum+    toList  = id  instance Foldable (Either a) where     foldMap _ (Left _) = mempty@@ -176,16 +244,26 @@     foldr _ z (Left _) = z     foldr f z (Right y) = f y z +    length (Left _)  = 0+    length (Right _) = 1++    null             = isLeft+ instance Foldable ((,) a) where     foldMap f (_, y) = f y      foldr f z (_, y) = f y z  instance Ix i => Foldable (Array i) where-    foldr f z = Prelude.foldr f z . elems-    foldl f z = Prelude.foldl f z . elems-    foldr1 f = Prelude.foldr1 f . elems-    foldl1 f = Prelude.foldl1 f . elems+    foldr = foldrElems+    foldl = foldlElems+    foldl' = foldlElems'+    foldr' = foldrElems'+    foldl1 = foldl1Elems+    foldr1 = foldr1Elems+    toList = elems+    length = numElements+    null a = numElements a == 0  instance Foldable Proxy where     foldMap _ _ = mempty@@ -197,13 +275,42 @@     foldl _ z _ = z     {-# INLINE foldl #-}     foldl1 _ _ = error "foldl1: Proxy"-    {-# INLINE foldl1 #-}     foldr1 _ _ = error "foldr1: Proxy"-    {-# INLINE foldr1 #-}+    length _   = 0+    null _     = True+    elem _ _   = False+    sum _      = 0+    product _  = 1 -instance Foldable (Const m) where-    foldMap _ _ = mempty+-- We don't export Max and Min because, as Edward Kmett pointed out to me,+-- there are two reasonable ways to define them. One way is to use Maybe, as we+-- do here; the other way is to impose a Bounded constraint on the Monoid+-- instance. We may eventually want to add both versions, but we don't want to+-- trample on anyone's toes by imposing Max = MaxMaybe. +newtype Max a = Max {getMax :: Maybe a}+newtype Min a = Min {getMin :: Maybe a}++instance Ord a => Monoid (Max a) where+  mempty = Max Nothing++  {-# INLINE mappend #-}+  m `mappend` Max Nothing = m+  Max Nothing `mappend` n = n+  (Max m@(Just x)) `mappend` (Max n@(Just y))+    | x >= y    = Max m+    | otherwise = Max n++instance Ord a => Monoid (Min a) where+  mempty = Min Nothing++  {-# INLINE mappend #-}+  m `mappend` Min Nothing = m+  Min Nothing `mappend` n = n+  (Min m@(Just x)) `mappend` (Min n@(Just y))+    | x <= y    = Min m+    | otherwise = Min n+ -- | Monadic fold over the elements of a structure, -- associating to the right, i.e. from right to left. foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b@@ -216,33 +323,54 @@ foldlM f z0 xs = foldr f' return xs z0   where f' x k z = f z x >>= k --- | Map each element of a structure to an action, evaluate--- these actions from left to right, and ignore the results.+-- | Map each element of a structure to an action, evaluate these+-- actions from left to right, and ignore the results. For a version+-- that doesn't ignore the results see 'Data.Traversable.traverse'. traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f () traverse_ f = foldr ((*>) . f) (pure ()) --- | 'for_' is 'traverse_' with its arguments flipped.+-- | 'for_' is 'traverse_' with its arguments flipped. For a version+-- that doesn't ignore the results see 'Data.Traversable.for'.+--+-- >>> for_ [1..4] print+-- 1+-- 2+-- 3+-- 4 for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f () {-# INLINE for_ #-} for_ = flip traverse_  -- | Map each element of a structure to a monadic action, evaluate--- these actions from left to right, and ignore the results.+-- these actions from left to right, and ignore the results. For a+-- version that doesn't ignore the results see+-- 'Data.Traversable.mapM'.+--+-- As of base 4.8.0.0, 'mapM_' is just 'traverse_', specialized to+-- 'Monad'. mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()-mapM_ f = foldr ((>>) . f) (return ())+mapM_ f= foldr ((>>) . f) (return ()) --- | 'forM_' is 'mapM_' with its arguments flipped.+-- | 'forM_' is 'mapM_' with its arguments flipped. For a version that+-- doesn't ignore the results see 'Data.Traversable.forM'.+--+-- As of base 4.8.0.0, 'forM_' is just 'for_', specialized to 'Monad'. forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m () {-# INLINE forM_ #-} forM_ = flip mapM_ --- | Evaluate each action in the structure from left to right,--- and ignore the results.+-- | Evaluate each action in the structure from left to right, and+-- ignore the results. For a version that doesn't ignore the results+-- see 'Data.Traversable.sequenceA'. sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f () sequenceA_ = foldr (*>) (pure ())  -- | Evaluate each monadic action in the structure from left to right,--- and ignore the results.+-- and ignore the results. For a version that doesn't ignore the+-- results see 'Data.Traversable.sequence'.+--+-- As of base 4.8.0.0, 'sequence_' is just 'sequenceA_', specialized+-- to 'Monad'. sequence_ :: (Foldable t, Monad m) => t (m a) -> m () sequence_ = foldr (>>) (return ()) @@ -252,57 +380,43 @@ asum = foldr (<|>) empty  -- | The sum of a collection of actions, generalizing 'concat'.+-- As of base 4.8.0.0, 'msum' is just 'asum', specialized to 'MonadPlus'. msum :: (Foldable t, MonadPlus m) => t (m a) -> m a {-# INLINE msum #-}-msum = foldr mplus mzero---- These use foldr rather than foldMap to avoid repeated concatenation.---- | List of elements of a structure.-toList :: Foldable t => t a -> [a]-{-# INLINE toList #-}-toList t = build (\ c n -> foldr c n t)+msum = asum  -- | The concatenation of all the elements of a container of lists. concat :: Foldable t => t [a] -> [a]-concat = fold+concat xs = build (\c n -> foldr (\x y -> foldr c y x) n xs)+{-# INLINE concat #-}  -- | Map a function over all the elements of a container and concatenate -- the resulting lists. concatMap :: Foldable t => (a -> [b]) -> t a -> [b]-concatMap = foldMap+concatMap f xs = build (\c n -> foldr (\x b -> foldr c b (f x)) n xs)+{-# INLINE concatMap #-} +-- These use foldr rather than foldMap to avoid repeated concatenation.+ -- | 'and' returns the conjunction of a container of Bools.  For the -- result to be 'True', the container must be finite; 'False', however, -- results from a 'False' value finitely far from the left end. and :: Foldable t => t Bool -> Bool-and = getAll . foldMap All+and = getAll #. foldMap All  -- | 'or' returns the disjunction of a container of Bools.  For the -- result to be 'False', the container must be finite; 'True', however, -- results from a 'True' value finitely far from the left end. or :: Foldable t => t Bool -> Bool-or = getAny . foldMap Any+or = getAny #. foldMap Any  -- | Determines whether any element of the structure satisfies the predicate. any :: Foldable t => (a -> Bool) -> t a -> Bool-any p = getAny . foldMap (Any . p)+any p = getAny #. foldMap (Any #. p)  -- | Determines whether all elements of the structure satisfy the predicate. all :: Foldable t => (a -> Bool) -> t a -> Bool-all p = getAll . foldMap (All . p)---- | The 'sum' function computes the sum of the numbers of a structure.-sum :: (Foldable t, Num a) => t a -> a-sum = getSum . foldMap Sum---- | The 'product' function computes the product of the numbers of a structure.-product :: (Foldable t, Num a) => t a -> a-product = getProduct . foldMap Product---- | The largest element of a non-empty structure.-maximum :: (Foldable t, Ord a) => t a -> a-maximum = foldr1 max+all p = getAll #. foldMap (All #. p)  -- | The largest element of a non-empty structure with respect to the -- given comparison function.@@ -312,10 +426,6 @@                         GT -> x                         _  -> y --- | The least element of a non-empty structure.-minimum :: (Foldable t, Ord a) => t a -> a-minimum = foldr1 min- -- | The least element of a non-empty structure with respect to the -- given comparison function. minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a@@ -324,10 +434,6 @@                         GT -> y                         _  -> x --- | Does the element occur in the structure?-elem :: (Foldable t, Eq a) => a -> t a -> Bool-elem = any . (==)- -- | 'notElem' is the negation of 'elem'. notElem :: (Foldable t, Eq a) => a -> t a -> Bool notElem x = not . elem x@@ -336,5 +442,36 @@ -- the leftmost element of the structure matching the predicate, or -- 'Nothing' if there is no such element. find :: Foldable t => (a -> Bool) -> t a -> Maybe a-find p = listToMaybe . concatMap (\ x -> if p x then [x] else [])+find p = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing)) +-- See Note [Function coercion]+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)+(#.) _f = coerce+{-# INLINE (#.) #-}++{-+Note [Function coercion]+~~~~~~~~~~~~~~~~~~~~~~~~++Several functions here use (#.) instead of (.) to avoid potential efficiency+problems relating to #7542. The problem, in a nutshell:++If N is a newtype constructor, then N x will always have the same+representation as x (something similar applies for a newtype deconstructor).+However, if f is a function,++N . f = \x -> N (f x)++This looks almost the same as f, but the eta expansion lifts it--the lhs could+be _|_, but the rhs never is. This can lead to very inefficient code.  Thus we+steal a technique from Shachaf and Edward Kmett and adapt it to the current+(rather clean) setting. Instead of using  N . f,  we use  N .## f, which is+just++coerce f `asTypeOf` (N . f)++That is, we just *pretend* that f has the right type, and thanks to the safety+of coerce, the type checker guarantees that nothing really goes wrong. We still+have to be a bit careful, though: remember that #. completely ignores the+*value* of its left operand.+-}

@@ -1,9 +1,11 @@-{-# LANGUAGE Safe #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}  ----------------------------------------------------------------------------- -- | -- Module      :  Data.Function -- Copyright   :  Nils Anders Danielsson 2006+--             ,  Alexander Berntsen     2014 -- License     :  BSD-style (see the LICENSE file in the distribution) -- -- Maintainer  :  libraries@haskell.org@@ -18,13 +20,15 @@   ( -- * "Prelude" re-exports     id, const, (.), flip, ($)     -- * Other combinators+  , (&)   , fix   , on   ) where -import Prelude+import GHC.Base ( ($), (.), id, const, flip )  infixl 0 `on`+infixl 1 &  -- | @'fix' f@ is the least fixed point of the function @f@, -- i.e. the least defined @x@ such that @f x = x@.@@ -86,3 +90,11 @@ on :: (b -> b -> c) -> (a -> b) -> a -> a -> c (.*.) `on` f = \x y -> f x .*. f y ++-- | '&' is a reverse application operator.  This provides notational+-- convenience.  Its precedence is one higher than that of the forward+-- application operator '$', which allows '&' to be nested in '$'.+--+-- @since 4.8.0.0+(&) :: a -> (a -> b) -> b+x & f = f x

@@ -1,17 +1,18 @@ {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}  ----------------------------------------------------------------------------- -- | -- Module      :  Data.Functor -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  provisional -- Portability :  portable -- -- Functors: uniform action over a parameterized type, generalizing the--- 'map' function on lists.+-- 'Data.List.map' function on lists.  module Data.Functor     (@@ -22,12 +23,43 @@       void,     ) where -import Control.Monad-import GHC.Base (Functor(..))+import GHC.Base ( Functor(..), flip ) +-- $setup+-- Allow the use of Prelude in doctests.+-- >>> import Prelude+ infixl 4 <$>  -- | An infix synonym for 'fmap'.+--+-- ==== __Examples__+--+-- Convert from a @'Maybe' 'Int'@ to a @'Maybe' 'String'@ using 'show':+--+-- >>> show <$> Nothing+-- Nothing+-- >>> show <$> Just 3+-- Just "3"+--+-- Convert from an @'Either' 'Int' 'Int'@ to an @'Either' 'Int'@+-- 'String' using 'show':+--+-- >>> show <$> Left 17+-- Left 17+-- >>> show <$> Right 17+-- Right "17"+--+-- Double each element of a list:+--+-- >>> (*2) <$> [1,2,3]+-- [2,4,6]+--+-- Apply 'even' to the second element of a pair:+--+-- >>> even <$> (2,2)+-- (2,True)+-- (<$>) :: Functor f => (a -> b) -> f a -> f b (<$>) = fmap @@ -35,7 +67,77 @@  -- | Flipped version of '<$'. ----- /Since: 4.7.0.0/+-- @since 4.7.0.0+--+-- ==== __Examples__+--+-- Replace the contents of a @'Maybe' 'Int'@ with a constant 'String':+--+-- >>> Nothing $> "foo"+-- Nothing+-- >>> Just 90210 $> "foo"+-- Just "foo"+--+-- Replace the contents of an @'Either' 'Int' 'Int'@ with a constant+-- 'String', resulting in an @'Either' 'Int' 'String'@:+--+-- >>> Left 8675309 $> "foo"+-- Left 8675309+-- >>> Right 8675309 $> "foo"+-- Right "foo"+--+-- Replace each element of a list with a constant 'String':+--+-- >>> [1,2,3] $> "foo"+-- ["foo","foo","foo"]+--+-- Replace the second element of a pair with a constant 'String':+--+-- >>> (1,2) $> "foo"+-- (1,"foo")+-- ($>) :: Functor f => f a -> b -> f b ($>) = flip (<$) +-- | @'void' value@ discards or ignores the result of evaluation, such+-- as the return value of an 'System.IO.IO' action.+--+-- ==== __Examples__+--+-- Replace the contents of a @'Maybe' 'Int'@ with unit:+--+-- >>> void Nothing+-- Nothing+-- >>> void (Just 3)+-- Just ()+--+-- Replace the contents of an @'Either' 'Int' 'Int'@ with unit,+-- resulting in an @'Either' 'Int' '()'@:+--+-- >>> void (Left 8675309)+-- Left 8675309+-- >>> void (Right 8675309)+-- Right ()+--+-- Replace every element of a list with unit:+--+-- >>> void [1,2,3]+-- [(),(),()]+--+-- Replace the second element of a pair with unit:+--+-- >>> void (1,2)+-- (1,())+--+-- Discard the result of an 'System.IO.IO' action:+--+-- >>> mapM print [1,2]+-- 1+-- 2+-- [(),()]+-- >>> void $ mapM print [1,2]+-- 1+-- 2+--+void :: Functor f => f a -> f ()+void x = () <$ x

@@ -0,0 +1,104 @@+{-# LANGUAGE AutoDeriveTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE Trustworthy #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Identity+-- Copyright   :  (c) Andy Gill 2001,+--                (c) Oregon Graduate Institute of Science and Technology 2001+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  portable+--+-- The identity functor and monad.+--+-- This trivial type constructor serves two purposes:+--+-- * It can be used with functions parameterized by functor or monad classes.+--+-- * It can be used as a base monad to which a series of monad+--   transformers may be applied to construct a composite monad.+--   Most monad transformer modules include the special case of+--   applying the transformer to 'Identity'.  For example, @State s@+--   is an abbreviation for @StateT s 'Identity'@.+--+-- @since 4.8.0.0+-----------------------------------------------------------------------------++module Data.Functor.Identity (+    Identity(..),+  ) where++import Control.Monad.Fix+import Control.Monad.Zip+import Data.Coerce+import Data.Data (Data)+import Data.Foldable+import GHC.Generics (Generic, Generic1)++-- | Identity functor and monad. (a non-strict monad)+--+-- @since 4.8.0.0+newtype Identity a = Identity { runIdentity :: a }+    deriving (Eq, Ord, Data, Traversable, Generic, Generic1)++-- | This instance would be equivalent to the derived instances of the+-- 'Identity' newtype if the 'runIdentity' field were removed+instance (Read a) => Read (Identity a) where+    readsPrec d = readParen (d > 10) $ \ r ->+        [(Identity x,t) | ("Identity",s) <- lex r, (x,t) <- readsPrec 11 s]++-- | This instance would be equivalent to the derived instances of the+-- 'Identity' newtype if the 'runIdentity' field were removed+instance (Show a) => Show (Identity a) where+    showsPrec d (Identity x) = showParen (d > 10) $+        showString "Identity " . showsPrec 11 x++-- ---------------------------------------------------------------------------+-- Identity instances for Functor and Monad++instance Foldable Identity where+    foldMap                = coerce++    elem                   = (. runIdentity) #. (==)+    foldl                  = coerce+    foldl'                 = coerce+    foldl1 _               = runIdentity+    foldr f z (Identity x) = f x z+    foldr'                 = foldr+    foldr1 _               = runIdentity+    length _               = 1+    maximum                = runIdentity+    minimum                = runIdentity+    null _                 = False+    product                = runIdentity+    sum                    = runIdentity+    toList (Identity x)    = [x]++instance Functor Identity where+    fmap     = coerce++instance Applicative Identity where+    pure     = Identity+    (<*>)    = coerce++instance Monad Identity where+    return   = Identity+    m >>= k  = k (runIdentity m)++instance MonadFix Identity where+    mfix f   = Identity (fix (runIdentity . f))++instance MonadZip Identity where+    mzipWith = coerce+    munzip   = coerce++-- | Internal (non-exported) 'Coercible' helper for 'elem'+--+-- See Note [Function coercion] in "Data.Foldable" for more details.+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c+(#.) _f = coerce

@@ -71,7 +71,7 @@  -- |Strict version of 'modifyIORef' ----- /Since: 4.6.0.0/+-- @since 4.6.0.0 modifyIORef' :: IORef a -> (a -> a) -> IO () modifyIORef' ref f = do     x <- readIORef ref@@ -103,18 +103,18 @@ -- | Strict version of 'atomicModifyIORef'.  This forces both the value stored -- in the 'IORef' as well as the value returned. ----- /Since: 4.6.0.0/+-- @since 4.6.0.0 atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b atomicModifyIORef' ref f = do-    b <- atomicModifyIORef ref-            (\x -> let (a, b) = f x-                    in (a, a `seq` b))+    b <- atomicModifyIORef ref $ \a ->+            case f a of+                v@(a',_) -> a' `seq` v     b `seq` return b  -- | Variant of 'writeIORef' with the \"barrier to reordering\" property that -- 'atomicModifyIORef' has. ----- /Since: 4.6.0.0/+-- @since 4.6.0.0 atomicWriteIORef :: IORef a -> a -> IO () atomicWriteIORef ref a = do     x <- atomicModifyIORef ref (\_ -> (a, ()))

@@ -12,7 +12,7 @@ -- -- The 'Ix' class is used to map a contiguous subrange of values in -- type onto integers.  It is used primarily for array indexing--- (see the array package).+-- (see the array package).  'Ix' uses row-major order. --  ----------------------------------------------------------------------------- @@ -56,11 +56,9 @@     -- >        inRange (Yellow,Blue) Red    ==  False     --      -- * For single-constructor datatypes, the derived instance declarations-    -- are as shown for tuples in Figure 1-    -- <http://www.haskell.org/onlinelibrary/ix.html#prelude-index>.+    -- are as shown for tuples in chapter 19, section 2 of the Haskell 2010 report:+    -- <https://www.haskell.org/onlinereport/haskell2010/haskellch19.html>.      ) where---- import Prelude  import GHC.Arr

@@ -1,12 +1,12 @@ {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, BangPatterns #-}+{-# LANGUAGE NoImplicitPrelude #-}  ----------------------------------------------------------------------------- -- | -- Module      :  Data.List -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  stable -- Portability :  portable@@ -24,6 +24,7 @@    , last    , tail    , init+   , uncons    , null    , length @@ -34,7 +35,7 @@    , intersperse    , intercalate    , transpose-   +    , subsequences    , permutations @@ -64,6 +65,7 @@     -- ** Scans    , scanl+   , scanl'    , scanl1    , scanr    , scanr1@@ -105,6 +107,7 @@    , isPrefixOf    , isSuffixOf    , isInfixOf+   , isSubsequenceOf     -- * Searching lists @@ -164,6 +167,7 @@     -- ** Ordered lists    , sort+   , sortOn    , insert     -- * Generalized functions@@ -205,952 +209,33 @@     ) where -import Data.Maybe-import Data.Bits        ( (.&.) )-import Data.Char        ( isSpace )--import GHC.Num-import GHC.Real-import GHC.List-import GHC.Base--infix 5 \\ -- comment to fool cpp---- -------------------------------------------------------------------------------- List functions---- | The 'dropWhileEnd' function drops the largest suffix of a list--- in which the given predicate holds for all elements.  For example:------ > dropWhileEnd isSpace "foo\n" == "foo"--- > dropWhileEnd isSpace "foo bar" == "foo bar"--- > dropWhileEnd isSpace ("foo\n" ++ undefined) == "foo" ++ undefined------ /Since: 4.5.0.0/-dropWhileEnd :: (a -> Bool) -> [a] -> [a]-dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []---- | The 'stripPrefix' function drops the given prefix from a list.--- It returns 'Nothing' if the list did not start with the prefix--- given, or 'Just' the list after the prefix, if it does.------ > stripPrefix "foo" "foobar" == Just "bar"--- > stripPrefix "foo" "foo" == Just ""--- > stripPrefix "foo" "barfoo" == Nothing--- > stripPrefix "foo" "barfoobaz" == Nothing-stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]-stripPrefix [] ys = Just ys-stripPrefix (x:xs) (y:ys)- | x == y = stripPrefix xs ys-stripPrefix _ _ = Nothing---- | The 'elemIndex' function returns the index of the first element--- in the given list which is equal (by '==') to the query element,--- or 'Nothing' if there is no such element.-elemIndex       :: Eq a => a -> [a] -> Maybe Int-elemIndex x     = findIndex (x==)---- | The 'elemIndices' function extends 'elemIndex', by returning the--- indices of all elements equal to the query element, in ascending order.-elemIndices     :: Eq a => a -> [a] -> [Int]-elemIndices x   = findIndices (x==)---- | The 'find' function takes a predicate and a list and returns the--- first element in the list matching the predicate, or 'Nothing' if--- there is no such element.-find            :: (a -> Bool) -> [a] -> Maybe a-find p          = listToMaybe . filter p---- | The 'findIndex' function takes a predicate and a list and returns--- the index of the first element in the list satisfying the predicate,--- or 'Nothing' if there is no such element.-findIndex       :: (a -> Bool) -> [a] -> Maybe Int-findIndex p     = listToMaybe . findIndices p---- | The 'findIndices' function extends 'findIndex', by returning the--- indices of all elements satisfying the predicate, in ascending order.-findIndices      :: (a -> Bool) -> [a] -> [Int]-#ifdef USE_REPORT_PRELUDE-findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]-#else--- Efficient definition-findIndices p ls = loop 0# ls-                 where-                   loop _ [] = []-                   loop n (x:xs) | p x       = I# n : loop (n +# 1#) xs-                                 | otherwise = loop (n +# 1#) xs-#endif  /* USE_REPORT_PRELUDE */---- | The 'isPrefixOf' function takes two lists and returns 'True'--- iff the first list is a prefix of the second.-isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool-isPrefixOf [] _         =  True-isPrefixOf _  []        =  False-isPrefixOf (x:xs) (y:ys)=  x == y && isPrefixOf xs ys---- | The 'isSuffixOf' function takes two lists and returns 'True'--- iff the first list is a suffix of the second.--- Both lists must be finite.-isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool-isSuffixOf x y          =  reverse x `isPrefixOf` reverse y---- | The 'isInfixOf' function takes two lists and returns 'True'--- iff the first list is contained, wholly and intact,--- anywhere within the second.------ Example:------ >isInfixOf "Haskell" "I really like Haskell." == True--- >isInfixOf "Ial" "I really like Haskell." == False-isInfixOf               :: (Eq a) => [a] -> [a] -> Bool-isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)---- | /O(n^2)/. The 'nub' function removes duplicate elements from a list.--- In particular, it keeps only the first occurrence of each element.--- (The name 'nub' means \`essence\'.)--- It is a special case of 'nubBy', which allows the programmer to supply--- their own equality test.-nub                     :: (Eq a) => [a] -> [a]-#ifdef USE_REPORT_PRELUDE-nub                     =  nubBy (==)-#else--- stolen from HBC-nub l                   = nub' l []             -- '-  where-    nub' [] _           = []                    -- '-    nub' (x:xs) ls                              -- '-        | x `elem` ls   = nub' xs ls            -- '-        | otherwise     = x : nub' xs (x:ls)    -- '-#endif---- | The 'nubBy' function behaves just like 'nub', except it uses a--- user-supplied equality predicate instead of the overloaded '=='--- function.-nubBy                   :: (a -> a -> Bool) -> [a] -> [a]-#ifdef USE_REPORT_PRELUDE-nubBy eq []             =  []-nubBy eq (x:xs)         =  x : nubBy eq (filter (\ y -> not (eq x y)) xs)-#else-nubBy eq l              = nubBy' l []-  where-    nubBy' [] _         = []-    nubBy' (y:ys) xs-       | elem_by eq y xs = nubBy' ys xs-       | otherwise       = y : nubBy' ys (y:xs)---- Not exported:--- Note that we keep the call to `eq` with arguments in the--- same order as in the reference implementation--- 'xs' is the list of things we've seen so far, --- 'y' is the potential new element-elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool-elem_by _  _ []         =  False-elem_by eq y (x:xs)     =  y `eq` x || elem_by eq y xs-#endif----- | 'delete' @x@ removes the first occurrence of @x@ from its list argument.--- For example,------ > delete 'a' "banana" == "bnana"------ It is a special case of 'deleteBy', which allows the programmer to--- supply their own equality test.--delete                  :: (Eq a) => a -> [a] -> [a]-delete                  =  deleteBy (==)---- | The 'deleteBy' function behaves like 'delete', but takes a--- user-supplied equality predicate.-deleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]-deleteBy _  _ []        = []-deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys---- | The '\\' function is list difference (non-associative).--- In the result of @xs@ '\\' @ys@, the first occurrence of each element of--- @ys@ in turn (if any) has been removed from @xs@.  Thus------ > (xs ++ ys) \\ xs == ys.------ It is a special case of 'deleteFirstsBy', which allows the programmer--- to supply their own equality test.--(\\)                    :: (Eq a) => [a] -> [a] -> [a]-(\\)                    =  foldl (flip delete)---- | The 'union' function returns the list union of the two lists.--- For example,------ > "dog" `union` "cow" == "dogcw"------ Duplicates, and elements of the first list, are removed from the--- the second list, but if the first list contains duplicates, so will--- the result.--- It is a special case of 'unionBy', which allows the programmer to supply--- their own equality test.--union                   :: (Eq a) => [a] -> [a] -> [a]-union                   = unionBy (==)---- | The 'unionBy' function is the non-overloaded version of 'union'.-unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]-unionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs---- | The 'intersect' function takes the list intersection of two lists.--- For example,------ > [1,2,3,4] `intersect` [2,4,6,8] == [2,4]------ If the first list contains duplicates, so will the result.------ > [1,2,2,3,4] `intersect` [6,4,4,2] == [2,2,4]------ It is a special case of 'intersectBy', which allows the programmer to--- supply their own equality test. If the element is found in both the first--- and the second list, the element from the first list will be used.--intersect               :: (Eq a) => [a] -> [a] -> [a]-intersect               =  intersectBy (==)---- | The 'intersectBy' function is the non-overloaded version of 'intersect'.-intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]-intersectBy _  [] _     =  []-intersectBy _  _  []    =  []-intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]---- | The 'intersperse' function takes an element and a list and--- \`intersperses\' that element between the elements of the list.--- For example,------ > intersperse ',' "abcde" == "a,b,c,d,e"--intersperse             :: a -> [a] -> [a]-intersperse _   []      = []-intersperse sep (x:xs)  = x : prependToAll sep xs----- Not exported:--- We want to make every element in the 'intersperse'd list available--- as soon as possible to avoid space leaks. Experiments suggested that--- a separate top-level helper is more efficient than a local worker.-prependToAll            :: a -> [a] -> [a]-prependToAll _   []     = []-prependToAll sep (x:xs) = sep : x : prependToAll sep xs---- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@.--- It inserts the list @xs@ in between the lists in @xss@ and concatenates the--- result.-intercalate :: [a] -> [[a]] -> [a]-intercalate xs xss = concat (intersperse xs xss)---- | The 'transpose' function transposes the rows and columns of its argument.--- For example,------ > transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]--transpose               :: [[a]] -> [[a]]-transpose []             = []-transpose ([]   : xss)   = transpose xss-transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss])----- | The 'partition' function takes a predicate a list and returns--- the pair of lists of elements which do and do not satisfy the--- predicate, respectively; i.e.,------ > partition p xs == (filter p xs, filter (not . p) xs)--partition               :: (a -> Bool) -> [a] -> ([a],[a])-{-# INLINE partition #-}-partition p xs = foldr (select p) ([],[]) xs--select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])-select p x ~(ts,fs) | p x       = (x:ts,fs)-                    | otherwise = (ts, x:fs)---- | The 'mapAccumL' function behaves like a combination of 'map' and--- 'foldl'; it applies a function to each element of a list, passing--- an accumulating parameter from left to right, and returning a final--- value of this accumulator together with the new list.-mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list-                                    -- and accumulator, returning new-                                    -- accumulator and elt of result list-          -> acc            -- Initial accumulator -          -> [x]            -- Input list-          -> (acc, [y])     -- Final accumulator and result list-mapAccumL _ s []        =  (s, [])-mapAccumL f s (x:xs)    =  (s'',y:ys)-                           where (s', y ) = f s x-                                 (s'',ys) = mapAccumL f s' xs---- | The 'mapAccumR' function behaves like a combination of 'map' and--- 'foldr'; it applies a function to each element of a list, passing--- an accumulating parameter from right to left, and returning a final--- value of this accumulator together with the new list.-mapAccumR :: (acc -> x -> (acc, y))     -- Function of elt of input list-                                        -- and accumulator, returning new-                                        -- accumulator and elt of result list-            -> acc              -- Initial accumulator-            -> [x]              -- Input list-            -> (acc, [y])               -- Final accumulator and result list-mapAccumR _ s []        =  (s, [])-mapAccumR f s (x:xs)    =  (s'', y:ys)-                           where (s'',y ) = f s' x-                                 (s', ys) = mapAccumR f s xs---- | The 'insert' function takes an element and a list and inserts the--- element into the list at the first position where it is less--- than or equal to the next element.  In particular, if the list--- is sorted before the call, the result will also be sorted.--- It is a special case of 'insertBy', which allows the programmer to--- supply their own comparison function.-insert :: Ord a => a -> [a] -> [a]-insert e ls = insertBy (compare) e ls---- | The non-overloaded version of 'insert'.-insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]-insertBy _   x [] = [x]-insertBy cmp x ys@(y:ys')- = case cmp x y of-     GT -> y : insertBy cmp x ys'-     _  -> x : ys---- | 'maximum' returns the maximum value from a list,--- which must be non-empty, finite, and of an ordered type.--- It is a special case of 'Data.List.maximumBy', which allows the--- programmer to supply their own comparison function.-maximum                 :: (Ord a) => [a] -> a-{-# NOINLINE [1] maximum #-}-maximum []              =  errorEmptyList "maximum"-maximum xs              =  foldl1 max xs--{-# RULES-  "maximumInt"     maximum = (strictMaximum :: [Int]     -> Int);-  "maximumInteger" maximum = (strictMaximum :: [Integer] -> Integer)- #-}---- We can't make the overloaded version of maximum strict without--- changing its semantics (max might not be strict), but we can for--- the version specialised to 'Int'.-strictMaximum           :: (Ord a) => [a] -> a-strictMaximum []        =  errorEmptyList "maximum"-strictMaximum xs        =  foldl1' max xs---- | 'minimum' returns the minimum value from a list,--- which must be non-empty, finite, and of an ordered type.--- It is a special case of 'Data.List.minimumBy', which allows the--- programmer to supply their own comparison function.-minimum                 :: (Ord a) => [a] -> a-{-# NOINLINE [1] minimum #-}-minimum []              =  errorEmptyList "minimum"-minimum xs              =  foldl1 min xs--{-# RULES-  "minimumInt"     minimum = (strictMinimum :: [Int]     -> Int);-  "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer)- #-}--strictMinimum           :: (Ord a) => [a] -> a-strictMinimum []        =  errorEmptyList "minimum"-strictMinimum xs        =  foldl1' min xs---- | The 'maximumBy' function takes a comparison function and a list--- and returns the greatest element of the list by the comparison function.--- The list must be finite and non-empty.-maximumBy               :: (a -> a -> Ordering) -> [a] -> a-maximumBy _ []          =  error "List.maximumBy: empty list"-maximumBy cmp xs        =  foldl1 maxBy xs-                        where-                           maxBy x y = case cmp x y of-                                       GT -> x-                                       _  -> y---- | The 'minimumBy' function takes a comparison function and a list--- and returns the least element of the list by the comparison function.--- The list must be finite and non-empty.-minimumBy               :: (a -> a -> Ordering) -> [a] -> a-minimumBy _ []          =  error "List.minimumBy: empty list"-minimumBy cmp xs        =  foldl1 minBy xs-                        where-                           minBy x y = case cmp x y of-                                       GT -> y-                                       _  -> x---- | The 'genericLength' function is an overloaded version of 'length'.  In--- particular, instead of returning an 'Int', it returns any type which is--- an instance of 'Num'.  It is, however, less efficient than 'length'.-genericLength           :: (Num i) => [a] -> i-{-# NOINLINE [1] genericLength #-}-genericLength []        =  0-genericLength (_:l)     =  1 + genericLength l--{-# RULES-  "genericLengthInt"     genericLength = (strictGenericLength :: [a] -> Int);-  "genericLengthInteger" genericLength = (strictGenericLength :: [a] -> Integer);- #-}--strictGenericLength     :: (Num i) => [b] -> i-strictGenericLength l   =  gl l 0-                        where-                           gl [] a     = a-                           gl (_:xs) a = let a' = a + 1 in a' `seq` gl xs a'---- | The 'genericTake' function is an overloaded version of 'take', which--- accepts any 'Integral' value as the number of elements to take.-genericTake             :: (Integral i) => i -> [a] -> [a]-genericTake n _ | n <= 0 = []-genericTake _ []        =  []-genericTake n (x:xs)    =  x : genericTake (n-1) xs---- | The 'genericDrop' function is an overloaded version of 'drop', which--- accepts any 'Integral' value as the number of elements to drop.-genericDrop             :: (Integral i) => i -> [a] -> [a]-genericDrop n xs | n <= 0 = xs-genericDrop _ []        =  []-genericDrop n (_:xs)    =  genericDrop (n-1) xs----- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which--- accepts any 'Integral' value as the position at which to split.-genericSplitAt          :: (Integral i) => i -> [a] -> ([a], [a])-genericSplitAt n xs | n <= 0 =  ([],xs)-genericSplitAt _ []     =  ([],[])-genericSplitAt n (x:xs) =  (x:xs',xs'') where-    (xs',xs'') = genericSplitAt (n-1) xs---- | The 'genericIndex' function is an overloaded version of '!!', which--- accepts any 'Integral' value as the index.-genericIndex :: (Integral i) => [a] -> i -> a-genericIndex (x:_)  0 = x-genericIndex (_:xs) n- | n > 0     = genericIndex xs (n-1)- | otherwise = error "List.genericIndex: negative argument."-genericIndex _ _      = error "List.genericIndex: index too large."---- | The 'genericReplicate' function is an overloaded version of 'replicate',--- which accepts any 'Integral' value as the number of repetitions to make.-genericReplicate        :: (Integral i) => i -> a -> [a]-genericReplicate n x    =  genericTake n (repeat x)---- | The 'zip4' function takes four lists and returns a list of--- quadruples, analogous to 'zip'.-zip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]-zip4                    =  zipWith4 (,,,)---- | The 'zip5' function takes five lists and returns a list of--- five-tuples, analogous to 'zip'.-zip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]-zip5                    =  zipWith5 (,,,,)---- | The 'zip6' function takes six lists and returns a list of six-tuples,--- analogous to 'zip'.-zip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->-                              [(a,b,c,d,e,f)]-zip6                    =  zipWith6 (,,,,,)---- | The 'zip7' function takes seven lists and returns a list of--- seven-tuples, analogous to 'zip'.-zip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->-                              [g] -> [(a,b,c,d,e,f,g)]-zip7                    =  zipWith7 (,,,,,,)---- | The 'zipWith4' function takes a function which combines four--- elements, as well as four lists and returns a list of their point-wise--- combination, analogous to 'zipWith'.-zipWith4                :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]-zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)-                        =  z a b c d : zipWith4 z as bs cs ds-zipWith4 _ _ _ _ _      =  []---- | The 'zipWith5' function takes a function which combines five--- elements, as well as five lists and returns a list of their point-wise--- combination, analogous to 'zipWith'.-zipWith5                :: (a->b->c->d->e->f) ->-                           [a]->[b]->[c]->[d]->[e]->[f]-zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)-                        =  z a b c d e : zipWith5 z as bs cs ds es-zipWith5 _ _ _ _ _ _    = []---- | The 'zipWith6' function takes a function which combines six--- elements, as well as six lists and returns a list of their point-wise--- combination, analogous to 'zipWith'.-zipWith6                :: (a->b->c->d->e->f->g) ->-                           [a]->[b]->[c]->[d]->[e]->[f]->[g]-zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)-                        =  z a b c d e f : zipWith6 z as bs cs ds es fs-zipWith6 _ _ _ _ _ _ _  = []---- | The 'zipWith7' function takes a function which combines seven--- elements, as well as seven lists and returns a list of their point-wise--- combination, analogous to 'zipWith'.-zipWith7                :: (a->b->c->d->e->f->g->h) ->-                           [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]-zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)-                   =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs-zipWith7 _ _ _ _ _ _ _ _ = []---- | The 'unzip4' function takes a list of quadruples and returns four--- lists, analogous to 'unzip'.-unzip4                  :: [(a,b,c,d)] -> ([a],[b],[c],[d])-unzip4                  =  foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->-                                        (a:as,b:bs,c:cs,d:ds))-                                 ([],[],[],[])---- | The 'unzip5' function takes a list of five-tuples and returns five--- lists, analogous to 'unzip'.-unzip5                  :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])-unzip5                  =  foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->-                                        (a:as,b:bs,c:cs,d:ds,e:es))-                                 ([],[],[],[],[])---- | The 'unzip6' function takes a list of six-tuples and returns six--- lists, analogous to 'unzip'.-unzip6                  :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])-unzip6                  =  foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->-                                        (a:as,b:bs,c:cs,d:ds,e:es,f:fs))-                                 ([],[],[],[],[],[])---- | The 'unzip7' function takes a list of seven-tuples and returns--- seven lists, analogous to 'unzip'.-unzip7          :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])-unzip7          =  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->-                                (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))-                         ([],[],[],[],[],[],[])----- | The 'deleteFirstsBy' function takes a predicate and two lists and--- returns the first list with the first occurrence of each element of--- the second list removed.-deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]-deleteFirstsBy eq       =  foldl (flip (deleteBy eq))---- | The 'group' function takes a list and returns a list of lists such--- that the concatenation of the result is equal to the argument.  Moreover,--- each sublist in the result contains only equal elements.  For example,------ > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]------ It is a special case of 'groupBy', which allows the programmer to supply--- their own equality test.-group                   :: Eq a => [a] -> [[a]]-group                   =  groupBy (==)---- | The 'groupBy' function is the non-overloaded version of 'group'.-groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]-groupBy _  []           =  []-groupBy eq (x:xs)       =  (x:ys) : groupBy eq zs-                           where (ys,zs) = span (eq x) xs---- | The 'inits' function returns all initial segments of the argument,--- shortest first.  For example,------ > inits "abc" == ["","a","ab","abc"]------ Note that 'inits' has the following strictness property:--- @inits (xs ++ _|_) = inits xs ++ _|_@------ In particular,--- @inits _|_ = [] : _|_@-inits                   :: [a] -> [[a]]-inits                   = map toListSB . scanl' snocSB emptySB-{-# NOINLINE inits #-}---- We do not allow inits to inline, because it plays havoc with Call Arity--- if it fuses with a consumer, and it would generally lead to serious--- loss of sharing if allowed to fuse with a producer.---- | A strictly accumulating version of 'scanl'-{-# NOINLINE [1] scanl' #-}-scanl'           :: (b -> a -> b) -> b -> [a] -> [b]--- This peculiar form is needed to prevent scanl' from being rewritten--- in its own right hand side.-scanl' = scanlGo'-  where-    scanlGo' :: (b -> a -> b) -> b -> [a] -> [b]-    scanlGo' f !q ls    = q : (case ls of-                            []   -> []-                            x:xs -> scanlGo' f (f q x) xs)---- | The 'tails' function returns all final segments of the argument,--- longest first.  For example,------ > tails "abc" == ["abc", "bc", "c",""]------ Note that 'tails' has the following strictness property:--- @tails _|_ = _|_ : _|_@-tails                   :: [a] -> [[a]]-tails xs                =  xs : case xs of-                                  []      -> []-                                  _ : xs' -> tails xs'---- | The 'subsequences' function returns the list of all subsequences of the argument.------ > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]-subsequences            :: [a] -> [[a]]-subsequences xs         =  [] : nonEmptySubsequences xs---- | The 'nonEmptySubsequences' function returns the list of all subsequences of the argument,---   except for the empty list.------ > nonEmptySubsequences "abc" == ["a","b","ab","c","ac","bc","abc"]-nonEmptySubsequences         :: [a] -> [[a]]-nonEmptySubsequences []      =  []-nonEmptySubsequences (x:xs)  =  [x] : foldr f [] (nonEmptySubsequences xs)-  where f ys r = ys : (x : ys) : r----- | The 'permutations' function returns the list of all permutations of the argument.------ > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]-permutations            :: [a] -> [[a]]-permutations xs0        =  xs0 : perms xs0 []-  where-    perms []     _  = []-    perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)-      where interleave    xs     r = let (_,zs) = interleave' id xs r in zs-            interleave' _ []     r = (ts, r)-            interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r-                                     in  (y:us, f (t:y:us) : zs)------------------------------------------------------------------------------------ Quick Sort algorithm taken from HBC's QSort library.---- | The 'sort' function implements a stable sorting algorithm.--- It is a special case of 'sortBy', which allows the programmer to supply--- their own comparison function.-sort :: (Ord a) => [a] -> [a]---- | The 'sortBy' function is the non-overloaded version of 'sort'.-sortBy :: (a -> a -> Ordering) -> [a] -> [a]--#ifdef USE_REPORT_PRELUDE-sort = sortBy compare-sortBy cmp = foldr (insertBy cmp) []-#else--{--GHC's mergesort replaced by a better implementation, 24/12/2009.-This code originally contributed to the nhc12 compiler by Thomas Nordin-in 2002.  Rumoured to have been based on code by Lennart Augustsson, e.g.-    http://www.mail-archive.com/haskell@haskell.org/msg01822.html-and possibly to bear similarities to a 1982 paper by Richard O'Keefe:-"A smooth applicative merge sort".--Benchmarks show it to be often 2x the speed of the previous implementation.-Fixes ticket http://hackage.haskell.org/trac/ghc/ticket/2143--}--sort = sortBy compare-sortBy cmp = mergeAll . sequences-  where-    sequences (a:b:xs)-      | a `cmp` b == GT = descending b [a]  xs-      | otherwise       = ascending  b (a:) xs-    sequences xs = [xs]--    descending a as (b:bs)-      | a `cmp` b == GT = descending b (a:as) bs-    descending a as bs  = (a:as): sequences bs--    ascending a as (b:bs)-      | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs-    ascending a as bs   = as [a]: sequences bs--    mergeAll [x] = x-    mergeAll xs  = mergeAll (mergePairs xs)--    mergePairs (a:b:xs) = merge a b: mergePairs xs-    mergePairs xs       = xs--    merge as@(a:as') bs@(b:bs')-      | a `cmp` b == GT = b:merge as  bs'-      | otherwise       = a:merge as' bs-    merge [] bs         = bs-    merge as []         = as--{--sortBy cmp l = mergesort cmp l-sort l = mergesort compare l--Quicksort replaced by mergesort, 14/5/2002.--From: Ian Lynagh <igloo@earth.li>--I am curious as to why the List.sort implementation in GHC is a-quicksort algorithm rather than an algorithm that guarantees n log n-time in the worst case? I have attached a mergesort implementation along-with a few scripts to time it's performance, the results of which are-shown below (* means it didn't finish successfully - in all cases this-was due to a stack overflow).--If I heap profile the random_list case with only 10000 then I see-random_list peaks at using about 2.5M of memory, whereas in the same-program using List.sort it uses only 100k.--Input style     Input length     Sort data     Sort alg    User time-stdin           10000            random_list   sort        2.82-stdin           10000            random_list   mergesort   2.96-stdin           10000            sorted        sort        31.37-stdin           10000            sorted        mergesort   1.90-stdin           10000            revsorted     sort        31.21-stdin           10000            revsorted     mergesort   1.88-stdin           100000           random_list   sort        *-stdin           100000           random_list   mergesort   *-stdin           100000           sorted        sort        *-stdin           100000           sorted        mergesort   *-stdin           100000           revsorted     sort        *-stdin           100000           revsorted     mergesort   *-func            10000            random_list   sort        0.31-func            10000            random_list   mergesort   0.91-func            10000            sorted        sort        19.09-func            10000            sorted        mergesort   0.15-func            10000            revsorted     sort        19.17-func            10000            revsorted     mergesort   0.16-func            100000           random_list   sort        3.85-func            100000           random_list   mergesort   *-func            100000           sorted        sort        5831.47-func            100000           sorted        mergesort   2.23-func            100000           revsorted     sort        5872.34-func            100000           revsorted     mergesort   2.24--mergesort :: (a -> a -> Ordering) -> [a] -> [a]-mergesort cmp = mergesort' cmp . map wrap--mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]-mergesort' _   [] = []-mergesort' _   [xs] = xs-mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)--merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]-merge_pairs _   [] = []-merge_pairs _   [xs] = [xs]-merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss--merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]-merge _   [] ys = ys-merge _   xs [] = xs-merge cmp (x:xs) (y:ys)- = case x `cmp` y of-        GT -> y : merge cmp (x:xs)   ys-        _  -> x : merge cmp    xs (y:ys)--wrap :: a -> [a]-wrap x = [x]----OLDER: qsort version---- qsort is stable and does not concatenate.-qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]-qsort _   []     r = r-qsort _   [x]    r = x:r-qsort cmp (x:xs) r = qpart cmp x xs [] [] r---- qpart partitions and sorts the sublists-qpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]-qpart cmp x [] rlt rge r =-    -- rlt and rge are in reverse order and must be sorted with an-    -- anti-stable sorting-    rqsort cmp rlt (x:rqsort cmp rge r)-qpart cmp x (y:ys) rlt rge r =-    case cmp x y of-        GT -> qpart cmp x ys (y:rlt) rge r-        _  -> qpart cmp x ys rlt (y:rge) r---- rqsort is as qsort but anti-stable, i.e. reverses equal elements-rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]-rqsort _   []     r = r-rqsort _   [x]    r = x:r-rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r+import Data.Foldable+import Data.Traversable -rqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]-rqpart cmp x [] rle rgt r =-    qsort cmp rle (x:qsort cmp rgt r)-rqpart cmp x (y:ys) rle rgt r =-    case cmp y x of-        GT -> rqpart cmp x ys rle (y:rgt) r-        _  -> rqpart cmp x ys (y:rle) rgt r--}+import Data.OldList hiding ( all, and, any, concat, concatMap, elem, find,+                             foldl, foldl1, foldl', foldr, foldr1, mapAccumL,+                             mapAccumR, maximum, maximumBy, minimum, minimumBy,+                             length, notElem, null, or, product, sum ) -#endif /* USE_REPORT_PRELUDE */+import GHC.Base ( Bool(..), Eq((==)), otherwise ) --- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'--- reduces a list to a summary value, 'unfoldr' builds a list from--- a seed value.  The function takes the element and returns 'Nothing'--- if it is done producing the list or returns 'Just' @(a,b)@, in which--- case, @a@ is a prepended to the list and @b@ is used as the next--- element in a recursive call.  For example,------ > iterate f == unfoldr (\x -> Just (x, f x))------ In some cases, 'unfoldr' can undo a 'foldr' operation:------ > unfoldr f' (foldr f z xs) == xs------ if the following holds:+-- | The 'isSubsequenceOf' function takes two lists and returns 'True' if the+-- first list is a subsequence of the second list. ----- > f' (f x y) = Just (x,y)--- > f' z       = Nothing+-- @'isSubsequenceOf' x y@ is equivalent to @'elem' x ('subsequences' y)@. ----- A simple use of unfoldr:+-- @since 4.8.0.0 ----- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10--- >  [10,9,8,7,6,5,4,3,2,1]+-- ==== __Examples__ ---unfoldr      :: (b -> Maybe (a, b)) -> b -> [a]-unfoldr f b  =-  case f b of-   Just (a,new_b) -> a : unfoldr f new_b-   Nothing        -> []---- --------------------------------------------------------------------------------- | A strict version of 'foldl'.-foldl'           :: (b -> a -> b) -> b -> [a] -> b-foldl' f z0 xs0 = lgo z0 xs0-    where lgo z []     = z-          lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs---- | 'foldl1' is a variant of 'foldl' that has no starting value argument,--- and thus must be applied to non-empty lists.-foldl1                  :: (a -> a -> a) -> [a] -> a-foldl1 f (x:xs)         =  foldl f x xs-foldl1 _ []             =  errorEmptyList "foldl1"---- | A strict version of 'foldl1'-foldl1'                  :: (a -> a -> a) -> [a] -> a-foldl1' f (x:xs)         =  foldl' f x xs-foldl1' _ []             =  errorEmptyList "foldl1'"---- -------------------------------------------------------------------------------- List sum and product--{-# SPECIALISE sum     :: [Int] -> Int #-}-{-# SPECIALISE sum     :: [Integer] -> Integer #-}-{-# INLINABLE sum #-}-{-# SPECIALISE product :: [Int] -> Int #-}-{-# SPECIALISE product :: [Integer] -> Integer #-}-{-# INLINABLE product #-}--- We make 'sum' and 'product' inlinable so that we get specialisations--- at other types.  See, for example, Trac #7507.---- | The 'sum' function computes the sum of a finite list of numbers.-sum                     :: (Num a) => [a] -> a--- | The 'product' function computes the product of a finite list of numbers.-product                 :: (Num a) => [a] -> a-#ifdef USE_REPORT_PRELUDE-sum                     =  foldl (+) 0-product                 =  foldl (*) 1-#else-sum     l       = sum' l 0-  where-    sum' []     a = a-    sum' (x:xs) a = sum' xs (a+x)-product l       = prod l 1-  where-    prod []     a = a-    prod (x:xs) a = prod xs (a*x)-#endif---- -------------------------------------------------------------------------------- Functions on strings---- | 'lines' breaks a string up into a list of strings at newline--- characters.  The resulting strings do not contain newlines.-lines                   :: String -> [String]-lines ""                =  []--- Somehow GHC doesn't detect the selector thunks in the below code,--- so s' keeps a reference to the first line via the pair and we have--- a space leak (cf. #4334).--- So we need to make GHC see the selector thunks with a trick.-lines s                 =  cons (case break (== '\n') s of-                                    (l, s') -> (l, case s' of-                                                    []      -> []-                                                    _:s''   -> lines s''))-  where-    cons ~(h, t)        =  h : t---- | 'unlines' is an inverse operation to 'lines'.--- It joins lines, after appending a terminating newline to each.-unlines                 :: [String] -> String-#ifdef USE_REPORT_PRELUDE-unlines                 =  concatMap (++ "\n")-#else--- HBC version (stolen)--- here's a more efficient version-unlines [] = []-unlines (l:ls) = l ++ '\n' : unlines ls-#endif---- | 'words' breaks a string up into a list of words, which were delimited--- by white space.-words                   :: String -> [String]-words s                 =  case dropWhile {-partain:Char.-}isSpace s of-                                "" -> []-                                s' -> w : words s''-                                      where (w, s'') =-                                             break {-partain:Char.-}isSpace s'---- | 'unwords' is an inverse operation to 'words'.--- It joins words with separating spaces.-unwords                 :: [String] -> String-#ifdef USE_REPORT_PRELUDE-unwords []              =  ""-unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws-#else--- HBC version (stolen)--- here's a more efficient version-unwords []              =  ""-unwords [w]             = w-unwords (w:ws)          = w ++ ' ' : unwords ws-#endif--{- A "SnocBuilder" is a version of Chris Okasaki's banker's queue that supports-toListSB instead of uncons. In single-threaded use, its performance-characteristics are similar to John Hughes's functional difference lists, but-likely somewhat worse. In heavily persistent settings, however, it does much-better, because it takes advantage of sharing. The banker's queue guarantees-(amortized) O(1) snoc and O(1) uncons, meaning that we can think of toListSB as-an O(1) conversion to a list-like structure a constant factor slower than-normal lists--we pay the O(n) cost incrementally as we consume the list. Using-functional difference lists, on the other hand, we would have to pay the whole-cost up front for each output list. -}--{- We store a front list, a rear list, and the length of the queue.  Because we-only snoc onto the queue and never uncons, we know it's time to rotate when the-length of the queue plus 1 is a power of 2. Note that we rely on the value of-the length field only for performance.  In the unlikely event of overflow, the-performance will suffer but the semantics will remain correct.  -}--data SnocBuilder a = SnocBuilder {-# UNPACK #-} !Word [a] [a]--{- Smart constructor that rotates the builder when lp is one minus a power of-2. Does not rotate very small builders because doing so is not worth the-trouble. The lp < 255 test goes first because the power-of-2 test gives awful-branch prediction for very small n (there are 5 powers of 2 between 1 and-16). Putting the well-predicted lp < 255 test first avoids branching on the-power-of-2 test until powers of 2 have become sufficiently rare to be predicted-well. -}--{-# INLINE sb #-}-sb :: Word -> [a] -> [a] -> SnocBuilder a-sb lp f r-  | lp < 255 || (lp .&. (lp + 1)) /= 0 = SnocBuilder lp f r-  | otherwise                          = SnocBuilder lp (f ++ reverse r) []---- The empty builder--emptySB :: SnocBuilder a-emptySB = SnocBuilder 0 [] []---- Add an element to the end of a queue.--snocSB :: SnocBuilder a -> a -> SnocBuilder a-snocSB (SnocBuilder lp f r) x = sb (lp + 1) f (x:r)---- Convert a builder to a list--toListSB :: SnocBuilder a -> [a]-toListSB (SnocBuilder _ f r) = f ++ reverse r+-- >>> isSubsequenceOf "GHC" "The Glorious Haskell Compiler"+-- True+-- >>> isSubsequenceOf ['a','d'..'z'] ['a'..'z']+-- True+-- >>> isSubsequenceOf [1..10] [10,9..0]+-- False+isSubsequenceOf :: (Eq a) => [a] -> [a] -> Bool+isSubsequenceOf []    _                    = True+isSubsequenceOf _     []                   = False+isSubsequenceOf a@(x:a') (y:b) | x == y    = isSubsequenceOf a' b+                               | otherwise = isSubsequenceOf a b

@@ -6,7 +6,7 @@ -- Module      :  Data.Maybe -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  stable -- Portability :  portable@@ -33,35 +33,9 @@  import GHC.Base --- ------------------------------------------------------------------------------ The Maybe type, and instances---- | The 'Maybe' type encapsulates an optional value.  A value of type--- @'Maybe' a@ either contains a value of type @a@ (represented as @'Just' a@), --- or it is empty (represented as 'Nothing').  Using 'Maybe' is a good way to --- deal with errors or exceptional cases without resorting to drastic--- measures such as 'error'.------ The 'Maybe' type is also a monad.  It is a simple kind of error--- monad, where all errors are represented by 'Nothing'.  A richer--- error monad can be built using the 'Data.Either.Either' type.--data  Maybe a  =  Nothing | Just a-  deriving (Eq, Ord)--instance  Functor Maybe  where-    fmap _ Nothing       = Nothing-    fmap f (Just a)      = Just (f a)--instance  Monad Maybe  where-    (Just x) >>= k      = k x-    Nothing  >>= _      = Nothing--    (Just _) >>  k      = k-    Nothing  >>  _      = Nothing--    return              = Just-    fail _              = Nothing+-- $setup+-- Allow the use of some Prelude functions in doctests.+-- >>> import Prelude ( (*), odd, show, sum )  -- --------------------------------------------------------------------------- -- Functions over Maybe@@ -70,23 +44,105 @@ -- value.  If the 'Maybe' value is 'Nothing', the function returns the -- default value.  Otherwise, it applies the function to the value inside -- the 'Just' and returns the result.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> maybe False odd (Just 3)+-- True+--+-- >>> maybe False odd Nothing+-- False+--+-- Read an integer from a string using 'readMaybe'. If we succeed,+-- return twice the integer; that is, apply @(*2)@ to it. If instead+-- we fail to parse an integer, return @0@ by default:+--+-- >>> import Text.Read ( readMaybe )+-- >>> maybe 0 (*2) (readMaybe "5")+-- 10+-- >>> maybe 0 (*2) (readMaybe "")+-- 0+--+-- Apply 'show' to a @Maybe Int@. If we have @Just n@, we want to show+-- the underlying 'Int' @n@. But if we have 'Nothing', we return the+-- empty string instead of (for example) \"Nothing\":+--+-- >>> maybe "" show (Just 5)+-- "5"+-- >>> maybe "" show Nothing+-- ""+-- maybe :: b -> (a -> b) -> Maybe a -> b maybe n _ Nothing  = n maybe _ f (Just x) = f x  -- | The 'isJust' function returns 'True' iff its argument is of the -- form @Just _@.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> isJust (Just 3)+-- True+--+-- >>> isJust (Just ())+-- True+--+-- >>> isJust Nothing+-- False+--+-- Only the outer constructor is taken into consideration:+--+-- >>> isJust (Just Nothing)+-- True+-- isJust         :: Maybe a -> Bool isJust Nothing = False isJust _       = True  -- | The 'isNothing' function returns 'True' iff its argument is 'Nothing'.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> isNothing (Just 3)+-- False+--+-- >>> isNothing (Just ())+-- False+--+-- >>> isNothing Nothing+-- True+--+-- Only the outer constructor is taken into consideration:+--+-- >>> isNothing (Just Nothing)+-- False+-- isNothing         :: Maybe a -> Bool isNothing Nothing = True isNothing _       = False  -- | The 'fromJust' function extracts the element out of a 'Just' and -- throws an error if its argument is 'Nothing'.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> fromJust (Just 1)+-- 1+--+-- >>> 2 * (fromJust (Just 10))+-- 20+--+-- >>> 2 * (fromJust Nothing)+-- *** Exception: Maybe.fromJust: Nothing+-- fromJust          :: Maybe a -> a fromJust Nothing  = error "Maybe.fromJust: Nothing" -- yuck fromJust (Just x) = x@@ -94,31 +150,134 @@ -- | The 'fromMaybe' function takes a default value and and 'Maybe' -- value.  If the 'Maybe' is 'Nothing', it returns the default values; -- otherwise, it returns the value contained in the 'Maybe'.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> fromMaybe "" (Just "Hello, World!")+-- "Hello, World!"+--+-- >>> fromMaybe "" Nothing+-- ""+--+-- Read an integer from a string using 'readMaybe'. If we fail to+-- parse an integer, we want to return @0@ by default:+--+-- >>> import Text.Read ( readMaybe )+-- >>> fromMaybe 0 (readMaybe "5")+-- 5+-- >>> fromMaybe 0 (readMaybe "")+-- 0+-- fromMaybe     :: a -> Maybe a -> a fromMaybe d x = case x of {Nothing -> d;Just v  -> v}  -- | The 'maybeToList' function returns an empty list when given -- 'Nothing' or a singleton list when not given 'Nothing'.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> maybeToList (Just 7)+-- [7]+--+-- >>> maybeToList Nothing+-- []+--+-- One can use 'maybeToList' to avoid pattern matching when combined+-- with a function that (safely) works on lists:+--+-- >>> import Text.Read ( readMaybe )+-- >>> sum $ maybeToList (readMaybe "3")+-- 3+-- >>> sum $ maybeToList (readMaybe "")+-- 0+-- maybeToList            :: Maybe a -> [a] maybeToList  Nothing   = [] maybeToList  (Just x)  = [x]  -- | The 'listToMaybe' function returns 'Nothing' on an empty list -- or @'Just' a@ where @a@ is the first element of the list.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> listToMaybe []+-- Nothing+--+-- >>> listToMaybe [9]+-- Just 9+--+-- >>> listToMaybe [1,2,3]+-- Just 1+--+-- Composing 'maybeToList' with 'listToMaybe' should be the identity+-- on singleton/empty lists:+--+-- >>> maybeToList $ listToMaybe [5]+-- [5]+-- >>> maybeToList $ listToMaybe []+-- []+--+-- But not on lists with more than one element:+--+-- >>> maybeToList $ listToMaybe [1,2,3]+-- [1]+-- listToMaybe           :: [a] -> Maybe a listToMaybe []        =  Nothing listToMaybe (a:_)     =  Just a  -- | The 'catMaybes' function takes a list of 'Maybe's and returns--- a list of all the 'Just' values. +-- a list of all the 'Just' values.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> catMaybes [Just 1, Nothing, Just 3]+-- [1,3]+--+-- When constructing a list of 'Maybe' values, 'catMaybes' can be used+-- to return all of the \"success\" results (if the list is the result+-- of a 'map', then 'mapMaybe' would be more appropriate):+--+-- >>> import Text.Read ( readMaybe )+-- >>> [readMaybe x :: Maybe Int | x <- ["1", "Foo", "3"] ]+-- [Just 1,Nothing,Just 3]+-- >>> catMaybes $ [readMaybe x :: Maybe Int | x <- ["1", "Foo", "3"] ]+-- [1,3]+-- catMaybes              :: [Maybe a] -> [a] catMaybes ls = [x | Just x <- ls]  -- | The 'mapMaybe' function is a version of 'map' which can throw -- out elements.  In particular, the functional argument returns -- something of type @'Maybe' b@.  If this is 'Nothing', no element--- is added on to the result list.  If it just @'Just' b@, then @b@ is+-- is added on to the result list.  If it is @'Just' b@, then @b@ is -- included in the result list.+--+-- ==== __Examples__+--+-- Using @'mapMaybe' f x@ is a shortcut for @'catMaybes' $ 'map' f x@+-- in most cases:+--+-- >>> import Text.Read ( readMaybe )+-- >>> let readMaybeInt = readMaybe :: String -> Maybe Int+-- >>> mapMaybe readMaybeInt ["1", "Foo", "3"]+-- [1,3]+-- >>> catMaybes $ map readMaybeInt ["1", "Foo", "3"]+-- [1,3]+--+-- If we map the 'Just' constructor, the entire list should be returned:+--+-- >>> mapMaybe Just [1,2,3]+-- [1,2,3]+-- mapMaybe          :: (a -> Maybe b) -> [a] -> [b] mapMaybe _ []     = [] mapMaybe f (x:xs) =

@@ -3,6 +3,8 @@ {-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}  ----------------------------------------------------------------------------- -- |@@ -21,21 +23,23 @@ -----------------------------------------------------------------------------  module Data.Monoid (-        -- * Monoid typeclass+        -- * 'Monoid' typeclass         Monoid(..),         (<>),         Dual(..),         Endo(..),-        -- * Bool wrappers+        -- * 'Bool' wrappers         All(..),         Any(..),-        -- * Num wrappers+        -- * 'Num' wrappers         Sum(..),         Product(..),-        -- * Maybe wrappers+        -- * 'Maybe' wrappers         -- $MaybeExamples         First(..),-        Last(..)+        Last(..),+        -- * 'Alternative' wrapper+        Alt (..)   ) where  -- Push down the module in the dependency hierarchy.@@ -45,8 +49,6 @@ import GHC.Read import GHC.Show import GHC.Generics-import Data.Maybe-import Data.Proxy  {- -- just for testing@@ -54,103 +56,18 @@ import Test.QuickCheck -- -} --- ------------------------------------------------------------------------------ | The class of monoids (types with an associative binary operation that--- has an identity).  Instances should satisfy the following laws:------  * @mappend mempty x = x@------  * @mappend x mempty = x@------  * @mappend x (mappend y z) = mappend (mappend x y) z@------  * @mconcat = 'foldr' mappend mempty@------ The method names refer to the monoid of lists under concatenation,--- but there are many other instances.------ Minimal complete definition: 'mempty' and 'mappend'.------ Some types can be viewed as a monoid in more than one way,--- e.g. both addition and multiplication on numbers.--- In such cases we often define @newtype@s and make those instances--- of 'Monoid', e.g. 'Sum' and 'Product'.--class Monoid a where-        mempty  :: a-        -- ^ Identity of 'mappend'-        mappend :: a -> a -> a-        -- ^ An associative operation-        mconcat :: [a] -> a--        -- ^ Fold a list using the monoid.-        -- For most types, the default definition for 'mconcat' will be-        -- used, but the function is included in the class definition so-        -- that an optimized version can be provided for specific types.--        mconcat = foldr mappend mempty- infixr 6 <>  -- | An infix synonym for 'mappend'. ----- /Since: 4.5.0.0/+-- @since 4.5.0.0 (<>) :: Monoid m => m -> m -> m (<>) = mappend {-# INLINE (<>) #-}  -- Monoid instances. -instance Monoid [a] where-        mempty  = []-        mappend = (++)--instance Monoid b => Monoid (a -> b) where-        mempty _ = mempty-        mappend f g x = f x `mappend` g x--instance Monoid () where-        -- Should it be strict?-        mempty        = ()-        _ `mappend` _ = ()-        mconcat _     = ()--instance (Monoid a, Monoid b) => Monoid (a,b) where-        mempty = (mempty, mempty)-        (a1,b1) `mappend` (a2,b2) =-                (a1 `mappend` a2, b1 `mappend` b2)--instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where-        mempty = (mempty, mempty, mempty)-        (a1,b1,c1) `mappend` (a2,b2,c2) =-                (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2)--instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where-        mempty = (mempty, mempty, mempty, mempty)-        (a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) =-                (a1 `mappend` a2, b1 `mappend` b2,-                 c1 `mappend` c2, d1 `mappend` d2)--instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>-                Monoid (a,b,c,d,e) where-        mempty = (mempty, mempty, mempty, mempty, mempty)-        (a1,b1,c1,d1,e1) `mappend` (a2,b2,c2,d2,e2) =-                (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2,-                 d1 `mappend` d2, e1 `mappend` e2)---- lexicographical ordering-instance Monoid Ordering where-        mempty         = EQ-        LT `mappend` _ = LT-        EQ `mappend` y = y-        GT `mappend` _ = GT--instance Monoid (Proxy s) where-    mempty = Proxy-    mappend _ _ = Proxy-    mconcat _ = Proxy---- | The dual of a monoid, obtained by swapping the arguments of 'mappend'.+-- | The dual of a 'Monoid', obtained by swapping the arguments of 'mappend'. newtype Dual a = Dual { getDual :: a }         deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1) @@ -166,7 +83,7 @@         mempty = Endo id         Endo f `mappend` Endo g = Endo (f . g) --- | Boolean monoid under conjunction.+-- | Boolean monoid under conjunction ('&&'). newtype All = All { getAll :: Bool }         deriving (Eq, Ord, Read, Show, Bounded, Generic) @@ -174,7 +91,7 @@         mempty = All True         All x `mappend` All y = All (x && y) --- | Boolean monoid under disjunction.+-- | Boolean monoid under disjunction ('||'). newtype Any = Any { getAny :: Bool }         deriving (Eq, Ord, Read, Show, Bounded, Generic) @@ -188,7 +105,8 @@  instance Num a => Monoid (Sum a) where         mempty = Sum 0-        Sum x `mappend` Sum y = Sum (x + y)+        mappend = coerce ((+) :: a -> a -> a)+--        Sum x `mappend` Sum y = Sum (x + y)  -- | Monoid under multiplication. newtype Product a = Product { getProduct :: a }@@ -196,7 +114,8 @@  instance Num a => Monoid (Product a) where         mempty = Product 1-        Product x `mappend` Product y = Product (x * y)+        mappend = coerce ((*) :: a -> a -> a)+--        Product x `mappend` Product y = Product (x * y)  -- $MaybeExamples -- To implement @find@ or @findLast@ on any 'Foldable':@@ -229,36 +148,43 @@ --      Just (combine key value oldValue)) -- @ --- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to--- <http://en.wikipedia.org/wiki/Monoid>: \"Any semigroup @S@ may be--- turned into a monoid simply by adjoining an element @e@ not in @S@--- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S@.\" Since--- there is no \"Semigroup\" typeclass providing just 'mappend', we--- use 'Monoid' instead.-instance Monoid a => Monoid (Maybe a) where-  mempty = Nothing-  Nothing `mappend` m = m-  m `mappend` Nothing = m-  Just m1 `mappend` Just m2 = Just (m1 `mappend` m2) - -- | Maybe monoid returning the leftmost non-Nothing value.+--+-- @'First' a@ is isomorphic to @'Alt' 'Maybe' a@, but precedes it+-- historically. newtype First a = First { getFirst :: Maybe a }-        deriving (Eq, Ord, Read, Show, Generic, Generic1)+        deriving (Eq, Ord, Read, Show, Generic, Generic1,+                  Functor, Applicative, Monad)  instance Monoid (First a) where         mempty = First Nothing-        r@(First (Just _)) `mappend` _ = r         First Nothing `mappend` r = r+        l `mappend` _             = l  -- | Maybe monoid returning the rightmost non-Nothing value.+--+-- @'Last' a@ is isomorphic to @'Dual' ('First' a)@, and thus to+-- @'Dual' ('Alt' 'Maybe' a)@ newtype Last a = Last { getLast :: Maybe a }-        deriving (Eq, Ord, Read, Show, Generic, Generic1)+        deriving (Eq, Ord, Read, Show, Generic, Generic1,+                  Functor, Applicative, Monad)  instance Monoid (Last a) where         mempty = Last Nothing-        _ `mappend` r@(Last (Just _)) = r-        r `mappend` Last Nothing = r+        l `mappend` Last Nothing = l+        _ `mappend` r            = r++-- | Monoid under '<|>'.+--+-- @since 4.8.0.0+newtype Alt f a = Alt {getAlt :: f a}+  deriving (Generic, Generic1, Read, Show, Eq, Ord, Num, Enum,+            Monad, MonadPlus, Applicative, Alternative, Functor)++instance forall f a . Alternative f => Monoid (Alt f a) where+        mempty = Alt empty+        mappend = coerce ((<|>) :: f a -> f a -> f a)  {- {--------------------------------------------------------------------