base 4.8.2.0 → 4.9.0.0

raw patch · 162 files changed

+7111/−2053 lines, 162 filesdep +invalid-cabal-flag-settingsdep ~ghc-primdep ~integer-gmpPVP ok

version bump matches the API change (PVP)

Dependencies added: invalid-cabal-flag-settings

Dependency ranges changed: ghc-prim, integer-gmp

API changes (from Hackage documentation)

Files

• Control/Applicative.hs +7/−32
• Control/Arrow.hs +16/−14
• Control/Category.hs +3/−0
• Control/Concurrent.hs +16/−9
• Control/Concurrent/Chan.hs +7/−3
• Control/Concurrent/MVar.hs +2/−2
• Control/Concurrent/QSem.hs +1/−1
• Control/Concurrent/QSemN.hs +1/−3
• Control/Exception.hs +5/−3
• Control/Exception/Base.hs +29/−14
• Control/Monad.hs +61/−25
• Control/Monad/Fail.hs +78/−0
• Control/Monad/Fix.hs +43/−3
• Control/Monad/IO/Class.hs +36/−0
• Control/Monad/ST/Lazy/Imp.hs +2/−4
• Control/Monad/Zip.hs +45/−1
• Data/Bifunctor.hs +4/−0
• Data/Bits.hs +1/−9
• Data/Char.hs +2/−209
• Data/Coerce.hs +1/−2
• Data/Complex.hs +46/−3
• Data/Data.hs +472/−54
• Data/Dynamic.hs +2/−3
• Data/Either.hs +4/−6
• Data/Fixed.hs +0/−1
• Data/Foldable.hs +164/−18
• Data/Functor.hs +9/−0
• Data/Functor/Classes.hs +490/−0
• Data/Functor/Compose.hs +94/−0
• Data/Functor/Const.hs +69/−0
• Data/Functor/Identity.hs +10/−3
• Data/Functor/Product.hs +97/−0
• Data/Functor/Sum.hs +77/−0
• Data/IORef.hs +3/−10
• Data/Kind.hs +19/−0
• Data/List.hs +3/−2
• Data/List/NonEmpty.hs +490/−0
• Data/Maybe.hs +1/−1
• Data/Monoid.hs +31/−3
• Data/OldList.hs +19/−5
• Data/Proxy.hs +11/−5
• Data/Semigroup.hs +634/−0
• Data/String.hs +45/−1
• Data/Traversable.hs +57/−8
• Data/Type/Bool.hs +2/−2
• Data/Type/Coercion.hs +5/−7
• Data/Type/Equality.hs +42/−20
• Data/Typeable.hs +3/−2
• Data/Typeable/Internal.hs +188/−113
• Data/Unique.hs +2/−3
• Data/Version.hs +9/−8
• Data/Void.hs +0/−1
• Debug/Trace.hs +15/−9
• Foreign/C/Types.hs +5/−6
• Foreign/Marshal/Array.hs +1/−2
• Foreign/Marshal/Error.hs +0/−4
• Foreign/Ptr.hs +1/−2
• Foreign/Storable.hs +6/−0
• GHC/Arr.hs +39/−37
• GHC/Base.hs +57/−32
• GHC/Char.hs +9/−2
• GHC/Conc.hs +1/−1
• GHC/Conc/IO.hs +2/−2
• GHC/Conc/Signal.hs +1/−1
• GHC/Conc/Sync.hs +14/−17
• GHC/Conc/Windows.hs +5/−7
• GHC/ConsoleHandler.hs +4/−4
• GHC/Enum.hs +67/−30
• GHC/Environment.hs +11/−7
• GHC/Err.hs +45/−8
• GHC/Event/Array.hs +5/−5
• GHC/Event/Control.hs +2/−2
• GHC/Event/EPoll.hsc +2/−2
• GHC/Event/IntTable.hs +16/−17
• GHC/Event/KQueue.hsc +2/−2
• GHC/Event/Manager.hs +8/−3
• GHC/Event/PSQ.hs +1/−1
• GHC/Event/Poll.hsc +3/−3
• GHC/Event/TimerManager.hs +2/−2
• GHC/Exception.hs +63/−8
• GHC/Exception.hs-boot +5/−1
• GHC/ExecutionStack.hs +50/−0
• GHC/ExecutionStack/Internal.hsc +238/−0
• GHC/Exts.hs +22/−6
• GHC/Fingerprint.hs +1/−1
• GHC/Float.hs +100/−12
• GHC/ForeignPtr.hs +18/−17
• GHC/GHCi.hs +2/−3
• GHC/Generics.hs +596/−153
• GHC/IO.hs +94/−170
• GHC/IO.hs-boot +1/−1
• GHC/IO/Buffer.hs +1/−1
• GHC/IO/Encoding.hs +2/−0
• GHC/IO/Encoding/CodePage/API.hs +8/−8
• GHC/IO/Encoding/Failure.hs +5/−4
• GHC/IO/Encoding/Latin1.hs +2/−2
• GHC/IO/Encoding/Types.hs +1/−1
• GHC/IO/Exception.hs +22/−20
• GHC/IO/FD.hs +1/−4
• GHC/IO/Handle.hs +9/−9
• GHC/IO/Handle/FD.hs +3/−3
• GHC/IO/Handle/Internals.hs +22/−14
• GHC/IO/Handle/Text.hs +4/−4
• GHC/IO/Handle/Types.hs +4/−8
• GHC/IO/Unsafe.hs +180/−0
• GHC/IOArray.hs +4/−5
• GHC/IORef.hs +2/−3
• GHC/IP.hs +0/−17
• GHC/Int.hs +146/−16
• GHC/List.hs +14/−26
• GHC/MVar.hs +4/−5
• GHC/Natural.hs +8/−16
• GHC/OverloadedLabels.hs +48/−0
• GHC/Pack.hs +1/−1
• GHC/RTS/Flags.hsc +4/−4
• GHC/Read.hs +3/−1
• GHC/Real.hs +9/−11
• GHC/ST.hs +8/−61
• GHC/Show.hs +20/−4
• GHC/SrcLoc.hs +0/−33
• GHC/Stable.hs +0/−3
• GHC/Stack.hs +101/−0
• GHC/Stack.hsc +0/−185
• GHC/Stack/CCS.hs-boot +16/−0
• GHC/Stack/CCS.hsc +120/−0
• GHC/Stack/Types.hs +217/−0
• GHC/StaticPtr.hs +10/−5
• GHC/Stats.hsc +33/−14
• GHC/TypeLits.hs +55/−10
• GHC/Unicode.hs +214/−1
• GHC/Weak.hs +5/−6
• GHC/Word.hs +148/−11
• Numeric.hs +4/−3
• Prelude.hs +1/−1
• System/CPUTime.hsc +11/−11
• System/Environment.hs +1/−1
• System/Environment/ExecutablePath.hsc +3/−3
• System/IO.hs +1/−1
• System/Mem.hs +16/−5
• System/Mem/StableName.hs +1/−22
• System/Posix/Internals.hs +115/−48
• System/Posix/Types.hs +1/−2
• System/Timeout.hs +2/−3
• Text/ParserCombinators/ReadP.hs +11/−6
• Text/ParserCombinators/ReadPrec.hs +6/−2
• Text/Printf.hs +2/−2
• Text/Read.hs +1/−1
• Text/Read/Lex.hs +22/−8
• Text/Show/Functions.hs +1/−1
• base.cabal +34/−18
• cbits/Win32Utils.c +1/−1
• cbits/consUtils.c +2/−2
• cbits/iconv.c +1/−1
• cbits/inputReady.c +2/−2
• cbits/primFloat.c +1/−1
• changelog.md +172/−1
• configure +218/−147
• configure.ac +10/−7
• include/CTypes.h +1/−1
• include/HsBase.h +12/−12
• include/HsBaseConfig.h.in +32/−0
• include/Typeable.h +0/−31

@@ -1,9 +1,7 @@ {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE ScopedTypeVariables #-}  ----------------------------------------------------------------------------- -- |@@ -57,38 +55,13 @@ import Data.Ord import Data.Foldable (Foldable(..)) import Data.Functor ((<$>))+import Data.Functor.Const (Const(..))  import GHC.Base import GHC.Generics import GHC.List (repeat, zipWith)-import GHC.Read (Read(readsPrec), readParen, lex)-import GHC.Show (Show(showsPrec), showParen, showString)--newtype Const a b = Const { getConst :: a }-                  deriving (Generic, Generic1, Monoid, Eq, Ord)--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]--instance Show a => Show (Const a b) where-    showsPrec d (Const x) = showParen (d > 10) $-                            showString "Const " . showsPrec 11 x--instance Foldable (Const m) where-    foldMap _ _ = mempty--instance Functor (Const m) where-    fmap _ (Const v) = Const v--instance Monoid m => Applicative (Const m) where-    pure _ = Const mempty-    (<*>) = 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.+import GHC.Read (Read)+import GHC.Show (Show)  newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }                          deriving (Generic, Generic1, Monad)@@ -97,7 +70,7 @@     fmap f (WrapMonad v) = WrapMonad (liftM f v)  instance Monad m => Applicative (WrappedMonad m) where-    pure = WrapMonad . return+    pure = WrapMonad . pure     WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v)  instance MonadPlus m => Alternative (WrappedMonad m) where@@ -123,7 +96,9 @@ -- @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@ -- newtype ZipList a = ZipList { getZipList :: [a] }-                  deriving (Show, Eq, Ord, Read, Functor, Generic, Generic1)+                  deriving ( Show, Eq, Ord, Read, Functor+                           , Foldable, Generic, Generic1)+-- See Data.Traversable for Traversabel instance due to import loops  instance Applicative ZipList where     pure x = ZipList (repeat x)

@@ -1,5 +1,8 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}+    -- The RULES for the methods of class Arrow may never fire+    -- e.g. compose/arr;  see Trac #10528  ----------------------------------------------------------------------------- -- |@@ -83,6 +86,7 @@ -- which may be overridden for efficiency.  class Category a => Arrow a where+    {-# MINIMAL arr, (first | (***)) #-}      -- | Lift a function to an arrow.     arr :: (b -> c) -> a b c@@ -90,16 +94,14 @@     -- | Send the first component of the input through the argument     --   arrow, and copy the rest unchanged to the output.     first :: a b c -> a (b,d) (c,d)+    first = (*** id)      -- | A mirror image of 'first'.     --     --   The default definition may be overridden with a more efficient     --   version if desired.     second :: a b c -> a (d,b) (d,c)-    second f = arr swap >>> first f >>> arr swap-      where-        swap :: (x,y) -> (y,x)-        swap ~(x,y) = (y,x)+    second = (id ***)      -- | Split the input between the two argument arrows and combine     --   their output.  Note that this is in general not a functor.@@ -107,7 +109,8 @@     --   The default definition may be overridden with a more efficient     --   version if desired.     (***) :: a b c -> a b' c' -> a (b,b') (c,c')-    f *** g = first f >>> second g+    f *** g = first f >>> arr swap >>> first g >>> arr swap+      where swap ~(x,y) = (y,x)      -- | Fanout: send the input to both argument arrows and combine     --   their output.@@ -138,8 +141,6 @@  instance Arrow (->) where     arr f = f-    first f = f *** id-    second f = id *** f --  (f *** g) ~(x,y) = (f x, g y) --  sorry, although the above defn is fully H'98, nhc98 can't parse it.     (***) f g ~(x,y) = (f x, g y)@@ -215,21 +216,19 @@ -- be overridden for efficiency.  class Arrow a => ArrowChoice a where+    {-# MINIMAL (left | (+++)) #-}      -- | Feed marked inputs through the argument arrow, passing the     --   rest through unchanged to the output.     left :: a b c -> a (Either b d) (Either c d)+    left = (+++ id)      -- | A mirror image of 'left'.     --     --   The default definition may be overridden with a more efficient     --   version if desired.     right :: a b c -> a (Either d b) (Either d c)-    right f = arr mirror >>> left f >>> arr mirror-      where-        mirror :: Either x y -> Either y x-        mirror (Left x) = Right x-        mirror (Right y) = Left y+    right = (id +++)      -- | Split the input between the two argument arrows, retagging     --   and merging their outputs.@@ -238,7 +237,11 @@     --   The default definition may be overridden with a more efficient     --   version if desired.     (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')-    f +++ g = left f >>> right g+    f +++ g = left f >>> arr mirror >>> left g >>> arr mirror+      where+        mirror :: Either x y -> Either y x+        mirror (Left x) = Right x+        mirror (Right y) = Left y      -- | Fanin: Split the input between the two argument arrows and     --   merge their outputs.@@ -311,7 +314,6 @@    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 

@@ -2,6 +2,9 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PolyKinds #-}+{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}+    -- The RULES for the methods of class Category may never fire+    -- e.g. identity/left, identity/right, association;  see Trac #10528  ----------------------------------------------------------------------------- -- |

@@ -3,8 +3,9 @@            , MagicHash            , UnboxedTuples            , ScopedTypeVariables+           , RankNTypes   #-}-{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-deprecations #-} -- kludge for the Control.Concurrent.QSem, Control.Concurrent.QSemN -- and Control.Concurrent.SampleVar imports. @@ -73,6 +74,7 @@         -- $boundthreads         rtsSupportsBoundThreads,         forkOS,+        forkOSWithUnmask,         isCurrentThreadBound,         runInBoundThread,         runInUnboundThread,@@ -107,7 +109,7 @@  import GHC.Conc hiding (threadWaitRead, threadWaitWrite,                         threadWaitReadSTM, threadWaitWriteSTM)-import GHC.IO           ( unsafeUnmask )+import GHC.IO           ( unsafeUnmask, catchException ) import GHC.IORef        ( newIORef, readIORef, writeIORef ) import GHC.Base @@ -180,7 +182,7 @@  -} --- | fork a thread and call the supplied function when the thread is about+-- | Fork a thread and call the supplied function when the thread is about -- to terminate, with an exception or a returned value.  The function is -- called with asynchronous exceptions masked. --@@ -306,7 +308,7 @@                         MaskedInterruptible -> action0                         MaskedUninterruptible -> uninterruptibleMask_ action0 -            action_plus = Exception.catch action1 childHandler+            action_plus = catchException action1 childHandler          entry <- newStablePtr (myThreadId >>= putMVar mv >> action_plus)         err <- forkOS_createThread entry@@ -316,6 +318,11 @@         return tid     | otherwise = failNonThreaded +-- | Like 'forkIOWithUnmask', but the child thread is a bound thread,+-- as with 'forkOS'.+forkOSWithUnmask :: ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId+forkOSWithUnmask io = forkOS (io unsafeUnmask)+ -- | Returns 'True' if the calling thread is /bound/, that is, if it is -- safe to use foreign libraries that rely on thread-local state from the -- calling thread.@@ -374,7 +381,7 @@       mv <- newEmptyMVar       mask $ \restore -> do         tid <- forkIO $ Exception.try (restore action) >>= putMVar mv-        let wait = takeMVar mv `Exception.catch` \(e :: SomeException) ->+        let wait = takeMVar mv `catchException` \(e :: SomeException) ->                      Exception.throwTo tid e >> wait         wait >>= unsafeResult     else action@@ -405,7 +412,7 @@                           return ()                         -- hWaitForInput does work properly, but we can only                         -- do this for stdin since we know its FD.-                  _ -> error "threadWaitRead requires -threaded on Windows, or use System.IO.hWaitForInput"+                  _ -> errorWithoutStackTrace "threadWaitRead requires -threaded on Windows, or use System.IO.hWaitForInput" #else   = GHC.Conc.threadWaitRead fd #endif@@ -421,7 +428,7 @@ threadWaitWrite fd #ifdef mingw32_HOST_OS   | threaded  = withThread (waitFd fd 1)-  | otherwise = error "threadWaitWrite requires -threaded on Windows"+  | otherwise = errorWithoutStackTrace "threadWaitWrite requires -threaded on Windows" #else   = GHC.Conc.threadWaitWrite fd #endif@@ -445,7 +452,7 @@                                         Just (Left e)   -> throwSTM (e :: IOException)                   let killAction = return ()                   return (waitAction, killAction)-  | otherwise = error "threadWaitReadSTM requires -threaded on Windows"+  | otherwise = errorWithoutStackTrace "threadWaitReadSTM requires -threaded on Windows" #else   = GHC.Conc.threadWaitReadSTM fd #endif@@ -469,7 +476,7 @@                                         Just (Left e)   -> throwSTM (e :: IOException)                   let killAction = return ()                   return (waitAction, killAction)-  | otherwise = error "threadWaitWriteSTM requires -threaded on Windows"+  | otherwise = errorWithoutStackTrace "threadWaitWriteSTM requires -threaded on Windows" #else   = GHC.Conc.threadWaitWriteSTM fd #endif

@@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}  ----------------------------------------------------------------------------- -- |@@ -14,6 +14,11 @@ -- -- Unbounded channels. --+-- The channels are implemented with @MVar@s and therefore inherit all the+-- caveats that apply to @MVar@s (possibility of races, deadlocks etc). The+-- stm (software transactional memory) library has a more robust implementation+-- of channels called @TChan@s.+-- -----------------------------------------------------------------------------  module Control.Concurrent.Chan@@ -37,7 +42,6 @@ import System.IO.Unsafe         ( unsafeInterleaveIO ) import Control.Concurrent.MVar import Control.Exception (mask_)-import Data.Typeable  #define _UPK_(x) {-# UNPACK #-} !(x) @@ -49,7 +53,7 @@ data Chan a  = Chan _UPK_(MVar (Stream a))         _UPK_(MVar (Stream a)) -- Invariant: the Stream a is always an empty MVar-   deriving (Eq,Typeable)+   deriving (Eq)  type Stream a = MVar (ChItem a) 

@@ -270,5 +270,5 @@ -- -- @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 #)+mkWeakMVar m@(MVar m#) (IO f) = IO $ \s ->+    case mkWeak# m# m f s of (# s1, w #) -> (# s1, Weak w #)

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

@@ -1,5 +1,5 @@ {-# LANGUAGE Safe #-}-{-# LANGUAGE AutoDeriveTypeable, BangPatterns #-}+{-# LANGUAGE BangPatterns #-} {-# OPTIONS_GHC -funbox-strict-fields #-}  -----------------------------------------------------------------------------@@ -28,7 +28,6 @@ import Control.Concurrent.MVar ( MVar, newEmptyMVar, takeMVar, tryTakeMVar                           , putMVar, newMVar                           , tryPutMVar, isEmptyMVar)-import Data.Typeable import Control.Exception import Data.Maybe @@ -43,7 +42,6 @@ -- is safe; it never loses any of the resource. -- data QSemN = QSemN !(MVar (Int, [(Int, MVar ())], [(Int, MVar ())]))-  deriving Typeable  -- The semaphore state (i, xs, ys): --

@@ -56,6 +56,7 @@         RecSelError(..),         RecUpdError(..),         ErrorCall(..),+        TypeError(..),          -- * Throwing exceptions         throw,@@ -105,6 +106,7 @@         uninterruptibleMask_,         MaskingState(..),         getMaskingState,+        interruptible,         allowInterrupt,          -- *** Applying @mask@ to an exception handler@@ -133,7 +135,7 @@ import Control.Exception.Base  import GHC.Base-import GHC.IO (unsafeUnmask)+import GHC.IO (interruptible)  -- | You need this when using 'catches'. data Handler a = forall e . Exception e => Handler (e -> IO a)@@ -214,14 +216,14 @@ -- | 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.+-- #interruptible), but does not involve any actual blocking. -- -- When called outside 'mask', or inside 'uninterruptibleMask', this -- function has no effect. -- -- @since 4.4.0.0 allowInterrupt :: IO ()-allowInterrupt = unsafeUnmask $ return ()+allowInterrupt = interruptible $ return ()  {- $async 

@@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, MagicHash #-}-{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}  ----------------------------------------------------------------------------- -- |@@ -39,6 +39,7 @@         RecSelError(..),         RecUpdError(..),         ErrorCall(..),+        TypeError(..), -- #10284, custom error type for deferred type errors          -- * Throwing exceptions         throwIO,@@ -92,7 +93,7 @@         -- * Calls for GHC runtime         recSelError, recConError, irrefutPatError, runtimeError,         nonExhaustiveGuardsError, patError, noMethodBindingError,-        absentError,+        absentError, typeError,         nonTermination, nestedAtomically,   ) where @@ -104,7 +105,6 @@ -- import GHC.Exception hiding ( Exception ) import GHC.Conc.Sync -import Data.Dynamic import Data.Either  -----------------------------------------------------------------------------@@ -147,7 +147,7 @@         => IO a         -- ^ The computation to run         -> (e -> IO a)  -- ^ Handler to invoke if an exception is raised         -> IO a-catch = catchException+catch act = catchException (lazy act)  -- | The function 'catchJust' is like 'catch', but it takes an extra -- argument which is an /exception predicate/, a function which@@ -297,7 +297,7 @@  -- |A pattern match failed. The @String@ gives information about the -- source location of the pattern.-data PatternMatchFail = PatternMatchFail String deriving Typeable+newtype PatternMatchFail = PatternMatchFail String  instance Show PatternMatchFail where     showsPrec _ (PatternMatchFail err) = showString err@@ -311,7 +311,7 @@ -- multiple constructors, where some fields are in one constructor -- but not another. The @String@ gives information about the source -- location of the record selector.-data RecSelError = RecSelError String deriving Typeable+newtype RecSelError = RecSelError String  instance Show RecSelError where     showsPrec _ (RecSelError err) = showString err@@ -323,7 +323,7 @@ -- |An uninitialised record field was used. The @String@ gives -- information about the source location where the record was -- constructed.-data RecConError = RecConError String deriving Typeable+newtype RecConError = RecConError String  instance Show RecConError where     showsPrec _ (RecConError err) = showString err@@ -337,7 +337,7 @@ -- multiple constructors, where some fields are in one constructor -- but not another. The @String@ gives information about the source -- location of the record update.-data RecUpdError = RecUpdError String deriving Typeable+newtype RecUpdError = RecUpdError String  instance Show RecUpdError where     showsPrec _ (RecUpdError err) = showString err@@ -349,7 +349,7 @@ -- |A class method without a definition (neither a default definition, -- nor a definition in the appropriate instance) was called. The -- @String@ gives information about which method it was.-data NoMethodError = NoMethodError String deriving Typeable+newtype NoMethodError = NoMethodError String  instance Show NoMethodError where     showsPrec _ (NoMethodError err) = showString err@@ -358,11 +358,25 @@  ----- +-- |An expression that didn't typecheck during compile time was called.+-- This is only possible with -fdefer-type-errors. The @String@ gives+-- details about the failed type check.+--+-- @since 4.9.0.0+newtype TypeError = TypeError String++instance Show TypeError where+    showsPrec _ (TypeError err) = showString err++instance Exception TypeError++-----+ -- |Thrown when the runtime system detects that the computation is -- guaranteed not to terminate. Note that there is no guarantee that -- the runtime system will notice whether any given computation is -- guaranteed to terminate or not.-data NonTermination = NonTermination deriving Typeable+data NonTermination = NonTermination  instance Show NonTermination where     showsPrec _ NonTermination = showString "<<loop>>"@@ -373,7 +387,7 @@  -- |Thrown when the program attempts to call @atomically@, from the @stm@ -- package, inside another call to @atomically@.-data NestedAtomically = NestedAtomically deriving Typeable+data NestedAtomically = NestedAtomically  instance Show NestedAtomically where     showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested"@@ -384,19 +398,20 @@  recSelError, recConError, irrefutPatError, runtimeError,   nonExhaustiveGuardsError, patError, noMethodBindingError,-  absentError+  absentError, typeError         :: Addr# -> a   -- All take a UTF8-encoded C string  recSelError              s = throw (RecSelError ("No match in record selector "                                                  ++ unpackCStringUtf8# s))  -- No location info unfortunately-runtimeError             s = error (unpackCStringUtf8# s)                   -- No location info unfortunately-absentError              s = error ("Oops!  Entered absent arg " ++ unpackCStringUtf8# s)+runtimeError             s = errorWithoutStackTrace (unpackCStringUtf8# s)                   -- No location info unfortunately+absentError              s = errorWithoutStackTrace ("Oops!  Entered absent arg " ++ unpackCStringUtf8# s)  nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in")) irrefutPatError          s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern")) recConError              s = throw (RecConError      (untangle s "Missing field in record construction")) noMethodBindingError     s = throw (NoMethodError    (untangle s "No instance nor default method for class operation")) patError                 s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))+typeError                s = throw (TypeError        (unpackCStringUtf8# s))  -- GHC's RTS calls this nonTermination :: SomeException

@@ -75,12 +75,13 @@     , (<$!>)     ) where -import Data.Foldable ( Foldable, sequence_, msum, mapM_, foldlM, forM_ )-import Data.Functor ( void )-import Data.Traversable ( forM, mapM, sequence )+import Data.Foldable ( Foldable, sequence_, sequenceA_, msum, mapM_, foldlM, forM_ )+import Data.Functor ( void, (<$>) )+import Data.Traversable ( forM, mapM, traverse, sequence, sequenceA )  import GHC.Base hiding ( mapM, sequence )-import GHC.List ( zipWith, unzip, replicate )+import GHC.List ( zipWith, unzip )+import GHC.Num  ( (-) )  -- ----------------------------------------------------------------------------- -- Functions mandated by the Prelude@@ -94,13 +95,8 @@ -- | This generalizes the list-based 'filter' function.  {-# INLINE filterM #-}-filterM          :: (Monad m) => (a -> m Bool) -> [a] -> m [a]-filterM p        = foldr go (return [])-  where-    go x r = do-      flg <- p x-      ys <- r-      return (if flg then x:ys else ys)+filterM          :: (Applicative m) => (a -> m Bool) -> [a] -> m [a]+filterM p        = foldr (\ x -> liftA2 (\ flg -> if flg then (x:) else id) (p x)) (pure [])  infixr 1 <=<, >=> @@ -108,14 +104,19 @@ (>=>)       :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c) f >=> g     = \x -> f x >>= g --- | Right-to-left Kleisli composition of monads. @('>=>')@, with the arguments flipped+-- | Right-to-left Kleisli composition of monads. @('>=>')@, with the arguments flipped.+--+-- Note how this operator resembles function composition @('.')@:+--+-- > (.)   ::            (b ->   c) -> (a ->   b) -> a ->   c+-- > (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c (<=<)       :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c) (<=<)       = flip (>=>)  -- | @'forever' act@ repeats the action infinitely.-forever     :: (Monad m) => m a -> m b+forever     :: (Applicative f) => f a -> f b {-# INLINE forever #-}-forever a   = let a' = a >> a' in a'+forever a   = let a' = a *> a' in a' -- Use explicit sharing here, as it is prevents a space leak regardless of -- optimizations. @@ -125,19 +126,19 @@ -- | 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])+mapAndUnzipM      :: (Applicative m) => (a -> m (b,c)) -> [a] -> m ([b], [c]) {-# INLINE mapAndUnzipM #-}-mapAndUnzipM f xs =  sequence (map f xs) >>= return . unzip+mapAndUnzipM f xs =  unzip <$> traverse f xs --- | The 'zipWithM' function generalizes 'zipWith' to arbitrary monads.-zipWithM          :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]+-- | The 'zipWithM' function generalizes 'zipWith' to arbitrary applicative functors.+zipWithM          :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m [c] {-# INLINE zipWithM #-}-zipWithM f xs ys  =  sequence (zipWith f xs ys)+zipWithM f xs ys  =  sequenceA (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 ()+zipWithM_         :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m () {-# INLINE zipWithM_ #-}-zipWithM_ f xs ys =  sequence_ (zipWith f xs ys)+zipWithM_ f xs ys =  sequenceA_ (zipWith f xs ys)  {- | The 'foldM' function is analogous to 'foldl', except that its result is encapsulated in a monad. Note that 'foldM' works from left-to-right over@@ -173,20 +174,55 @@ {-# SPECIALISE foldM_ :: (a -> b -> Maybe a) -> a -> [b] -> Maybe () #-} foldM_ f a xs  = foldlM f a xs >> return () +{-+Note [Worker/wrapper transform on replicateM/replicateM_+--------------------------------------------------------++The implementations of replicateM and replicateM_ both leverage the+worker/wrapper transform. The simpler implementation of replicateM_, as an+example, would be:++    replicateM_ 0 _ = pure ()+    replicateM_ n f = f *> replicateM_ (n - 1) f++However, the self-recrusive nature of this implementation inhibits inlining,+which means we never get to specialise to the action (`f` in the code above).+By contrast, the implementation below with a local loop makes it possible to+inline the entire definition (as hapens for foldr, for example) thereby+specialising for the particular action.++For further information, see this Trac comment, which includes side-by-side+Core.++https://ghc.haskell.org/trac/ghc/ticket/11795#comment:6++-}+ -- | @'replicateM' n act@ performs the action @n@ times, -- gathering the results.-replicateM        :: (Monad m) => Int -> m a -> m [a]+replicateM        :: (Applicative 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)+replicateM cnt0 f =+    loop cnt0+  where+    loop cnt+        | cnt <= 0  = pure []+        | otherwise = liftA2 (:) f (loop (cnt - 1))  -- | Like 'replicateM', but discards the result.-replicateM_       :: (Monad m) => Int -> m a -> m ()+replicateM_       :: (Applicative 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)+replicateM_ cnt0 f =+    loop cnt0+  where+    loop cnt+        | cnt <= 0  = pure ()+        | otherwise = f *> loop (cnt - 1)+  -- | The reverse of 'when'. unless            :: (Applicative f) => Bool -> f () -> f ()

@@ -0,0 +1,78 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- |+-- Module      :  Control.Monad.Fail+-- Copyright   :  (C) 2015 David Luposchainsky,+--                (C) 2015 Herbert Valerio Riedel+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- Transitional module providing the 'MonadFail' class and primitive+-- instances.+--+-- This module can be imported for defining forward compatible+-- 'MonadFail' instances:+--+-- @+-- import qualified Control.Monad.Fail as Fail+--+-- instance Monad Foo where+--   (>>=) = {- ...bind impl... -}+--+--   -- Provide legacy 'fail' implementation for when+--   -- new-style MonadFail desugaring is not enabled.+--   fail = Fail.fail+--+-- instance Fail.MonadFail Foo where+--   fail = {- ...fail implementation... -}+-- @+--+-- See <https://prime.haskell.org/wiki/Libraries/Proposals/MonadFail>+-- for more details.+--+-- @since 4.9.0.0+--+module Control.Monad.Fail ( MonadFail(fail) ) where++import GHC.Base (String, Monad(), Maybe(Nothing), IO())+import {-# SOURCE #-} GHC.IO (failIO)++-- | When a value is bound in @do@-notation, the pattern on the left+-- hand side of @<-@ might not match. In this case, this class+-- provides a function to recover.+--+-- A 'Monad' without a 'MonadFail' instance may only be used in conjunction+-- with pattern that always match, such as newtypes, tuples, data types with+-- only a single data constructor, and irrefutable patterns (@~pat@).+--+-- Instances of 'MonadFail' should satisfy the following law: @fail s@ should+-- be a left zero for '>>=',+--+-- @+-- fail s >>= f  =  fail s+-- @+--+-- If your 'Monad' is also 'MonadPlus', a popular definition is+--+-- @+-- fail _ = mzero+-- @+--+-- @since 4.9.0.0+class Monad m => MonadFail m where+    fail :: String -> m a+++instance MonadFail Maybe where+    fail _ = Nothing++instance MonadFail [] where+    {-# INLINE fail #-}+    fail _ = []++instance MonadFail IO where+    fail = failIO

@@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeOperators #-}  ----------------------------------------------------------------------------- -- |@@ -26,7 +27,10 @@ import Data.Either import Data.Function ( fix ) import Data.Maybe-import GHC.Base ( Monad, error, (.) )+import Data.Monoid ( Dual(..), Sum(..), Product(..)+                   , First(..), Last(..), Alt(..) )+import GHC.Base ( Monad, errorWithoutStackTrace, (.) )+import GHC.Generics import GHC.List ( head, tail ) import GHC.ST import System.IO@@ -61,7 +65,7 @@ instance MonadFix Maybe where     mfix f = let a = f (unJust a) in a              where unJust (Just x) = x-                   unJust Nothing  = error "mfix Maybe: Nothing"+                   unJust Nothing  = errorWithoutStackTrace "mfix Maybe: Nothing"  instance MonadFix [] where     mfix f = case fix (f . head) of@@ -77,7 +81,43 @@ instance MonadFix (Either e) where     mfix f = let a = f (unRight a) in a              where unRight (Right x) = x-                   unRight (Left  _) = error "mfix Either: Left"+                   unRight (Left  _) = errorWithoutStackTrace "mfix Either: Left"  instance MonadFix (ST s) where         mfix = fixST++-- Instances of Data.Monoid wrappers++instance MonadFix Dual where+    mfix f   = Dual (fix (getDual . f))++instance MonadFix Sum where+    mfix f   = Sum (fix (getSum . f))++instance MonadFix Product where+    mfix f   = Product (fix (getProduct . f))++instance MonadFix First where+    mfix f   = First (mfix (getFirst . f))++instance MonadFix Last where+    mfix f   = Last (mfix (getLast . f))++instance MonadFix f => MonadFix (Alt f) where+    mfix f   = Alt (mfix (getAlt . f))++-- Instances for GHC.Generics+instance MonadFix Par1 where+    mfix f = Par1 (fix (unPar1 . f))++instance MonadFix f => MonadFix (Rec1 f) where+    mfix f = Rec1 (mfix (unRec1 . f))++instance MonadFix f => MonadFix (M1 i c f) where+    mfix f = M1 (mfix (unM1. f))++instance (MonadFix f, MonadFix g) => MonadFix (f :*: g) where+    mfix f = (mfix (fstP . f)) :*: (mfix (sndP . f))+      where+        fstP (a :*: _) = a+        sndP (_ :*: b) = b

@@ -0,0 +1,36 @@+{-# LANGUAGE Safe #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.IO.Class+-- Copyright   :  (c) Andy Gill 2001,+--                (c) Oregon Graduate Institute of Science and Technology, 2001+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  R.Paterson@city.ac.uk+-- Stability   :  experimental+-- Portability :  portable+--+-- Class of monads based on @IO@.+-----------------------------------------------------------------------------++module Control.Monad.IO.Class (+    MonadIO(..)+  ) where++-- | Monads in which 'IO' computations may be embedded.+-- Any monad built by applying a sequence of monad transformers to the+-- 'IO' monad will be an instance of this class.+--+-- Instances should satisfy the following laws, which state that 'liftIO'+-- is a transformer of monads:+--+-- * @'liftIO' . 'return' = 'return'@+--+-- * @'liftIO' (m >>= f) = 'liftIO' m >>= ('liftIO' . f)@++class (Monad m) => MonadIO m where+    -- | Lift a computation from the 'IO' monad.+    liftIO :: IO a -> m a++instance MonadIO IO where+    liftIO = id

@@ -71,14 +71,12 @@       (f r,new_s)  instance Applicative (ST s) where-    pure = return+    pure a = ST $ \ s -> (a,s)     (<*>) = ap  instance Monad (ST s) where -        return a = ST $ \ s -> (a,s)-        m >> k   =  m >>= \ _ -> k-        fail s   = error s+        fail s   = errorWithoutStackTrace s          (ST m) >>= k          = ST $ \ s ->

@@ -1,4 +1,5 @@ {-# LANGUAGE Safe #-}+{-# LANGUAGE TypeOperators #-}  ----------------------------------------------------------------------------- -- |@@ -17,7 +18,10 @@  module Control.Monad.Zip where -import Control.Monad (liftM)+import Control.Monad (liftM, liftM2)+import Data.Monoid+import Data.Proxy+import GHC.Generics  -- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith` --@@ -53,3 +57,43 @@     mzipWith = zipWith     munzip   = unzip +instance MonadZip Dual where+    -- Cannot use coerce, it's unsafe+    mzipWith = liftM2++instance MonadZip Sum where+    mzipWith = liftM2++instance MonadZip Product where+    mzipWith = liftM2++instance MonadZip Maybe where+    mzipWith = liftM2++instance MonadZip First where+    mzipWith = liftM2++instance MonadZip Last where+    mzipWith = liftM2++instance MonadZip f => MonadZip (Alt f) where+    mzipWith f (Alt ma) (Alt mb) = Alt (mzipWith f ma mb)++instance MonadZip Proxy where+    mzipWith _ _ _ = Proxy++-- Instances for GHC.Generics+instance MonadZip U1 where+    mzipWith _ _ _ = U1++instance MonadZip Par1 where+    mzipWith = liftM2++instance MonadZip f => MonadZip (Rec1 f) where+    mzipWith f (Rec1 fa) (Rec1 fb) = Rec1 (mzipWith f fa fb)++instance MonadZip f => MonadZip (M1 i c f) where+    mzipWith f (M1 fa) (M1 fb) = M1 (mzipWith f fa fb)++instance (MonadZip f, MonadZip g) => MonadZip (f :*: g) where+    mzipWith f (x1 :*: y1) (x2 :*: y2) = mzipWith f x1 x2 :*: mzipWith f y1 y2

@@ -18,6 +18,7 @@   ) where  import Control.Applicative  ( Const(..) )+import GHC.Generics ( K1(..) )  -- | Formally, the class 'Bifunctor' represents a bifunctor -- from @Hask@ -> @Hask@.@@ -99,3 +100,6 @@  instance Bifunctor Const where     bimap f _ (Const a) = Const (f a)++instance Bifunctor (K1 i) where+    bimap f _ (K1 c) = K1 (f c)

@@ -515,15 +515,7 @@    complement = complementInteger    shift x i@(I# i#) | i >= 0    = shiftLInteger x i#                      | otherwise = shiftRInteger x (negateInt# i#)-   shiftL x i@(I# i#)-     | i < 0        = error "Bits.shiftL(Integer): negative shift"-     | otherwise    = shiftLInteger x i#-   shiftR x i@(I# i#)-     | i < 0        = error "Bits.shiftR(Integer): negative shift"-     | otherwise    = shiftRInteger x i#-    testBit x (I# i) = testBitInteger x i-    zeroBits   = 0  #if HAVE_INTEGER_GMP1@@ -537,7 +529,7 @@    rotate x i = shift x i   -- since an Integer never wraps around     bitSizeMaybe _ = Nothing-   bitSize _  = error "Data.Bits.bitSize(Integer)"+   bitSize _  = errorWithoutStackTrace "Data.Bits.bitSize(Integer)"    isSigned _ = True  -----------------------------------------------------------------------------

@@ -53,14 +53,12 @@     ) where  import GHC.Base-import GHC.Arr (Ix) import GHC.Char import GHC.Real (fromIntegral) import GHC.Show-import GHC.Read (Read, readLitChar, lexLitChar)+import GHC.Read (readLitChar, lexLitChar) import GHC.Unicode import GHC.Num-import GHC.Enum  -- $setup -- Allow the use of Prelude in doctests.@@ -99,127 +97,12 @@   | (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+  | otherwise = errorWithoutStackTrace ("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-        | TitlecaseLetter       -- ^ Lt: Letter, Titlecase-        | ModifierLetter        -- ^ Lm: Letter, Modifier-        | OtherLetter           -- ^ Lo: Letter, Other-        | NonSpacingMark        -- ^ Mn: Mark, Non-Spacing-        | SpacingCombiningMark  -- ^ Mc: Mark, Spacing Combining-        | EnclosingMark         -- ^ Me: Mark, Enclosing-        | DecimalNumber         -- ^ Nd: Number, Decimal-        | LetterNumber          -- ^ Nl: Number, Letter-        | OtherNumber           -- ^ No: Number, Other-        | ConnectorPunctuation  -- ^ Pc: Punctuation, Connector-        | DashPunctuation       -- ^ Pd: Punctuation, Dash-        | OpenPunctuation       -- ^ Ps: Punctuation, Open-        | ClosePunctuation      -- ^ Pe: Punctuation, Close-        | InitialQuote          -- ^ Pi: Punctuation, Initial quote-        | FinalQuote            -- ^ Pf: Punctuation, Final quote-        | OtherPunctuation      -- ^ Po: Punctuation, Other-        | MathSymbol            -- ^ Sm: Symbol, Math-        | CurrencySymbol        -- ^ Sc: Symbol, Currency-        | ModifierSymbol        -- ^ Sk: Symbol, Modifier-        | OtherSymbol           -- ^ So: Symbol, Other-        | Space                 -- ^ Zs: Separator, Space-        | LineSeparator         -- ^ Zl: Separator, Line-        | ParagraphSeparator    -- ^ Zp: Separator, Paragraph-        | Control               -- ^ Cc: Other, Control-        | Format                -- ^ Cf: Other, Format-        | Surrogate             -- ^ Cs: Other, Surrogate-        | PrivateUse            -- ^ Co: Other, Private Use-        | NotAssigned           -- ^ Cn: Other, Not Assigned-        deriving (Eq, Ord, Enum, Read, Show, Bounded, Ix)---- | 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@@ -358,96 +241,6 @@         DecimalNumber           -> True         LetterNumber            -> True         OtherNumber             -> True-        _                       -> False---- | 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-        DashPunctuation         -> True-        OpenPunctuation         -> True-        ClosePunctuation        -> True-        InitialQuote            -> True-        FinalQuote              -> True-        OtherPunctuation        -> True-        _                       -> False---- | 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-        CurrencySymbol          -> True-        ModifierSymbol          -> True-        OtherSymbol             -> True         _                       -> False  -- | Selects Unicode space and separator characters.

@@ -26,5 +26,4 @@ import GHC.Prim (coerce) import GHC.Types (Coercible) -import GHC.Base () -- for build ordering-+import GHC.Base () -- for build ordering; see Notes in GHC.Base for more info

@@ -1,6 +1,8 @@+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}  ----------------------------------------------------------------------------- -- |@@ -34,7 +36,8 @@          )  where -import Data.Typeable+import GHC.Generics (Generic, Generic1)+import GHC.Float (Floating(..)) import Data.Data (Data) import Foreign (Storable, castPtr, peek, poke, pokeElemOff, peekElemOff, sizeOf,                 alignment)@@ -49,10 +52,13 @@ -- For a complex number @z@, @'abs' z@ is a number with the magnitude of @z@, -- but oriented in the positive real direction, whereas @'signum' z@ -- has the phase of @z@, but unit magnitude.+--+-- The 'Foldable' and 'Traversable' instances traverse the real part first. data Complex a   = !a :+ !a    -- ^ forms a complex number from its real and imaginary                 -- rectangular components.-        deriving (Eq, Show, Read, Data, Typeable)+        deriving (Eq, Show, Read, Data, Generic, Generic1+                , Functor, Foldable, Traversable)  -- ----------------------------------------------------------------------------- -- Functions over Complex@@ -140,6 +146,22 @@                       where expx = exp x     log z          =  log (magnitude z) :+ phase z +    x ** y = case (x,y) of+      (_ , (0:+0))  -> 1 :+ 0+      ((0:+0), (exp_re:+_)) -> case compare exp_re 0 of+                 GT -> 0 :+ 0+                 LT -> inf :+ 0+                 EQ -> nan :+ nan+      ((re:+im), (exp_re:+_))+        | (isInfinite re || isInfinite im) -> case compare exp_re 0 of+                 GT -> inf :+ 0+                 LT -> 0 :+ 0+                 EQ -> nan :+ nan+        | otherwise -> exp (log x * y)+      where+        inf = 1/0+        nan = 0/0+     sqrt (0:+0)    =  0     sqrt z@(x:+y)  =  u :+ (if y < 0 then -v else v)                       where (u,v) = if x < 0 then (v',u') else (u',v')@@ -174,6 +196,20 @@     acosh z        =  log (z + (z+1) * sqrt ((z-1)/(z+1)))     atanh z        =  0.5 * log ((1.0+z) / (1.0-z)) +    log1p x@(a :+ b)+      | abs a < 0.5 && abs b < 0.5+      , u <- 2*a + a*a + b*b = log1p (u/(1 + sqrt(u+1))) :+ atan2 (1 + a) b+      | otherwise = log (1 + x)+    {-# INLINE log1p #-}++    expm1 x@(a :+ b)+      | a*a + b*b < 1+      , u <- expm1 a+      , v <- sin (b/2)+      , w <- -2*v*v = (u*w + u + w) :+ (u+1)*sin b+      | otherwise = exp x - 1+    {-# INLINE expm1 #-}+ instance Storable a => Storable (Complex a) where     sizeOf a       = 2 * sizeOf (realPart a)     alignment a    = alignment (realPart a)@@ -186,3 +222,10 @@                         q <-return $  (castPtr p)                         poke q r                         pokeElemOff q 1 i++instance Applicative Complex where+  pure a = a :+ a+  f :+ g <*> a :+ b = f a :+ g b++instance Monad Complex where+  a :+ b >>= f = realPart (f a) :+ imagPart (f b)

@@ -1,7 +1,9 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE RankNTypes, ScopedTypeVariables, PolyKinds, StandaloneDeriving,-             AutoDeriveTypeable, TypeOperators, GADTs, FlexibleInstances #-}+             TypeOperators, GADTs, FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE BangPatterns #-}  ----------------------------------------------------------------------------- -- |@@ -109,10 +111,11 @@ import Data.Either import Data.Eq import Data.Maybe+import Data.Monoid import Data.Ord import Data.Typeable import Data.Version( Version(..) )-import GHC.Base+import GHC.Base hiding (Any, IntRep, FloatRep) import GHC.List import GHC.Num import GHC.Read@@ -131,7 +134,9 @@ --import GHC.ST                -- So we can give Data instance for ST --import GHC.Conc              -- So we can give Data instance for MVar & Co. import GHC.Arr               -- So we can give Data instance for Array-+import qualified GHC.Generics as Generics (Fixity(..))+import GHC.Generics hiding (Fixity(..))+                             -- So we can give Data instance for U1, V1, ...  ------------------------------------------------------------------------------ --@@ -442,7 +447,7 @@  -- | Build a term skeleton fromConstr :: Data a => Constr -> a-fromConstr = fromConstrB (error "Data.Data.fromConstr")+fromConstr = fromConstrB (errorWithoutStackTrace "Data.Data.fromConstr")   -- | Build a term and use a generic function for subterms@@ -580,7 +585,7 @@         (IntRep,    IntConstr i)      -> mkIntegralConstr dt i         (FloatRep,  FloatConstr f)    -> mkRealConstr dt f         (CharRep,   CharConstr c)     -> mkCharConstr dt c-        _ -> error "Data.Data.repConstr: The given ConstrRep does not fit to the given DataType."+        _ -> errorWithoutStackTrace "Data.Data.repConstr: The given ConstrRep does not fit to the given DataType."   @@ -618,7 +623,7 @@ dataTypeConstrs :: DataType -> [Constr] dataTypeConstrs dt = case datarep dt of                         (AlgRep cons) -> cons-                        _ -> error $ "Data.Data.dataTypeConstrs is not supported for "+                        _ -> errorWithoutStackTrace $ "Data.Data.dataTypeConstrs is not supported for "                                     ++ dataTypeName dt ++                                     ", as it is not an algebraic data type." @@ -693,7 +698,7 @@ indexConstr :: DataType -> ConIndex -> Constr indexConstr dt idx = case datarep dt of                         (AlgRep cs) -> cs !! (idx-1)-                        _           -> error $ "Data.Data.indexConstr is not supported for "+                        _           -> errorWithoutStackTrace $ "Data.Data.indexConstr is not supported for "                                                ++ dataTypeName dt ++                                                ", as it is not an algebraic data type." @@ -702,7 +707,7 @@ constrIndex :: Constr -> ConIndex constrIndex con = case constrRep con of                     (AlgConstr idx) -> idx-                    _ -> error $ "Data.Data.constrIndex is not supported for "+                    _ -> errorWithoutStackTrace $ "Data.Data.constrIndex is not supported for "                                  ++ dataTypeName (constrType con) ++                                  ", as it is not an algebraic data type." @@ -711,7 +716,7 @@ maxConstrIndex :: DataType -> ConIndex maxConstrIndex dt = case dataTypeRep dt of                         AlgRep cs -> length cs-                        _            -> error $ "Data.Data.maxConstrIndex is not supported for "+                        _            -> errorWithoutStackTrace $ "Data.Data.maxConstrIndex is not supported for "                                                  ++ dataTypeName dt ++                                                  ", as it is not an algebraic data type." @@ -753,21 +758,21 @@                         { datatype  = dt                         , conrep    = cr                         , constring = str-                        , confields = error "Data.Data.confields"-                        , confixity = error "Data.Data.confixity"+                        , confields = errorWithoutStackTrace "Data.Data.confields"+                        , confixity = errorWithoutStackTrace "Data.Data.confixity"                         }  mkIntegralConstr :: (Integral a, Show a) => DataType -> a -> Constr mkIntegralConstr dt i = case datarep dt of                   IntRep -> mkPrimCon dt (show i) (IntConstr (toInteger  i))-                  _ -> error $ "Data.Data.mkIntegralConstr is not supported for "+                  _ -> errorWithoutStackTrace $ "Data.Data.mkIntegralConstr is not supported for "                                ++ dataTypeName dt ++                                ", as it is not an Integral data type."  mkRealConstr :: (Real a, Show a) => DataType -> a -> Constr mkRealConstr dt f = case datarep dt of                     FloatRep -> mkPrimCon dt (show f) (FloatConstr (toRational f))-                    _ -> error $ "Data.Data.mkRealConstr is not supported for "+                    _ -> errorWithoutStackTrace $ "Data.Data.mkRealConstr is not supported for "                                  ++ dataTypeName dt ++                                  ", as it is not an Real data type." @@ -775,7 +780,7 @@ mkCharConstr :: DataType -> Char -> Constr mkCharConstr dt c = case datarep dt of                    CharRep -> mkPrimCon dt (show c) (CharConstr c)-                   _ -> error $ "Data.Data.mkCharConstr is not supported for "+                   _ -> errorWithoutStackTrace $ "Data.Data.mkCharConstr is not supported for "                                 ++ dataTypeName dt ++                                 ", as it is not an Char data type." @@ -854,7 +859,7 @@   gunfold _ z c  = case constrIndex c of                      1 -> z False                      2 -> z True-                     _ -> error $ "Data.Data.gunfold: Constructor "+                     _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor "                                   ++ show c                                   ++ " is not of type Bool."   dataTypeOf _ = boolDataType@@ -869,7 +874,7 @@   toConstr x = mkCharConstr charType x   gunfold _ z c = case constrRep c of                     (CharConstr x) -> z x-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Char."   dataTypeOf _ = charType @@ -883,7 +888,7 @@   toConstr = mkRealConstr floatType   gunfold _ z c = case constrRep c of                     (FloatConstr x) -> z (realToFrac x)-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Float."   dataTypeOf _ = floatType @@ -897,7 +902,7 @@   toConstr = mkRealConstr doubleType   gunfold _ z c = case constrRep c of                     (FloatConstr x) -> z (realToFrac x)-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Double."   dataTypeOf _ = doubleType @@ -911,7 +916,7 @@   toConstr x = mkIntegralConstr intType x   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Int."   dataTypeOf _ = intType @@ -925,7 +930,7 @@   toConstr = mkIntegralConstr integerType   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z x-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Integer."   dataTypeOf _ = integerType @@ -939,7 +944,7 @@   toConstr x = mkIntegralConstr int8Type x   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Int8."   dataTypeOf _ = int8Type @@ -953,7 +958,7 @@   toConstr x = mkIntegralConstr int16Type x   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Int16."   dataTypeOf _ = int16Type @@ -967,7 +972,7 @@   toConstr x = mkIntegralConstr int32Type x   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Int32."   dataTypeOf _ = int32Type @@ -981,7 +986,7 @@   toConstr x = mkIntegralConstr int64Type x   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Int64."   dataTypeOf _ = int64Type @@ -995,7 +1000,7 @@   toConstr x = mkIntegralConstr wordType x   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Word"   dataTypeOf _ = wordType @@ -1009,7 +1014,7 @@   toConstr x = mkIntegralConstr word8Type x   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Word8."   dataTypeOf _ = word8Type @@ -1023,7 +1028,7 @@   toConstr x = mkIntegralConstr word16Type x   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Word16."   dataTypeOf _ = word16Type @@ -1037,7 +1042,7 @@   toConstr x = mkIntegralConstr word32Type x   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Word32."   dataTypeOf _ = word32Type @@ -1051,7 +1056,7 @@   toConstr x = mkIntegralConstr word64Type x   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c                                  ++ " is not of type Word64."   dataTypeOf _ = word64Type @@ -1068,7 +1073,7 @@   gfoldl k z (a :% b) = z (%) `k` a `k` b   toConstr _ = ratioConstr   gunfold k z c | constrIndex c == 1 = k (k (z (%)))-  gunfold _ _ _ = error "Data.Data.gunfold(Ratio)"+  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(Ratio)"   dataTypeOf _  = ratioDataType  @@ -1090,7 +1095,7 @@   gunfold k z c = case constrIndex c of                     1 -> z []                     2 -> k (k (z (:)))-                    _ -> error "Data.Data.gunfold(List)"+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(List)"   dataTypeOf _ = listDataType   dataCast1 f  = gcast1 f @@ -1124,7 +1129,7 @@   gunfold k z c = case constrIndex c of                     1 -> z Nothing                     2 -> k (z Just)-                    _ -> error "Data.Data.gunfold(Maybe)"+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Maybe)"   dataTypeOf _ = maybeDataType   dataCast1 f  = gcast1 f @@ -1152,7 +1157,7 @@                     1 -> z LT                     2 -> z EQ                     3 -> z GT-                    _ -> error "Data.Data.gunfold(Ordering)"+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Ordering)"   dataTypeOf _ = orderingDataType  @@ -1175,7 +1180,7 @@   gunfold k z c = case constrIndex c of                     1 -> k (z Left)                     2 -> k (z Right)-                    _ -> error "Data.Data.gunfold(Either)"+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Either)"   dataTypeOf _ = eitherDataType   dataCast2 f  = gcast2 f @@ -1191,7 +1196,7 @@ instance Data () where   toConstr ()   = tuple0Constr   gunfold _ z c | constrIndex c == 1 = z ()-  gunfold _ _ _ = error "Data.Data.gunfold(unit)"+  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(unit)"   dataTypeOf _  = tuple0DataType  @@ -1207,7 +1212,7 @@   gfoldl f z (a,b) = z (,) `f` a `f` b   toConstr (_,_) = tuple2Constr   gunfold k z c | constrIndex c == 1 = k (k (z (,)))-  gunfold _ _ _ = error "Data.Data.gunfold(tup2)"+  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(tup2)"   dataTypeOf _  = tuple2DataType   dataCast2 f   = gcast2 f @@ -1224,7 +1229,7 @@   gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c   toConstr (_,_,_) = tuple3Constr   gunfold k z c | constrIndex c == 1 = k (k (k (z (,,))))-  gunfold _ _ _ = error "Data.Data.gunfold(tup3)"+  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(tup3)"   dataTypeOf _  = tuple3DataType  @@ -1242,7 +1247,7 @@   toConstr (_,_,_,_) = tuple4Constr   gunfold k z c = case constrIndex c of                     1 -> k (k (k (k (z (,,,)))))-                    _ -> error "Data.Data.gunfold(tup4)"+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(tup4)"   dataTypeOf _ = tuple4DataType  @@ -1260,7 +1265,7 @@   toConstr (_,_,_,_,_) = tuple5Constr   gunfold k z c = case constrIndex c of                     1 -> k (k (k (k (k (z (,,,,))))))-                    _ -> error "Data.Data.gunfold(tup5)"+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(tup5)"   dataTypeOf _ = tuple5DataType  @@ -1278,7 +1283,7 @@   toConstr (_,_,_,_,_,_) = tuple6Constr   gunfold k z c = case constrIndex c of                     1 -> k (k (k (k (k (k (z (,,,,,)))))))-                    _ -> error "Data.Data.gunfold(tup6)"+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(tup6)"   dataTypeOf _ = tuple6DataType  @@ -1297,34 +1302,34 @@   toConstr  (_,_,_,_,_,_,_) = tuple7Constr   gunfold k z c = case constrIndex c of                     1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))-                    _ -> error "Data.Data.gunfold(tup7)"+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(tup7)"   dataTypeOf _ = tuple7DataType   ------------------------------------------------------------------------------ -instance (Data a, Typeable a) => Data (Ptr a) where-  toConstr _   = error "Data.Data.toConstr(Ptr)"-  gunfold _ _  = error "Data.Data.gunfold(Ptr)"+instance Data a => Data (Ptr a) where+  toConstr _   = errorWithoutStackTrace "Data.Data.toConstr(Ptr)"+  gunfold _ _  = errorWithoutStackTrace "Data.Data.gunfold(Ptr)"   dataTypeOf _ = mkNoRepType "GHC.Ptr.Ptr"   dataCast1 x  = gcast1 x  ------------------------------------------------------------------------------ -instance (Data a, Typeable a) => Data (ForeignPtr a) where-  toConstr _   = error "Data.Data.toConstr(ForeignPtr)"-  gunfold _ _  = error "Data.Data.gunfold(ForeignPtr)"+instance Data a => Data (ForeignPtr a) where+  toConstr _   = errorWithoutStackTrace "Data.Data.toConstr(ForeignPtr)"+  gunfold _ _  = errorWithoutStackTrace "Data.Data.gunfold(ForeignPtr)"   dataTypeOf _ = mkNoRepType "GHC.ForeignPtr.ForeignPtr"   dataCast1 x  = gcast1 x  ------------------------------------------------------------------------------ -- 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)+instance (Data a, Data b, Ix a) => Data (Array a b)  where   gfoldl f z a = z (listArray (bounds a)) `f` (elems a)-  toConstr _   = error "Data.Data.toConstr(Array)"-  gunfold _ _  = error "Data.Data.gunfold(Array)"+  toConstr _   = errorWithoutStackTrace "Data.Data.toConstr(Array)"+  gunfold _ _  = errorWithoutStackTrace "Data.Data.gunfold(Array)"   dataTypeOf _ = mkNoRepType "Data.Array.Array"   dataCast2 x  = gcast2 x @@ -1342,7 +1347,7 @@   toConstr Proxy  = proxyConstr   gunfold _ z c = case constrIndex c of                     1 -> z Proxy-                    _ -> error "Data.Data.gunfold(Proxy)"+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Proxy)"   dataTypeOf _ = proxyDataType   dataCast1 f  = gcast1 f @@ -1360,7 +1365,7 @@   toConstr Refl   = reflConstr   gunfold _ z c   = case constrIndex c of                       1 -> z Refl-                      _ -> error "Data.Data.gunfold(:~:)"+                      _ -> errorWithoutStackTrace "Data.Data.gunfold(:~:)"   dataTypeOf _    = equalityDataType   dataCast2 f     = gcast2 f @@ -1378,7 +1383,7 @@   toConstr Coercion = coercionConstr   gunfold _ z c   = case constrIndex c of                       1 -> z Coercion-                      _ -> error "Data.Data.gunfold(Coercion)"+                      _ -> errorWithoutStackTrace "Data.Data.gunfold(Coercion)"   dataTypeOf _    = coercionDataType   dataCast2 f     = gcast2 f @@ -1396,5 +1401,418 @@   toConstr (Version _ _) = versionConstr   gunfold k z c = case constrIndex c of                     1 -> k (k (z Version))-                    _ -> error "Data.Data.gunfold(Version)"+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Version)"   dataTypeOf _  = versionDataType++-----------------------------------------------------------------------+-- instances for Data.Monoid wrappers++dualConstr :: Constr+dualConstr = mkConstr dualDataType "Dual" ["getDual"] Prefix++dualDataType :: DataType+dualDataType = mkDataType "Data.Monoid.Dual" [dualConstr]++instance Data a => Data (Dual a) where+  gfoldl f z (Dual x) = z Dual `f` x+  gunfold k z _ = k (z Dual)+  toConstr (Dual _) = dualConstr+  dataTypeOf _ = dualDataType+  dataCast1 f = gcast1 f++allConstr :: Constr+allConstr = mkConstr allDataType "All" ["getAll"] Prefix++allDataType :: DataType+allDataType = mkDataType "All" [allConstr]++instance Data All where+  gfoldl f z (All x) = (z All `f` x)+  gunfold k z _ = k (z All)+  toConstr (All _) = allConstr+  dataTypeOf _ = allDataType++anyConstr :: Constr+anyConstr = mkConstr anyDataType "Any" ["getAny"] Prefix++anyDataType :: DataType+anyDataType = mkDataType "Any" [anyConstr]++instance Data Any where+  gfoldl f z (Any x) = (z Any `f` x)+  gunfold k z _ = k (z Any)+  toConstr (Any _) = anyConstr+  dataTypeOf _ = anyDataType+++sumConstr :: Constr+sumConstr = mkConstr sumDataType "Sum" ["getSum"] Prefix++sumDataType :: DataType+sumDataType = mkDataType "Data.Monoid.Sum" [sumConstr]++instance Data a => Data (Sum a) where+  gfoldl f z (Sum x) = z Sum `f` x+  gunfold k z _ = k (z Sum)+  toConstr (Sum _) = sumConstr+  dataTypeOf _ = sumDataType+  dataCast1 f = gcast1 f+++productConstr :: Constr+productConstr = mkConstr productDataType "Product" ["getProduct"] Prefix++productDataType :: DataType+productDataType = mkDataType "Data.Monoid.Product" [productConstr]++instance Data a => Data (Product a) where+  gfoldl f z (Product x) = z Product `f` x+  gunfold k z _ = k (z Product)+  toConstr (Product _) = productConstr+  dataTypeOf _ = productDataType+  dataCast1 f = gcast1 f+++firstConstr :: Constr+firstConstr = mkConstr firstDataType "First" ["getFirst"] Prefix++firstDataType :: DataType+firstDataType = mkDataType "Data.Monoid.First" [firstConstr]++instance Data a => Data (First a) where+  gfoldl f z (First x) = (z First `f` x)+  gunfold k z _ = k (z First)+  toConstr (First _) = firstConstr+  dataTypeOf _ = firstDataType+  dataCast1 f = gcast1 f+++lastConstr :: Constr+lastConstr = mkConstr lastDataType "Last" ["getLast"] Prefix++lastDataType :: DataType+lastDataType = mkDataType "Data.Monoid.Last" [lastConstr]++instance Data a => Data (Last a) where+  gfoldl f z (Last x) = (z Last `f` x)+  gunfold k z _ = k (z Last)+  toConstr (Last _) = lastConstr+  dataTypeOf _ = lastDataType+  dataCast1 f = gcast1 f+++altConstr :: Constr+altConstr = mkConstr altDataType "Alt" ["getAlt"] Prefix++altDataType :: DataType+altDataType = mkDataType "Alt" [altConstr]++instance (Data (f a), Data a, Typeable f) => Data (Alt f a) where+  gfoldl f z (Alt x) = (z Alt `f` x)+  gunfold k z _ = k (z Alt)+  toConstr (Alt _) = altConstr+  dataTypeOf _ = altDataType++-----------------------------------------------------------------------+-- instances for GHC.Generics++u1Constr :: Constr+u1Constr = mkConstr u1DataType "U1" [] Prefix++u1DataType :: DataType+u1DataType = mkDataType "GHC.Generics.U1" [u1Constr]++instance Data p => Data (U1 p) where+  gfoldl _ z U1 = z U1+  toConstr U1 = u1Constr+  gunfold _ z c = case constrIndex c of+                    1 -> z U1+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(U1)"+  dataTypeOf _  = u1DataType+  dataCast1 f = gcast1 f++-----------------------------------------------------------------------++par1Constr :: Constr+par1Constr = mkConstr par1DataType "Par1" [] Prefix++par1DataType :: DataType+par1DataType = mkDataType "GHC.Generics.Par1" [par1Constr]++instance Data p => Data (Par1 p) where+  gfoldl k z (Par1 p) = z Par1 `k` p+  toConstr (Par1 _) = par1Constr+  gunfold k z c = case constrIndex c of+                    1 -> k (z Par1)+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Par1)"+  dataTypeOf _  = par1DataType+  dataCast1 f = gcast1 f++-----------------------------------------------------------------------++rec1Constr :: Constr+rec1Constr = mkConstr rec1DataType "Rec1" [] Prefix++rec1DataType :: DataType+rec1DataType = mkDataType "GHC.Generics.Rec1" [rec1Constr]++instance (Data (f p), Typeable f, Data p) => Data (Rec1 f p) where+  gfoldl k z (Rec1 p) = z Rec1 `k` p+  toConstr (Rec1 _) = rec1Constr+  gunfold k z c = case constrIndex c of+                    1 -> k (z Rec1)+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Rec1)"+  dataTypeOf _  = rec1DataType+  dataCast1 f = gcast1 f++-----------------------------------------------------------------------++k1Constr :: Constr+k1Constr = mkConstr k1DataType "K1" [] Prefix++k1DataType :: DataType+k1DataType = mkDataType "GHC.Generics.K1" [k1Constr]++instance (Typeable i, Data p, Data c) => Data (K1 i c p) where+  gfoldl k z (K1 p) = z K1 `k` p+  toConstr (K1 _) = k1Constr+  gunfold k z c = case constrIndex c of+                    1 -> k (z K1)+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(K1)"+  dataTypeOf _  = k1DataType+  dataCast1 f = gcast1 f++-----------------------------------------------------------------------++m1Constr :: Constr+m1Constr = mkConstr m1DataType "M1" [] Prefix++m1DataType :: DataType+m1DataType = mkDataType "GHC.Generics.M1" [m1Constr]++instance (Data p, Data (f p), Typeable c, Typeable i, Typeable f)+    => Data (M1 i c f p) where+  gfoldl k z (M1 p) = z M1 `k` p+  toConstr (M1 _) = m1Constr+  gunfold k z c = case constrIndex c of+                    1 -> k (z M1)+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(M1)"+  dataTypeOf _  = m1DataType+  dataCast1 f = gcast1 f++-----------------------------------------------------------------------++sum1DataType :: DataType+sum1DataType = mkDataType "GHC.Generics.:+:" [l1Constr, r1Constr]++l1Constr :: Constr+l1Constr = mkConstr sum1DataType "L1" [] Prefix++r1Constr :: Constr+r1Constr = mkConstr sum1DataType "R1" [] Prefix++instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p))+    => Data ((f :+: g) p) where+  gfoldl k z (L1 a) = z L1 `k` a+  gfoldl k z (R1 a) = z R1 `k` a+  toConstr L1{} = l1Constr+  toConstr R1{} = r1Constr+  gunfold k z c = case constrIndex c of+                    1 -> k (z L1)+                    2 -> k (z R1)+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(:+:)"+  dataTypeOf _ = sum1DataType+  dataCast1 f = gcast1 f++-----------------------------------------------------------------------++comp1Constr :: Constr+comp1Constr = mkConstr comp1DataType "Comp1" [] Prefix++comp1DataType :: DataType+comp1DataType = mkDataType "GHC.Generics.:.:" [comp1Constr]++instance (Typeable f, Typeable g, Data p, Data (f (g p)))+    => Data ((f :.: g) p) where+  gfoldl k z (Comp1 c) = z Comp1 `k` c+  toConstr (Comp1 _) = m1Constr+  gunfold k z c = case constrIndex c of+                    1 -> k (z Comp1)+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(:.:)"+  dataTypeOf _ = comp1DataType+  dataCast1 f = gcast1 f++-----------------------------------------------------------------------++v1DataType :: DataType+v1DataType = mkDataType "GHC.Generics.V1" []++instance Data p => Data (V1 p) where+  gfoldl _ _ !_ = undefined+  toConstr !_ = undefined+  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(V1)"+  dataTypeOf _ = v1DataType+  dataCast1 f = gcast1 f++-----------------------------------------------------------------------++prod1DataType :: DataType+prod1DataType = mkDataType "GHC.Generics.:*:" [prod1Constr]++prod1Constr :: Constr+prod1Constr = mkConstr prod1DataType "Prod1" [] Infix++instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p))+    => Data ((f :*: g) p) where+  gfoldl k z (l :*: r) = z (:*:) `k` l `k` r+  toConstr _ = prod1Constr+  gunfold k z c = case constrIndex c of+                    1 -> k (k (z (:*:)))+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(:*:)"+  dataCast1 f = gcast1 f+  dataTypeOf _ = prod1DataType++-----------------------------------------------------------------------++prefixConstr :: Constr+prefixConstr = mkConstr fixityDataType "Prefix" [] Prefix+infixConstr  :: Constr+infixConstr  = mkConstr fixityDataType "Infix"  [] Prefix++fixityDataType :: DataType+fixityDataType = mkDataType "GHC.Generics.Fixity" [prefixConstr,infixConstr]++instance Data Generics.Fixity where+  gfoldl _ z Generics.Prefix      = z Generics.Prefix+  gfoldl f z (Generics.Infix a i) = z Generics.Infix `f` a `f` i+  toConstr Generics.Prefix  = prefixConstr+  toConstr Generics.Infix{} = infixConstr+  gunfold k z c = case constrIndex c of+                    1 -> z Generics.Prefix+                    2 -> k (k (z Generics.Infix))+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Fixity)"+  dataTypeOf _ = fixityDataType++-----------------------------------------------------------------------++leftAssociativeConstr :: Constr+leftAssociativeConstr+  = mkConstr associativityDataType "LeftAssociative" [] Prefix+rightAssociativeConstr :: Constr+rightAssociativeConstr+  = mkConstr associativityDataType "RightAssociative" [] Prefix+notAssociativeConstr :: Constr+notAssociativeConstr+  = mkConstr associativityDataType "NotAssociative" [] Prefix++associativityDataType :: DataType+associativityDataType = mkDataType "GHC.Generics.Associativity"+  [leftAssociativeConstr,rightAssociativeConstr,notAssociativeConstr]++instance Data Associativity where+  gfoldl _ z LeftAssociative  = z LeftAssociative+  gfoldl _ z RightAssociative = z RightAssociative+  gfoldl _ z NotAssociative   = z NotAssociative+  toConstr LeftAssociative  = leftAssociativeConstr+  toConstr RightAssociative = rightAssociativeConstr+  toConstr NotAssociative   = notAssociativeConstr+  gunfold _ z c = case constrIndex c of+                    1 -> z LeftAssociative+                    2 -> z RightAssociative+                    3 -> z NotAssociative+                    _ -> errorWithoutStackTrace+                           "Data.Data.gunfold(Associativity)"+  dataTypeOf _ = associativityDataType++-----------------------------------------------------------------------++noSourceUnpackednessConstr :: Constr+noSourceUnpackednessConstr+  = mkConstr sourceUnpackednessDataType "NoSourceUnpackedness" [] Prefix+sourceNoUnpackConstr :: Constr+sourceNoUnpackConstr+  = mkConstr sourceUnpackednessDataType "SourceNoUnpack" [] Prefix+sourceUnpackConstr :: Constr+sourceUnpackConstr+  = mkConstr sourceUnpackednessDataType "SourceUnpack" [] Prefix++sourceUnpackednessDataType :: DataType+sourceUnpackednessDataType = mkDataType "GHC.Generics.SourceUnpackedness"+  [noSourceUnpackednessConstr,sourceNoUnpackConstr,sourceUnpackConstr]++instance Data SourceUnpackedness where+  gfoldl _ z NoSourceUnpackedness = z NoSourceUnpackedness+  gfoldl _ z SourceNoUnpack       = z SourceNoUnpack+  gfoldl _ z SourceUnpack         = z SourceUnpack+  toConstr NoSourceUnpackedness = noSourceUnpackednessConstr+  toConstr SourceNoUnpack       = sourceNoUnpackConstr+  toConstr SourceUnpack         = sourceUnpackConstr+  gunfold _ z c = case constrIndex c of+                    1 -> z NoSourceUnpackedness+                    2 -> z SourceNoUnpack+                    3 -> z SourceUnpack+                    _ -> errorWithoutStackTrace+                           "Data.Data.gunfold(SourceUnpackedness)"+  dataTypeOf _ = sourceUnpackednessDataType++-----------------------------------------------------------------------++noSourceStrictnessConstr :: Constr+noSourceStrictnessConstr+  = mkConstr sourceStrictnessDataType "NoSourceStrictness" [] Prefix+sourceLazyConstr :: Constr+sourceLazyConstr+  = mkConstr sourceStrictnessDataType "SourceLazy" [] Prefix+sourceStrictConstr :: Constr+sourceStrictConstr+  = mkConstr sourceStrictnessDataType "SourceStrict" [] Prefix++sourceStrictnessDataType :: DataType+sourceStrictnessDataType = mkDataType "GHC.Generics.SourceStrictness"+  [noSourceStrictnessConstr,sourceLazyConstr,sourceStrictConstr]++instance Data SourceStrictness where+  gfoldl _ z NoSourceStrictness = z NoSourceStrictness+  gfoldl _ z SourceLazy         = z SourceLazy+  gfoldl _ z SourceStrict       = z SourceStrict+  toConstr NoSourceStrictness = noSourceStrictnessConstr+  toConstr SourceLazy         = sourceLazyConstr+  toConstr SourceStrict       = sourceStrictConstr+  gunfold _ z c = case constrIndex c of+                    1 -> z NoSourceStrictness+                    2 -> z SourceLazy+                    3 -> z SourceStrict+                    _ -> errorWithoutStackTrace+                           "Data.Data.gunfold(SourceStrictness)"+  dataTypeOf _ = sourceStrictnessDataType++-----------------------------------------------------------------------++decidedLazyConstr :: Constr+decidedLazyConstr+  = mkConstr decidedStrictnessDataType "DecidedLazy" [] Prefix+decidedStrictConstr :: Constr+decidedStrictConstr+  = mkConstr decidedStrictnessDataType "DecidedStrict" [] Prefix+decidedUnpackConstr :: Constr+decidedUnpackConstr+  = mkConstr decidedStrictnessDataType "DecidedUnpack" [] Prefix++decidedStrictnessDataType :: DataType+decidedStrictnessDataType = mkDataType "GHC.Generics.DecidedStrictness"+  [decidedLazyConstr,decidedStrictConstr,decidedUnpackConstr]++instance Data DecidedStrictness where+  gfoldl _ z DecidedLazy   = z DecidedLazy+  gfoldl _ z DecidedStrict = z DecidedStrict+  gfoldl _ z DecidedUnpack = z DecidedUnpack+  toConstr DecidedLazy   = decidedLazyConstr+  toConstr DecidedStrict = decidedStrictConstr+  toConstr DecidedUnpack = decidedUnpackConstr+  gunfold _ z c = case constrIndex c of+                    1 -> z DecidedLazy+                    2 -> z DecidedStrict+                    3 -> z DecidedUnpack+                    _ -> errorWithoutStackTrace+                           "Data.Data.gunfold(DecidedStrictness)"+  dataTypeOf _ = decidedStrictnessDataType

@@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}  ----------------------------------------------------------------------------- -- |@@ -68,7 +68,6 @@   of the object\'s type; useful for debugging. -} data Dynamic = Dynamic TypeRep Obj-               deriving Typeable  instance Show Dynamic where    -- the instance just prints the type representation.@@ -136,7 +135,7 @@ dynApp :: Dynamic -> Dynamic -> Dynamic dynApp f x = case dynApply f x of               Just r -> r-             Nothing -> error ("Type error in dynamic application.\n" +++             Nothing -> errorWithoutStackTrace ("Type error in dynamic application.\n" ++                                "Can't apply function " ++ show f ++                                " to argument " ++ show x) 

@@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, TypeOperators, UndecidableInstances #-}  -----------------------------------------------------------------------------@@ -8,7 +8,7 @@ -- Module      :  Data.Either -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  experimental -- Portability :  portable@@ -31,7 +31,6 @@ import GHC.Show import GHC.Read -import Data.Typeable import Data.Type.Equality  -- $setup@@ -123,7 +122,7 @@  -} data  Either a b  =  Left a | Right b-  deriving (Eq, Ord, Read, Show, Typeable)+  deriving (Eq, Ord, Read, Show)  instance Functor (Either a) where     fmap _ (Left x) = Left x@@ -135,7 +134,6 @@     Right f <*> r = fmap f r  instance Monad (Either e) where-    return = Right     Left  l >>= _ = Left l     Right r >>= k = k r @@ -283,7 +281,7 @@ 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 a          b          = 'False type instance a == b = EqEither a b  {-

@@ -1,6 +1,5 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE AutoDeriveTypeable #-}  ----------------------------------------------------------------------------- -- |

@@ -1,6 +1,10 @@-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeOperators #-}  ----------------------------------------------------------------------------- -- |@@ -56,11 +60,12 @@ import Data.Ord import Data.Proxy -import GHC.Arr  ( Array(..), Ix(..), elems, numElements,+import GHC.Arr  ( Array(..), elems, numElements,                   foldlElems, foldrElems,                   foldlElems', foldrElems',                   foldl1Elems, foldr1Elems) import GHC.Base hiding ( foldr )+import GHC.Generics import GHC.Num  ( Num(..) )  infix  4 `elem`, `notElem`@@ -119,32 +124,80 @@     -- | Map each element of the structure to a monoid,     -- and combine the results.     foldMap :: Monoid m => (a -> m) -> t a -> m+    {-# INLINE foldMap #-}+    -- This INLINE allows more list functions to fuse. See Trac #9848.     foldMap f = foldr (mappend . f) mempty      -- | Right-associative fold of a structure.     ---    -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@+    -- In the case of lists, 'foldr', when applied to a binary operator, a+    -- starting value (typically the right-identity of the operator), and a+    -- list, reduces the list using the binary operator, from right to left:+    --+    -- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)+    --+    -- Note that, since the head of the resulting expression is produced by+    -- an application of the operator to the first element of the list,+    -- 'foldr' can produce a terminating expression from an infinite list.+    --+    -- For a general 'Foldable' structure this should be semantically identical+    -- to,+    --+    -- @foldr f z = 'List.foldr' f z . 'toList'@+    --     foldr :: (a -> b -> b) -> b -> t a -> b     foldr f z t = appEndo (foldMap (Endo #. f) t) z -    -- | Right-associative fold of a structure,-    -- but with strict application of the operator.+    -- | 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       where f' k x z = k $! f x z      -- | Left-associative fold of a structure.     ---    -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@+    -- In the case of lists, 'foldl', when applied to a binary+    -- operator, a starting value (typically the left-identity of the operator),+    -- and a list, reduces the list using the binary operator, from left to+    -- right:+    --+    -- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn+    --+    -- Note that to produce the outermost application of the operator the+    -- entire input list must be traversed. This means that 'foldl'' will+    -- diverge if given an infinite list.+    --+    -- Also note that if you want an efficient left-fold, you probably want to+    -- use 'foldl'' instead of 'foldl'. The reason for this is that latter does+    -- not force the "inner" results (e.g. @z `f` x1@ in the above example)+    -- before applying them to the operator (e.g. to @(`f` x2)@). This results+    -- in a thunk chain @O(n)@ elements long, which then must be evaluated from+    -- the outside-in.+    --+    -- For a general 'Foldable' structure this should be semantically identical+    -- to,+    --+    -- @foldl f z = 'List.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.+    -- | Left-associative fold of a structure but with strict application of+    -- the operator.     ---    -- @'foldl' f z = 'List.foldl'' f z . 'toList'@+    -- This ensures that each step of the fold is forced to weak head normal+    -- form before being applied, avoiding the collection of thunks that would+    -- otherwise occur. This is often what you want to strictly reduce a finite+    -- list to a single, monolithic result (e.g. 'length').+    --+    -- For a general 'Foldable' structure this should be semantically identical+    -- to,+    --+    -- @foldl f z = 'List.foldl'' f z . 'toList'@+    --     foldl' :: (b -> a -> b) -> b -> t a -> b     foldl' f z0 xs = foldr f' id xs z0       where f' x k z = k $! f z x@@ -152,9 +205,9 @@     -- | A variant of 'foldr' that has no base case,     -- and thus may only be applied to non-empty structures.     ---    -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@+    -- @'foldr1' f = 'List.foldr1' f . 'toList'@     foldr1 :: (a -> a -> a) -> t a -> a-    foldr1 f xs = fromMaybe (error "foldr1: empty structure")+    foldr1 f xs = fromMaybe (errorWithoutStackTrace "foldr1: empty structure")                     (foldr mf Nothing xs)       where         mf x m = Just (case m of@@ -164,9 +217,9 @@     -- | A variant of 'foldl' that has no base case,     -- and thus may only be applied to non-empty structures.     ---    -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@+    -- @'foldl1' f = 'List.foldl1' f . 'toList'@     foldl1 :: (a -> a -> a) -> t a -> a-    foldl1 f xs = fromMaybe (error "foldl1: empty structure")+    foldl1 f xs = fromMaybe (errorWithoutStackTrace "foldl1: empty structure")                     (foldl mf Nothing xs)       where         mf m y = Just (case m of@@ -196,12 +249,12 @@      -- | The largest element of a non-empty structure.     maximum :: forall a . Ord a => t a -> a-    maximum = fromMaybe (error "maximum: empty structure") .+    maximum = fromMaybe (errorWithoutStackTrace "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") .+    minimum = fromMaybe (errorWithoutStackTrace "minimum: empty structure") .        getMin . foldMap (Min #. (Just :: a -> Maybe a))      -- | The 'sum' function computes the sum of the numbers of a structure.@@ -254,7 +307,7 @@      foldr f z (_, y) = f y z -instance Ix i => Foldable (Array i) where+instance Foldable (Array i) where     foldr = foldrElems     foldl = foldlElems     foldl' = foldlElems'@@ -274,14 +327,74 @@     {-# INLINE foldr #-}     foldl _ z _ = z     {-# INLINE foldl #-}-    foldl1 _ _ = error "foldl1: Proxy"-    foldr1 _ _ = error "foldr1: Proxy"+    foldl1 _ _ = errorWithoutStackTrace "foldl1: Proxy"+    foldr1 _ _ = errorWithoutStackTrace "foldr1: Proxy"     length _   = 0     null _     = True     elem _ _   = False     sum _      = 0     product _  = 1 +instance Foldable Dual where+    foldMap            = coerce++    elem               = (. getDual) #. (==)+    foldl              = coerce+    foldl'             = coerce+    foldl1 _           = getDual+    foldr f z (Dual x) = f x z+    foldr'             = foldr+    foldr1 _           = getDual+    length _           = 1+    maximum            = getDual+    minimum            = getDual+    null _             = False+    product            = getDual+    sum                = getDual+    toList (Dual x)    = [x]++instance Foldable Sum where+    foldMap            = coerce++    elem               = (. getSum) #. (==)+    foldl              = coerce+    foldl'             = coerce+    foldl1 _           = getSum+    foldr f z (Sum x)  = f x z+    foldr'             = foldr+    foldr1 _           = getSum+    length _           = 1+    maximum            = getSum+    minimum            = getSum+    null _             = False+    product            = getSum+    sum                = getSum+    toList (Sum x)     = [x]++instance Foldable Product where+    foldMap               = coerce++    elem                  = (. getProduct) #. (==)+    foldl                 = coerce+    foldl'                = coerce+    foldl1 _              = getProduct+    foldr f z (Product x) = f x z+    foldr'                = foldr+    foldr1 _              = getProduct+    length _              = 1+    maximum               = getProduct+    minimum               = getProduct+    null _                = False+    product               = getProduct+    sum                   = getProduct+    toList (Product x)    = [x]++instance Foldable First where+    foldMap f = foldMap f . getFirst++instance Foldable Last where+    foldMap f = foldMap f . getLast+ -- 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@@ -310,6 +423,39 @@   (Min m@(Just x)) `mappend` (Min n@(Just y))     | x <= y    = Min m     | otherwise = Min n++-- Instances for GHC.Generics+instance Foldable U1 where+    foldMap _ _ = mempty+    {-# INLINE foldMap #-}+    fold _ = mempty+    {-# INLINE fold #-}+    foldr _ z _ = z+    {-# INLINE foldr #-}+    foldl _ z _ = z+    {-# INLINE foldl #-}+    foldl1 _ _ = errorWithoutStackTrace "foldl1: U1"+    foldr1 _ _ = errorWithoutStackTrace "foldr1: U1"+    length _   = 0+    null _     = True+    elem _ _   = False+    sum _      = 0+    product _  = 1++deriving instance Foldable V1+deriving instance Foldable Par1+deriving instance Foldable f => Foldable (Rec1 f)+deriving instance Foldable (K1 i c)+deriving instance Foldable f => Foldable (M1 i c f)+deriving instance (Foldable f, Foldable g) => Foldable (f :+: g)+deriving instance (Foldable f, Foldable g) => Foldable (f :*: g)+deriving instance (Foldable f, Foldable g) => Foldable (f :.: g)+deriving instance Foldable UAddr+deriving instance Foldable UChar+deriving instance Foldable UDouble+deriving instance Foldable UFloat+deriving instance Foldable UInt+deriving instance Foldable UWord  -- | Monadic fold over the elements of a structure, -- associating to the right, i.e. from right to left.

@@ -33,6 +33,15 @@  -- | An infix synonym for 'fmap'. --+-- The name of this operator is an allusion to '$'.+-- Note the similarities between their types:+--+-- >  ($)  ::              (a -> b) ->   a ->   b+-- > (<$>) :: Functor f => (a -> b) -> f a -> f b+--+-- Whereas '$' is function application, '<$>' is function+-- application lifted over a 'Functor'.+-- -- ==== __Examples__ -- -- Convert from a @'Maybe' 'Int'@ to a @'Maybe' 'String'@ using 'show':

@@ -0,0 +1,490 @@+{-# LANGUAGE Safe #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Classes+-- Copyright   :  (c) Ross Paterson 2013+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Liftings of the Prelude classes 'Eq', 'Ord', 'Read' and 'Show' to+-- unary and binary type constructors.+--+-- These classes are needed to express the constraints on arguments of+-- transformers in portable Haskell.  Thus for a new transformer @T@,+-- one might write instances like+--+-- > instance (Eq1 f) => Eq1 (T f) where ...+-- > instance (Ord1 f) => Ord1 (T f) where ...+-- > instance (Read1 f) => Read1 (T f) where ...+-- > instance (Show1 f) => Show1 (T f) where ...+--+-- If these instances can be defined, defining instances of the base+-- classes is mechanical:+--+-- > instance (Eq1 f, Eq a) => Eq (T f a) where (==) = eq1+-- > instance (Ord1 f, Ord a) => Ord (T f a) where compare = compare1+-- > instance (Read1 f, Read a) => Read (T f a) where readsPrec = readsPrec1+-- > instance (Show1 f, Show a) => Show (T f a) where showsPrec = showsPrec1+--+-- @since 4.9.0.0+-----------------------------------------------------------------------------++module Data.Functor.Classes (+    -- * Liftings of Prelude classes+    -- ** For unary constructors+    Eq1(..), eq1,+    Ord1(..), compare1,+    Read1(..), readsPrec1,+    Show1(..), showsPrec1,+    -- ** For binary constructors+    Eq2(..), eq2,+    Ord2(..), compare2,+    Read2(..), readsPrec2,+    Show2(..), showsPrec2,+    -- * Helper functions+    -- $example+    readsData,+    readsUnaryWith,+    readsBinaryWith,+    showsUnaryWith,+    showsBinaryWith,+    -- ** Obsolete helpers+    readsUnary,+    readsUnary1,+    readsBinary1,+    showsUnary,+    showsUnary1,+    showsBinary1,+  ) where++import Control.Applicative (Const(Const))+import Data.Functor.Identity (Identity(Identity))+import Data.Proxy (Proxy(Proxy))+import Data.Monoid (mappend)+import Text.Show (showListWith)++-- | Lifting of the 'Eq' class to unary type constructors.+class Eq1 f where+    -- | Lift an equality test through the type constructor.+    --+    -- The function will usually be applied to an equality function,+    -- but the more general type ensures that the implementation uses+    -- it to compare elements of the first container with elements of+    -- the second.+    liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool++-- | Lift the standard @('==')@ function through the type constructor.+eq1 :: (Eq1 f, Eq a) => f a -> f a -> Bool+eq1 = liftEq (==)++-- | Lifting of the 'Ord' class to unary type constructors.+class (Eq1 f) => Ord1 f where+    -- | Lift a 'compare' function through the type constructor.+    --+    -- The function will usually be applied to a comparison function,+    -- but the more general type ensures that the implementation uses+    -- it to compare elements of the first container with elements of+    -- the second.+    liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering++-- | Lift the standard 'compare' function through the type constructor.+compare1 :: (Ord1 f, Ord a) => f a -> f a -> Ordering+compare1 = liftCompare compare++-- | Lifting of the 'Read' class to unary type constructors.+class Read1 f where+    -- | 'readsPrec' function for an application of the type constructor+    -- based on 'readsPrec' and 'readList' functions for the argument type.+    liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)++    -- | 'readList' function for an application of the type constructor+    -- based on 'readsPrec' and 'readList' functions for the argument type.+    -- The default implementation using standard list syntax is correct+    -- for most types.+    liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]+    liftReadList rp rl = readListWith (liftReadsPrec rp rl 0)++-- | Read a list (using square brackets and commas), given a function+-- for reading elements.+readListWith :: ReadS a -> ReadS [a]+readListWith rp =+    readParen False (\r -> [pr | ("[",s) <- lex r, pr <- readl s])+  where+    readl s = [([],t) | ("]",t) <- lex s] +++        [(x:xs,u) | (x,t) <- rp s, (xs,u) <- readl' t]+    readl' s = [([],t) | ("]",t) <- lex s] +++        [(x:xs,v) | (",",t) <- lex s, (x,u) <- rp t, (xs,v) <- readl' u]++-- | Lift the standard 'readsPrec' and 'readList' functions through the+-- type constructor.+readsPrec1 :: (Read1 f, Read a) => Int -> ReadS (f a)+readsPrec1 = liftReadsPrec readsPrec readList++-- | Lifting of the 'Show' class to unary type constructors.+class Show1 f where+    -- | 'showsPrec' function for an application of the type constructor+    -- based on 'showsPrec' and 'showList' functions for the argument type.+    liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->+        Int -> f a -> ShowS++    -- | 'showList' function for an application of the type constructor+    -- based on 'showsPrec' and 'showList' functions for the argument type.+    -- The default implementation using standard list syntax is correct+    -- for most types.+    liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->+        [f a] -> ShowS+    liftShowList sp sl = showListWith (liftShowsPrec sp sl 0)++-- | Lift the standard 'showsPrec' and 'showList' functions through the+-- type constructor.+showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS+showsPrec1 = liftShowsPrec showsPrec showList++-- | Lifting of the 'Eq' class to binary type constructors.+class Eq2 f where+    -- | Lift equality tests through the type constructor.+    --+    -- The function will usually be applied to equality functions,+    -- but the more general type ensures that the implementation uses+    -- them to compare elements of the first container with elements of+    -- the second.+    liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool++-- | Lift the standard @('==')@ function through the type constructor.+eq2 :: (Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool+eq2 = liftEq2 (==) (==)++-- | Lifting of the 'Ord' class to binary type constructors.+class (Eq2 f) => Ord2 f where+    -- | Lift 'compare' functions through the type constructor.+    --+    -- The function will usually be applied to comparison functions,+    -- but the more general type ensures that the implementation uses+    -- them to compare elements of the first container with elements of+    -- the second.+    liftCompare2 :: (a -> b -> Ordering) -> (c -> d -> Ordering) ->+        f a c -> f b d -> Ordering++-- | Lift the standard 'compare' function through the type constructor.+compare2 :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Ordering+compare2 = liftCompare2 compare compare++-- | Lifting of the 'Read' class to binary type constructors.+class Read2 f where+    -- | 'readsPrec' function for an application of the type constructor+    -- based on 'readsPrec' and 'readList' functions for the argument types.+    liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] ->+        (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f a b)++    -- | 'readList' function for an application of the type constructor+    -- based on 'readsPrec' and 'readList' functions for the argument types.+    -- The default implementation using standard list syntax is correct+    -- for most types.+    liftReadList2 :: (Int -> ReadS a) -> ReadS [a] ->+        (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]+    liftReadList2 rp1 rl1 rp2 rl2 =+        readListWith (liftReadsPrec2 rp1 rl1 rp2 rl2 0)++-- | Lift the standard 'readsPrec' function through the type constructor.+readsPrec2 :: (Read2 f, Read a, Read b) => Int -> ReadS (f a b)+readsPrec2 = liftReadsPrec2 readsPrec readList readsPrec readList++-- | Lifting of the 'Show' class to binary type constructors.+class Show2 f where+    -- | 'showsPrec' function for an application of the type constructor+    -- based on 'showsPrec' and 'showList' functions for the argument types.+    liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->+        (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f a b -> ShowS++    -- | 'showList' function for an application of the type constructor+    -- based on 'showsPrec' and 'showList' functions for the argument types.+    -- The default implementation using standard list syntax is correct+    -- for most types.+    liftShowList2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->+        (Int -> b -> ShowS) -> ([b] -> ShowS) -> [f a b] -> ShowS+    liftShowList2 sp1 sl1 sp2 sl2 =+        showListWith (liftShowsPrec2 sp1 sl1 sp2 sl2 0)++-- | Lift the standard 'showsPrec' function through the type constructor.+showsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS+showsPrec2 = liftShowsPrec2 showsPrec showList showsPrec showList++-- Instances for Prelude type constructors++instance Eq1 Maybe where+    liftEq _ Nothing Nothing = True+    liftEq _ Nothing (Just _) = False+    liftEq _ (Just _) Nothing = False+    liftEq eq (Just x) (Just y) = eq x y++instance Ord1 Maybe where+    liftCompare _ Nothing Nothing = EQ+    liftCompare _ Nothing (Just _) = LT+    liftCompare _ (Just _) Nothing = GT+    liftCompare comp (Just x) (Just y) = comp x y++instance Read1 Maybe where+    liftReadsPrec rp _ d =+         readParen False (\ r -> [(Nothing,s) | ("Nothing",s) <- lex r])+         `mappend`+         readsData (readsUnaryWith rp "Just" Just) d++instance Show1 Maybe where+    liftShowsPrec _ _ _ Nothing = showString "Nothing"+    liftShowsPrec sp _ d (Just x) = showsUnaryWith sp "Just" d x++instance Eq1 [] where+    liftEq _ [] [] = True+    liftEq _ [] (_:_) = False+    liftEq _ (_:_) [] = False+    liftEq eq (x:xs) (y:ys) = eq x y && liftEq eq xs ys++instance Ord1 [] where+    liftCompare _ [] [] = EQ+    liftCompare _ [] (_:_) = LT+    liftCompare _ (_:_) [] = GT+    liftCompare comp (x:xs) (y:ys) = comp x y `mappend` liftCompare comp xs ys++instance Read1 [] where+    liftReadsPrec _ rl _ = rl++instance Show1 [] where+    liftShowsPrec _ sl _ = sl++instance Eq2 (,) where+    liftEq2 e1 e2 (x1, y1) (x2, y2) = e1 x1 x2 && e2 y1 y2++instance Ord2 (,) where+    liftCompare2 comp1 comp2 (x1, y1) (x2, y2) =+        comp1 x1 x2 `mappend` comp2 y1 y2++instance Read2 (,) where+    liftReadsPrec2 rp1 _ rp2 _ _ = readParen False $ \ r ->+        [((x,y), w) | ("(",s) <- lex r,+                      (x,t)   <- rp1 0 s,+                      (",",u) <- lex t,+                      (y,v)   <- rp2 0 u,+                      (")",w) <- lex v]++instance Show2 (,) where+    liftShowsPrec2 sp1 _ sp2 _ _ (x, y) =+        showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')'++instance (Eq a) => Eq1 ((,) a) where+    liftEq = liftEq2 (==)++instance (Ord a) => Ord1 ((,) a) where+    liftCompare = liftCompare2 compare++instance (Read a) => Read1 ((,) a) where+    liftReadsPrec = liftReadsPrec2 readsPrec readList++instance (Show a) => Show1 ((,) a) where+    liftShowsPrec = liftShowsPrec2 showsPrec showList++instance Eq2 Either where+    liftEq2 e1 _ (Left x) (Left y) = e1 x y+    liftEq2 _ _ (Left _) (Right _) = False+    liftEq2 _ _ (Right _) (Left _) = False+    liftEq2 _ e2 (Right x) (Right y) = e2 x y++instance Ord2 Either where+    liftCompare2 comp1 _ (Left x) (Left y) = comp1 x y+    liftCompare2 _ _ (Left _) (Right _) = LT+    liftCompare2 _ _ (Right _) (Left _) = GT+    liftCompare2 _ comp2 (Right x) (Right y) = comp2 x y++instance Read2 Either where+    liftReadsPrec2 rp1 _ rp2 _ = readsData $+         readsUnaryWith rp1 "Left" Left `mappend`+         readsUnaryWith rp2 "Right" Right++instance Show2 Either where+    liftShowsPrec2 sp1 _ _ _ d (Left x) = showsUnaryWith sp1 "Left" d x+    liftShowsPrec2 _ _ sp2 _ d (Right x) = showsUnaryWith sp2 "Right" d x++instance (Eq a) => Eq1 (Either a) where+    liftEq = liftEq2 (==)++instance (Ord a) => Ord1 (Either a) where+    liftCompare = liftCompare2 compare++instance (Read a) => Read1 (Either a) where+    liftReadsPrec = liftReadsPrec2 readsPrec readList++instance (Show a) => Show1 (Either a) where+    liftShowsPrec = liftShowsPrec2 showsPrec showList++-- Instances for other functors defined in the base package++instance Eq1 Identity where+    liftEq eq (Identity x) (Identity y) = eq x y++instance Ord1 Identity where+    liftCompare comp (Identity x) (Identity y) = comp x y++instance Read1 Identity where+    liftReadsPrec rp _ = readsData $+         readsUnaryWith rp "Identity" Identity++instance Show1 Identity where+    liftShowsPrec sp _ d (Identity x) = showsUnaryWith sp "Identity" d x++instance Eq2 Const where+    liftEq2 eq _ (Const x) (Const y) = eq x y++instance Ord2 Const where+    liftCompare2 comp _ (Const x) (Const y) = comp x y++instance Read2 Const where+    liftReadsPrec2 rp _ _ _ = readsData $+         readsUnaryWith rp "Const" Const++instance Show2 Const where+    liftShowsPrec2 sp _ _ _ d (Const x) = showsUnaryWith sp "Const" d x++instance (Eq a) => Eq1 (Const a) where+    liftEq = liftEq2 (==)+instance (Ord a) => Ord1 (Const a) where+    liftCompare = liftCompare2 compare+instance (Read a) => Read1 (Const a) where+    liftReadsPrec = liftReadsPrec2 readsPrec readList+instance (Show a) => Show1 (Const a) where+    liftShowsPrec = liftShowsPrec2 showsPrec showList++-- Proxy unfortunately imports this module, hence these instances are placed+-- here,+-- | @since 4.9.0.0+instance Eq1 Proxy where+  liftEq _ _ _ = True++-- | @since 4.9.0.0+instance Ord1 Proxy where+  liftCompare _ _ _ = EQ++-- | @since 4.9.0.0+instance Show1 Proxy where+  liftShowsPrec _ _ _ _ = showString "Proxy"++-- | @since 4.9.0.0+instance Read1 Proxy where+  liftReadsPrec _ _ d =+    readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ])++-- Building blocks++-- | @'readsData' p d@ is a parser for datatypes where each alternative+-- begins with a data constructor.  It parses the constructor and+-- passes it to @p@.  Parsers for various constructors can be constructed+-- with 'readsUnary', 'readsUnary1' and 'readsBinary1', and combined with+-- @mappend@ from the @Monoid@ class.+readsData :: (String -> ReadS a) -> Int -> ReadS a+readsData reader d =+    readParen (d > 10) $ \ r -> [res | (kw,s) <- lex r, res <- reader kw s]++-- | @'readsUnaryWith' rp n c n'@ matches the name of a unary data constructor+-- and then parses its argument using @rp@.+readsUnaryWith :: (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t+readsUnaryWith rp name cons kw s =+    [(cons x,t) | kw == name, (x,t) <- rp 11 s]++-- | @'readsBinaryWith' rp1 rp2 n c n'@ matches the name of a binary+-- data constructor and then parses its arguments using @rp1@ and @rp2@+-- respectively.+readsBinaryWith :: (Int -> ReadS a) -> (Int -> ReadS b) ->+    String -> (a -> b -> t) -> String -> ReadS t+readsBinaryWith rp1 rp2 name cons kw s =+    [(cons x y,u) | kw == name, (x,t) <- rp1 11 s, (y,u) <- rp2 11 t]++-- | @'showsUnaryWith' sp n d x@ produces the string representation of a+-- unary data constructor with name @n@ and argument @x@, in precedence+-- context @d@.+showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS+showsUnaryWith sp name d x = showParen (d > 10) $+    showString name . showChar ' ' . sp 11 x++-- | @'showsBinaryWith' sp1 sp2 n d x y@ produces the string+-- representation of a binary data constructor with name @n@ and arguments+-- @x@ and @y@, in precedence context @d@.+showsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) ->+    String -> Int -> a -> b -> ShowS+showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $+    showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y++-- Obsolete building blocks++-- | @'readsUnary' n c n'@ matches the name of a unary data constructor+-- and then parses its argument using 'readsPrec'.+{-# DEPRECATED readsUnary "Use readsUnaryWith to define liftReadsPrec" #-}+readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t+readsUnary name cons kw s =+    [(cons x,t) | kw == name, (x,t) <- readsPrec 11 s]++-- | @'readsUnary1' n c n'@ matches the name of a unary data constructor+-- and then parses its argument using 'readsPrec1'.+{-# DEPRECATED readsUnary1 "Use readsUnaryWith to define liftReadsPrec" #-}+readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t+readsUnary1 name cons kw s =+    [(cons x,t) | kw == name, (x,t) <- readsPrec1 11 s]++-- | @'readsBinary1' n c n'@ matches the name of a binary data constructor+-- and then parses its arguments using 'readsPrec1'.+{-# DEPRECATED readsBinary1 "Use readsBinaryWith to define liftReadsPrec" #-}+readsBinary1 :: (Read1 f, Read1 g, Read a) =>+    String -> (f a -> g a -> t) -> String -> ReadS t+readsBinary1 name cons kw s =+    [(cons x y,u) | kw == name,+        (x,t) <- readsPrec1 11 s, (y,u) <- readsPrec1 11 t]++-- | @'showsUnary' n d x@ produces the string representation of a unary data+-- constructor with name @n@ and argument @x@, in precedence context @d@.+{-# DEPRECATED showsUnary "Use showsUnaryWith to define liftShowsPrec" #-}+showsUnary :: (Show a) => String -> Int -> a -> ShowS+showsUnary name d x = showParen (d > 10) $+    showString name . showChar ' ' . showsPrec 11 x++-- | @'showsUnary1' n d x@ produces the string representation of a unary data+-- constructor with name @n@ and argument @x@, in precedence context @d@.+{-# DEPRECATED showsUnary1 "Use showsUnaryWith to define liftShowsPrec" #-}+showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS+showsUnary1 name d x = showParen (d > 10) $+    showString name . showChar ' ' . showsPrec1 11 x++-- | @'showsBinary1' n d x y@ produces the string representation of a binary+-- data constructor with name @n@ and arguments @x@ and @y@, in precedence+-- context @d@.+{-# DEPRECATED showsBinary1 "Use showsBinaryWith to define liftShowsPrec" #-}+showsBinary1 :: (Show1 f, Show1 g, Show a) =>+    String -> Int -> f a -> g a -> ShowS+showsBinary1 name d x y = showParen (d > 10) $+    showString name . showChar ' ' . showsPrec1 11 x .+        showChar ' ' . showsPrec1 11 y++{- $example+These functions can be used to assemble 'Read' and 'Show' instances for+new algebraic types.  For example, given the definition++> data T f a = Zero a | One (f a) | Two a (f a)++a standard 'Read1' instance may be defined as++> instance (Read1 f) => Read1 (T f) where+>     liftReadsPrec rp rl = readsData $+>         readsUnaryWith rp "Zero" Zero `mappend`+>         readsUnaryWith (liftReadsPrec rp rl) "One" One `mappend`+>         readsBinaryWith rp (liftReadsPrec rp rl) "Two" Two++and the corresponding 'Show1' instance as++> instance (Show1 f) => Show1 (T f) where+>     liftShowsPrec sp _ d (Zero x) =+>         showsUnaryWith sp "Zero" d x+>     liftShowsPrec sp sl d (One x) =+>         showsUnaryWith (liftShowsPrec sp sl) "One" d x+>     liftShowsPrec sp sl d (Two x y) =+>         showsBinaryWith sp (liftShowsPrec sp sl) "Two" d x y++-}

@@ -0,0 +1,94 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE Safe #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Compose+-- Copyright   :  (c) Ross Paterson 2010+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Composition of functors.+--+-- @since 4.9.0.0+-----------------------------------------------------------------------------++module Data.Functor.Compose (+    Compose(..),+  ) where++import Data.Functor.Classes++import Control.Applicative+import Data.Data (Data)+import Data.Foldable (Foldable(foldMap))+import Data.Traversable (Traversable(traverse))+import GHC.Generics (Generic, Generic1)++infixr 9 `Compose`++-- | Right-to-left composition of functors.+-- The composition of applicative functors is always applicative,+-- but the composition of monads is not always a monad.+newtype Compose f g a = Compose { getCompose :: f (g a) }+  deriving (Data, Generic, Generic1)++-- Instances of lifted Prelude classes++instance (Eq1 f, Eq1 g) => Eq1 (Compose f g) where+    liftEq eq (Compose x) (Compose y) = liftEq (liftEq eq) x y++instance (Ord1 f, Ord1 g) => Ord1 (Compose f g) where+    liftCompare comp (Compose x) (Compose y) =+        liftCompare (liftCompare comp) x y++instance (Read1 f, Read1 g) => Read1 (Compose f g) where+    liftReadsPrec rp rl = readsData $+        readsUnaryWith (liftReadsPrec rp' rl') "Compose" Compose+      where+        rp' = liftReadsPrec rp rl+        rl' = liftReadList rp rl++instance (Show1 f, Show1 g) => Show1 (Compose f g) where+    liftShowsPrec sp sl d (Compose x) =+        showsUnaryWith (liftShowsPrec sp' sl') "Compose" d x+      where+        sp' = liftShowsPrec sp sl+        sl' = liftShowList sp sl++-- Instances of Prelude classes++instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where+    (==) = eq1++instance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where+    compare = compare1++instance (Read1 f, Read1 g, Read a) => Read (Compose f g a) where+    readsPrec = readsPrec1++instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where+    showsPrec = showsPrec1++-- Functor instances++instance (Functor f, Functor g) => Functor (Compose f g) where+    fmap f (Compose x) = Compose (fmap (fmap f) x)++instance (Foldable f, Foldable g) => Foldable (Compose f g) where+    foldMap f (Compose t) = foldMap (foldMap f) t++instance (Traversable f, Traversable g) => Traversable (Compose f g) where+    traverse f (Compose t) = Compose <$> traverse (traverse f) t++instance (Applicative f, Applicative g) => Applicative (Compose f g) where+    pure x = Compose (pure (pure x))+    Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)++instance (Alternative f, Applicative g) => Alternative (Compose f g) where+    empty = Compose empty+    Compose x <|> Compose y = Compose (x <|> y)

@@ -0,0 +1,69 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Trustworthy #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Const+-- Copyright   :  Conor McBride and Ross Paterson 2005+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable++-- The 'Const' functor.+--+-- @since 4.9.0.0++module Data.Functor.Const (Const(..)) where++import Data.Bits (Bits, FiniteBits)+import Data.Foldable (Foldable(foldMap))+import Foreign.Storable (Storable)++import GHC.Arr (Ix)+import GHC.Base+import GHC.Enum (Bounded, Enum)+import GHC.Float (Floating, RealFloat)+import GHC.Generics (Generic, Generic1)+import GHC.Num (Num)+import GHC.Real (Fractional, Integral, Real, RealFrac)+import GHC.Read (Read(readsPrec), readParen, lex)+import GHC.Show (Show(showsPrec), showParen, showString)++-- | The 'Const' functor.+newtype Const a b = Const { getConst :: a }+    deriving ( Bits, Bounded, Enum, Eq, FiniteBits, Floating, Fractional+             , Generic, Generic1, Integral, Ix, Monoid, Num, Ord, Real+             , RealFrac, RealFloat , Storable)++-- | This instance would be equivalent to the derived instances of the+-- 'Const' newtype if the 'runConst' field were removed+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]++-- | This instance would be equivalent to the derived instances of the+-- 'Const' newtype if the 'runConst' field were removed+instance Show a => Show (Const a b) where+    showsPrec d (Const x) = showParen (d > 10) $+                            showString "Const " . showsPrec 11 x++instance Foldable (Const m) where+    foldMap _ _ = mempty++instance Functor (Const m) where+    fmap _ (Const v) = Const v++instance Monoid m => Applicative (Const m) where+    pure _ = Const mempty+    (<*>) = 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.

@@ -1,6 +1,7 @@-{-# LANGUAGE AutoDeriveTypeable #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE Trustworthy #-}  -----------------------------------------------------------------------------@@ -35,16 +36,23 @@  import Control.Monad.Fix import Control.Monad.Zip+import Data.Bits (Bits, FiniteBits) import Data.Coerce import Data.Data (Data) import Data.Foldable+import Data.Ix (Ix)+import Data.Semigroup (Semigroup)+import Data.String (IsString)+import Foreign.Storable (Storable) 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)+    deriving ( Bits, Bounded, Data, Enum, Eq, FiniteBits, Floating, Fractional+             , Generic, Generic1, Integral, IsString, Ix, Monoid, Num, Ord+             , Real, RealFrac, RealFloat , Semigroup, Storable, Traversable)  -- | This instance would be equivalent to the derived instances of the -- 'Identity' newtype if the 'runIdentity' field were removed@@ -87,7 +95,6 @@     (<*>)    = coerce  instance Monad Identity where-    return   = Identity     m >>= k  = k (runIdentity m)  instance MonadFix Identity where

@@ -0,0 +1,97 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE Safe #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Product+-- Copyright   :  (c) Ross Paterson 2010+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Products, lifted to functors.+--+-- @since 4.9.0.0+-----------------------------------------------------------------------------++module Data.Functor.Product (+    Product(..),+  ) where++import Control.Applicative+import Control.Monad (MonadPlus(..))+import Control.Monad.Fix (MonadFix(..))+import Control.Monad.Zip (MonadZip(mzipWith))+import Data.Data (Data)+import Data.Foldable (Foldable(foldMap))+import Data.Functor.Classes+import Data.Monoid (mappend)+import Data.Traversable (Traversable(traverse))+import GHC.Generics (Generic, Generic1)++-- | Lifted product of functors.+data Product f g a = Pair (f a) (g a)+  deriving (Data, Generic, Generic1)++instance (Eq1 f, Eq1 g) => Eq1 (Product f g) where+    liftEq eq (Pair x1 y1) (Pair x2 y2) = liftEq eq x1 x2 && liftEq eq y1 y2++instance (Ord1 f, Ord1 g) => Ord1 (Product f g) where+    liftCompare comp (Pair x1 y1) (Pair x2 y2) =+        liftCompare comp x1 x2 `mappend` liftCompare comp y1 y2++instance (Read1 f, Read1 g) => Read1 (Product f g) where+    liftReadsPrec rp rl = readsData $+        readsBinaryWith (liftReadsPrec rp rl) (liftReadsPrec rp rl) "Pair" Pair++instance (Show1 f, Show1 g) => Show1 (Product f g) where+    liftShowsPrec sp sl d (Pair x y) =+        showsBinaryWith (liftShowsPrec sp sl) (liftShowsPrec sp sl) "Pair" d x y++instance (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a)+    where (==) = eq1+instance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where+    compare = compare1+instance (Read1 f, Read1 g, Read a) => Read (Product f g a) where+    readsPrec = readsPrec1+instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where+    showsPrec = showsPrec1++instance (Functor f, Functor g) => Functor (Product f g) where+    fmap f (Pair x y) = Pair (fmap f x) (fmap f y)++instance (Foldable f, Foldable g) => Foldable (Product f g) where+    foldMap f (Pair x y) = foldMap f x `mappend` foldMap f y++instance (Traversable f, Traversable g) => Traversable (Product f g) where+    traverse f (Pair x y) = Pair <$> traverse f x <*> traverse f y++instance (Applicative f, Applicative g) => Applicative (Product f g) where+    pure x = Pair (pure x) (pure x)+    Pair f g <*> Pair x y = Pair (f <*> x) (g <*> y)++instance (Alternative f, Alternative g) => Alternative (Product f g) where+    empty = Pair empty empty+    Pair x1 y1 <|> Pair x2 y2 = Pair (x1 <|> x2) (y1 <|> y2)++instance (Monad f, Monad g) => Monad (Product f g) where+    Pair m n >>= f = Pair (m >>= fstP . f) (n >>= sndP . f)+      where+        fstP (Pair a _) = a+        sndP (Pair _ b) = b++instance (MonadPlus f, MonadPlus g) => MonadPlus (Product f g) where+    mzero = Pair mzero mzero+    Pair x1 y1 `mplus` Pair x2 y2 = Pair (x1 `mplus` x2) (y1 `mplus` y2)++instance (MonadFix f, MonadFix g) => MonadFix (Product f g) where+    mfix f = Pair (mfix (fstP . f)) (mfix (sndP . f))+      where+        fstP (Pair a _) = a+        sndP (Pair _ b) = b++instance (MonadZip f, MonadZip g) => MonadZip (Product f g) where+    mzipWith f (Pair x1 y1) (Pair x2 y2) = Pair (mzipWith f x1 x2) (mzipWith f y1 y2)

@@ -0,0 +1,77 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE Safe #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Sum+-- Copyright   :  (c) Ross Paterson 2014+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Sums, lifted to functors.+--+-- @since 4.9.0.0+-----------------------------------------------------------------------------++module Data.Functor.Sum (+    Sum(..),+  ) where++import Data.Data (Data)+import Data.Foldable (Foldable(foldMap))+import Data.Functor.Classes+import Data.Monoid (mappend)+import Data.Traversable (Traversable(traverse))+import GHC.Generics (Generic, Generic1)++-- | Lifted sum of functors.+data Sum f g a = InL (f a) | InR (g a)+  deriving (Data, Generic, Generic1)++instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where+    liftEq eq (InL x1) (InL x2) = liftEq eq x1 x2+    liftEq _ (InL _) (InR _) = False+    liftEq _ (InR _) (InL _) = False+    liftEq eq (InR y1) (InR y2) = liftEq eq y1 y2++instance (Ord1 f, Ord1 g) => Ord1 (Sum f g) where+    liftCompare comp (InL x1) (InL x2) = liftCompare comp x1 x2+    liftCompare _ (InL _) (InR _) = LT+    liftCompare _ (InR _) (InL _) = GT+    liftCompare comp (InR y1) (InR y2) = liftCompare comp y1 y2++instance (Read1 f, Read1 g) => Read1 (Sum f g) where+    liftReadsPrec rp rl = readsData $+        readsUnaryWith (liftReadsPrec rp rl) "InL" InL `mappend`+        readsUnaryWith (liftReadsPrec rp rl) "InR" InR++instance (Show1 f, Show1 g) => Show1 (Sum f g) where+    liftShowsPrec sp sl d (InL x) =+        showsUnaryWith (liftShowsPrec sp sl) "InL" d x+    liftShowsPrec sp sl d (InR y) =+        showsUnaryWith (liftShowsPrec sp sl) "InR" d y++instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where+    (==) = eq1+instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where+    compare = compare1+instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where+    readsPrec = readsPrec1+instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where+    showsPrec = showsPrec1++instance (Functor f, Functor g) => Functor (Sum f g) where+    fmap f (InL x) = InL (fmap f x)+    fmap f (InR y) = InR (fmap f y)++instance (Foldable f, Foldable g) => Foldable (Sum f g) where+    foldMap f (InL x) = foldMap f x+    foldMap f (InR y) = foldMap f y++instance (Traversable f, Traversable g) => Traversable (Sum f g) where+    traverse f (InL x) = InL <$> traverse f x+    traverse f (InR y) = InR <$> traverse f y

@@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-}+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}  ----------------------------------------------------------------------------- -- |@@ -27,10 +27,7 @@         atomicModifyIORef,         atomicModifyIORef',         atomicWriteIORef,--#if !defined(__PARALLEL_HASKELL__)         mkWeakIORef,-#endif         -- ** Memory Model          -- $memmodel@@ -41,17 +38,13 @@ import GHC.STRef import GHC.IORef hiding (atomicModifyIORef) import qualified GHC.IORef-#if !defined(__PARALLEL_HASKELL__) import GHC.Weak-#endif -#if !defined(__PARALLEL_HASKELL__) -- |Make a 'Weak' pointer to an 'IORef', using the second argument as a finalizer -- to run when 'IORef' is garbage-collected mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a))-mkWeakIORef r@(IORef (STRef r#)) f = IO $ \s ->-  case mkWeak# r# r f s of (# s1, w #) -> (# s1, Weak w #)-#endif+mkWeakIORef r@(IORef (STRef r#)) (IO finalizer) = IO $ \s ->+    case mkWeak# r# r finalizer s of (# s1, w #) -> (# s1, Weak w #)  -- |Mutate the contents of an 'IORef'. --

@@ -0,0 +1,19 @@+{-# LANGUAGE Trustworthy, ExplicitNamespaces #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Kind+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  not portable+--+-- Basic kinds+--+-- @since 4.9.0.0+-----------------------------------------------------------------------------++module Data.Kind ( Type, Constraint, type (*), type (★) ) where++import GHC.Types

@@ -219,8 +219,9 @@  import GHC.Base ( Bool(..), Eq((==)), otherwise ) --- | The 'isSubsequenceOf' function takes two lists and returns 'True' if the--- first list is a subsequence of the second list.+-- | The 'isSubsequenceOf' function takes two lists and returns 'True' if all+-- the elements of the first list occur, in order, in the second. The+-- elements do not have to occur consecutively. -- -- @'isSubsequenceOf' x y@ is equivalent to @'elem' x ('subsequences' y)@. --

@@ -0,0 +1,490 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE Trustworthy #-} -- can't use Safe due to IsList instance+{-# LANGUAGE TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.List.NonEmpty+-- Copyright   :  (C) 2011-2015 Edward Kmett,+--                (C) 2010 Tony Morris, Oliver Taylor, Eelis van der Weegen+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- A 'NonEmpty' list is one which always has at least one element, but+-- is otherwise identical to the traditional list type in complexity+-- and in terms of API. You will almost certainly want to import this+-- module @qualified@.+--+-- @since 4.9.0.0+----------------------------------------------------------------------------++module Data.List.NonEmpty (+   -- * The type of non-empty streams+     NonEmpty(..)++   -- * Non-empty stream transformations+   , map         -- :: (a -> b) -> NonEmpty a -> NonEmpty b+   , intersperse -- :: a -> NonEmpty a -> NonEmpty a+   , scanl       -- :: Foldable f => (b -> a -> b) -> b -> f a -> NonEmpty b+   , scanr       -- :: Foldable f => (a -> b -> b) -> b -> f a -> NonEmpty b+   , scanl1      -- :: (a -> a -> a) -> NonEmpty a -> NonEmpty a+   , scanr1      -- :: (a -> a -> a) -> NonEmpty a -> NonEmpty a+   , transpose   -- :: NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a)+   , sortBy      -- :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a+   , sortWith      -- :: Ord o => (a -> o) -> NonEmpty a -> NonEmpty a+   -- * Basic functions+   , length      -- :: NonEmpty a -> Int+   , head        -- :: NonEmpty a -> a+   , tail        -- :: NonEmpty a -> [a]+   , last        -- :: NonEmpty a -> a+   , init        -- :: NonEmpty a -> [a]+   , (<|), cons  -- :: a -> NonEmpty a -> NonEmpty a+   , uncons      -- :: NonEmpty a -> (a, Maybe (NonEmpty a))+   , unfoldr     -- :: (a -> (b, Maybe a)) -> a -> NonEmpty b+   , sort        -- :: NonEmpty a -> NonEmpty a+   , reverse     -- :: NonEmpty a -> NonEmpty a+   , inits       -- :: Foldable f => f a -> NonEmpty a+   , tails       -- :: Foldable f => f a -> NonEmpty a+   -- * Building streams+   , iterate     -- :: (a -> a) -> a -> NonEmpty a+   , repeat      -- :: a -> NonEmpty a+   , cycle       -- :: NonEmpty a -> NonEmpty a+   , unfold      -- :: (a -> (b, Maybe a) -> a -> NonEmpty b+   , insert      -- :: (Foldable f, Ord a) => a -> f a -> NonEmpty a+   , some1       -- :: Alternative f => f a -> f (NonEmpty a)+   -- * Extracting sublists+   , take        -- :: Int -> NonEmpty a -> [a]+   , drop        -- :: Int -> NonEmpty a -> [a]+   , splitAt     -- :: Int -> NonEmpty a -> ([a], [a])+   , takeWhile   -- :: Int -> NonEmpty a -> [a]+   , dropWhile   -- :: Int -> NonEmpty a -> [a]+   , span        -- :: Int -> NonEmpty a -> ([a],[a])+   , break       -- :: Int -> NonEmpty a -> ([a],[a])+   , filter      -- :: (a -> Bool) -> NonEmpty a -> [a]+   , partition   -- :: (a -> Bool) -> NonEmpty a -> ([a],[a])+   , group       -- :: Foldable f => Eq a => f a -> [NonEmpty a]+   , groupBy     -- :: Foldable f => (a -> a -> Bool) -> f a -> [NonEmpty a]+   , groupWith     -- :: (Foldable f, Eq b) => (a -> b) -> f a -> [NonEmpty a]+   , groupAllWith  -- :: (Foldable f, Ord b) => (a -> b) -> f a -> [NonEmpty a]+   , group1      -- :: Eq a => NonEmpty a -> NonEmpty (NonEmpty a)+   , groupBy1    -- :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a)+   , groupWith1     -- :: (Foldable f, Eq b) => (a -> b) -> f a -> NonEmpty (NonEmpty a)+   , groupAllWith1  -- :: (Foldable f, Ord b) => (a -> b) -> f a -> NonEmpty (NonEmpty a)+   -- * Sublist predicates+   , isPrefixOf  -- :: Foldable f => f a -> NonEmpty a -> Bool+   -- * \"Set\" operations+   , nub         -- :: Eq a => NonEmpty a -> NonEmpty a+   , nubBy       -- :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a+   -- * Indexing streams+   , (!!)        -- :: NonEmpty a -> Int -> a+   -- * Zipping and unzipping streams+   , zip         -- :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b)+   , zipWith     -- :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c+   , unzip       -- :: NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)+   -- * Converting to and from a list+   , fromList    -- :: [a] -> NonEmpty a+   , toList      -- :: NonEmpty a -> [a]+   , nonEmpty    -- :: [a] -> Maybe (NonEmpty a)+   , xor         -- :: NonEmpty a -> Bool+   ) where+++import           Prelude             hiding (break, cycle, drop, dropWhile,+                                      filter, foldl, foldr, head, init, iterate,+                                      last, length, map, repeat, reverse,+                                      scanl, scanl1, scanr, scanr1, span,+                                      splitAt, tail, take, takeWhile,+                                      unzip, zip, zipWith, (!!))+import qualified Prelude++import           Control.Applicative (Alternative, many)+import           Control.Monad       (ap)+import           Control.Monad.Fix+import           Control.Monad.Zip   (MonadZip(..))+import           Data.Data           (Data)+import           Data.Foldable       hiding (length, toList)+import qualified Data.Foldable       as Foldable+import           Data.Function       (on)+import qualified Data.List           as List+import           Data.Ord            (comparing)+import qualified GHC.Exts            as Exts (IsList(..))+import           GHC.Generics        (Generic, Generic1)++infixr 5 :|, <|++-- | Non-empty (and non-strict) list type.+--+-- @since 4.9.0.0+data NonEmpty a = a :| [a]+  deriving ( Eq, Ord, Show, Read, Data, Generic, Generic1 )++instance Exts.IsList (NonEmpty a) where+  type Item (NonEmpty a) = a+  fromList               = fromList+  toList                 = toList++instance MonadFix NonEmpty where+  mfix f = case fix (f . head) of+             ~(x :| _) -> x :| mfix (tail . f)++instance MonadZip NonEmpty where+  mzip     = zip+  mzipWith = zipWith+  munzip   = unzip++-- | Number of elements in 'NonEmpty' list.+length :: NonEmpty a -> Int+length (_ :| xs) = 1 + Prelude.length xs++-- | Compute n-ary logic exclusive OR operation on 'NonEmpty' list.+xor :: NonEmpty Bool -> Bool+xor (x :| xs)   = foldr xor' x xs+  where xor' True y  = not y+        xor' False y = y++-- | 'unfold' produces a new stream by repeatedly applying the unfolding+-- function to the seed value to produce an element of type @b@ and a new+-- seed value.  When the unfolding function returns 'Nothing' instead of+-- a new seed value, the stream ends.+unfold :: (a -> (b, Maybe a)) -> a -> NonEmpty b+unfold f a = case f a of+  (b, Nothing) -> b :| []+  (b, Just c)  -> b <| unfold f c++-- | 'nonEmpty' efficiently turns a normal list into a 'NonEmpty' stream,+-- producing 'Nothing' if the input is empty.+nonEmpty :: [a] -> Maybe (NonEmpty a)+nonEmpty []     = Nothing+nonEmpty (a:as) = Just (a :| as)++-- | 'uncons' produces the first element of the stream, and a stream of the+-- remaining elements, if any.+uncons :: NonEmpty a -> (a, Maybe (NonEmpty a))+uncons ~(a :| as) = (a, nonEmpty as)++-- | The 'unfoldr' function is analogous to "Data.List"'s+-- 'Data.List.unfoldr' operation.+unfoldr :: (a -> (b, Maybe a)) -> a -> NonEmpty b+unfoldr f a = case f a of+  (b, mc) -> b :| maybe [] go mc+ where+    go c = case f c of+      (d, me) -> d : maybe [] go me++instance Functor NonEmpty where+  fmap f ~(a :| as) = f a :| fmap f as+  b <$ ~(_ :| as)   = b   :| (b <$ as)++instance Applicative NonEmpty where+  pure a = a :| []+  (<*>) = ap++instance Monad NonEmpty where+  ~(a :| as) >>= f = b :| (bs ++ bs')+    where b :| bs = f a+          bs' = as >>= toList . f++instance Traversable NonEmpty where+  traverse f ~(a :| as) = (:|) <$> f a <*> traverse f as++instance Foldable NonEmpty where+  foldr f z ~(a :| as) = f a (foldr f z as)+  foldl f z ~(a :| as) = foldl f (f z a) as+  foldl1 f ~(a :| as) = foldl f a as+  foldMap f ~(a :| as) = f a `mappend` foldMap f as+  fold ~(m :| ms) = m `mappend` fold ms++-- | Extract the first element of the stream.+head :: NonEmpty a -> a+head ~(a :| _) = a++-- | Extract the possibly-empty tail of the stream.+tail :: NonEmpty a -> [a]+tail ~(_ :| as) = as++-- | Extract the last element of the stream.+last :: NonEmpty a -> a+last ~(a :| as) = List.last (a : as)++-- | Extract everything except the last element of the stream.+init :: NonEmpty a -> [a]+init ~(a :| as) = List.init (a : as)++-- | Prepend an element to the stream.+(<|) :: a -> NonEmpty a -> NonEmpty a+a <| ~(b :| bs) = a :| b : bs++-- | Synonym for '<|'.+cons :: a -> NonEmpty a -> NonEmpty a+cons = (<|)++-- | Sort a stream.+sort :: Ord a => NonEmpty a -> NonEmpty a+sort = lift List.sort++-- | Converts a normal list to a 'NonEmpty' stream.+--+-- Raises an error if given an empty list.+fromList :: [a] -> NonEmpty a+fromList (a:as) = a :| as+fromList [] = errorWithoutStackTrace "NonEmpty.fromList: empty list"++-- | Convert a stream to a normal list efficiently.+toList :: NonEmpty a -> [a]+toList ~(a :| as) = a : as++-- | Lift list operations to work on a 'NonEmpty' stream.+--+-- /Beware/: If the provided function returns an empty list,+-- this will raise an error.+lift :: Foldable f => ([a] -> [b]) -> f a -> NonEmpty b+lift f = fromList . f . Foldable.toList++-- | Map a function over a 'NonEmpty' stream.+map :: (a -> b) -> NonEmpty a -> NonEmpty b+map f ~(a :| as) = f a :| fmap f as++-- | The 'inits' function takes a stream @xs@ and returns all the+-- finite prefixes of @xs@.+inits :: Foldable f => f a -> NonEmpty [a]+inits = fromList . List.inits . Foldable.toList++-- | The 'tails' function takes a stream @xs@ and returns all the+-- suffixes of @xs@.+tails   :: Foldable f => f a -> NonEmpty [a]+tails = fromList . List.tails . Foldable.toList++-- | @'insert' x xs@ inserts @x@ into the last position in @xs@ where it+-- is still less than or equal to the next element. In particular, if the+-- list is sorted beforehand, the result will also be sorted.+insert  :: (Foldable f, Ord a) => a -> f a -> NonEmpty a+insert a = fromList . List.insert a . Foldable.toList++-- | @'some1' x@ sequences @x@ one or more times.+some1 :: Alternative f => f a -> f (NonEmpty a)+some1 x = (:|) <$> x <*> many x++-- | 'scanl' is similar to 'foldl', but returns a stream of successive+-- reduced values from the left:+--+-- > scanl f z [x1, x2, ...] == z :| [z `f` x1, (z `f` x1) `f` x2, ...]+--+-- Note that+--+-- > last (scanl f z xs) == foldl f z xs.+scanl   :: Foldable f => (b -> a -> b) -> b -> f a -> NonEmpty b+scanl f z = fromList . List.scanl f z . Foldable.toList++-- | 'scanr' is the right-to-left dual of 'scanl'.+-- Note that+--+-- > head (scanr f z xs) == foldr f z xs.+scanr   :: Foldable f => (a -> b -> b) -> b -> f a -> NonEmpty b+scanr f z = fromList . List.scanr f z . Foldable.toList++-- | 'scanl1' is a variant of 'scanl' that has no starting value argument:+--+-- > scanl1 f [x1, x2, ...] == x1 :| [x1 `f` x2, x1 `f` (x2 `f` x3), ...]+scanl1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a+scanl1 f ~(a :| as) = fromList (List.scanl f a as)++-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.+scanr1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a+scanr1 f ~(a :| as) = fromList (List.scanr1 f (a:as))++-- | 'intersperse x xs' alternates elements of the list with copies of @x@.+--+-- > intersperse 0 (1 :| [2,3]) == 1 :| [0,2,0,3]+intersperse :: a -> NonEmpty a -> NonEmpty a+intersperse a ~(b :| bs) = b :| case bs of+    [] -> []+    _ -> a : List.intersperse a bs++-- | @'iterate' f x@ produces the infinite sequence+-- of repeated applications of @f@ to @x@.+--+-- > iterate f x = x :| [f x, f (f x), ..]+iterate :: (a -> a) -> a -> NonEmpty a+iterate f a = a :| List.iterate f (f a)++-- | @'cycle' xs@ returns the infinite repetition of @xs@:+--+-- > cycle (1 :| [2,3]) = 1 :| [2,3,1,2,3,...]+cycle :: NonEmpty a -> NonEmpty a+cycle = fromList . List.cycle . toList++-- | 'reverse' a finite NonEmpty stream.+reverse :: NonEmpty a -> NonEmpty a+reverse = lift List.reverse++-- | @'repeat' x@ returns a constant stream, where all elements are+-- equal to @x@.+repeat :: a -> NonEmpty a+repeat a = a :| List.repeat a++-- | @'take' n xs@ returns the first @n@ elements of @xs@.+take :: Int -> NonEmpty a -> [a]+take n = List.take n . toList++-- | @'drop' n xs@ drops the first @n@ elements off the front of+-- the sequence @xs@.+drop :: Int -> NonEmpty a -> [a]+drop n = List.drop n . toList++-- | @'splitAt' n xs@ returns a pair consisting of the prefix of @xs@+-- of length @n@ and the remaining stream immediately following this prefix.+--+-- > 'splitAt' n xs == ('take' n xs, 'drop' n xs)+-- > xs == ys ++ zs where (ys, zs) = 'splitAt' n xs+splitAt :: Int -> NonEmpty a -> ([a],[a])+splitAt n = List.splitAt n . toList++-- | @'takeWhile' p xs@ returns the longest prefix of the stream+-- @xs@ for which the predicate @p@ holds.+takeWhile :: (a -> Bool) -> NonEmpty a -> [a]+takeWhile p = List.takeWhile p . toList++-- | @'dropWhile' p xs@ returns the suffix remaining after+-- @'takeWhile' p xs@.+dropWhile :: (a -> Bool) -> NonEmpty a -> [a]+dropWhile p = List.dropWhile p . toList++-- | @'span' p xs@ returns the longest prefix of @xs@ that satisfies+-- @p@, together with the remainder of the stream.+--+-- > 'span' p xs == ('takeWhile' p xs, 'dropWhile' p xs)+-- > xs == ys ++ zs where (ys, zs) = 'span' p xs+span :: (a -> Bool) -> NonEmpty a -> ([a], [a])+span p = List.span p . toList++-- | The @'break' p@ function is equivalent to @'span' (not . p)@.+break :: (a -> Bool) -> NonEmpty a -> ([a], [a])+break p = span (not . p)++-- | @'filter' p xs@ removes any elements from @xs@ that do not satisfy @p@.+filter :: (a -> Bool) -> NonEmpty a -> [a]+filter p = List.filter p . toList++-- | The 'partition' function takes a predicate @p@ and a stream+-- @xs@, and returns a pair of lists. The first list corresponds to the+-- elements of @xs@ for which @p@ holds; the second corresponds to the+-- elements of @xs@ for which @p@ does not hold.+--+-- > 'partition' p xs = ('filter' p xs, 'filter' (not . p) xs)+partition :: (a -> Bool) -> NonEmpty a -> ([a], [a])+partition p = List.partition p . toList++-- | The 'group' function takes a stream and returns a list of+-- streams such that flattening the resulting list is equal to the+-- argument.  Moreover, each stream in the resulting list+-- contains only equal elements.  For example, in list notation:+--+-- > 'group' $ 'cycle' "Mississippi"+-- >   = "M" : "i" : "ss" : "i" : "ss" : "i" : "pp" : "i" : "M" : "i" : ...+group :: (Foldable f, Eq a) => f a -> [NonEmpty a]+group = groupBy (==)++-- | 'groupBy' operates like 'group', but uses the provided equality+-- predicate instead of `==`.+groupBy :: Foldable f => (a -> a -> Bool) -> f a -> [NonEmpty a]+groupBy eq0 = go eq0 . Foldable.toList+  where+    go _  [] = []+    go eq (x : xs) = (x :| ys) : groupBy eq zs+      where (ys, zs) = List.span (eq x) xs++-- | 'groupWith' operates like 'group', but uses the provided projection when+-- comparing for equality+groupWith :: (Foldable f, Eq b) => (a -> b) -> f a -> [NonEmpty a]+groupWith f = groupBy ((==) `on` f)++-- | 'groupAllWith' operates like 'groupWith', but sorts the list+-- first so that each equivalence class has, at most, one list in the+-- output+groupAllWith :: (Ord b) => (a -> b) -> [a] -> [NonEmpty a]+groupAllWith f = groupWith f . List.sortBy (compare `on` f)++-- | 'group1' operates like 'group', but uses the knowledge that its+-- input is non-empty to produce guaranteed non-empty output.+group1 :: Eq a => NonEmpty a -> NonEmpty (NonEmpty a)+group1 = groupBy1 (==)++-- | 'groupBy1' is to 'group1' as 'groupBy' is to 'group'.+groupBy1 :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a)+groupBy1 eq (x :| xs) = (x :| ys) :| groupBy eq zs+  where (ys, zs) = List.span (eq x) xs++-- | 'groupWith1' is to 'group1' as 'groupWith' is to 'group'+groupWith1 :: (Eq b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a)+groupWith1 f = groupBy1 ((==) `on` f)++-- | 'groupAllWith1' is to 'groupWith1' as 'groupAllWith' is to 'groupWith'+groupAllWith1 :: (Ord b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a)+groupAllWith1 f = groupWith1 f . sortWith f++-- | The 'isPrefix' function returns @True@ if the first argument is+-- a prefix of the second.+isPrefixOf :: Eq a => [a] -> NonEmpty a -> Bool+isPrefixOf [] _ = True+isPrefixOf (y:ys) (x :| xs) = (y == x) && List.isPrefixOf ys xs++-- | @xs !! n@ returns the element of the stream @xs@ at index+-- @n@. Note that the head of the stream has index 0.+--+-- /Beware/: a negative or out-of-bounds index will cause an error.+(!!) :: NonEmpty a -> Int -> a+(!!) ~(x :| xs) n+  | n == 0 = x+  | n > 0  = xs List.!! (n - 1)+  | otherwise = errorWithoutStackTrace "NonEmpty.!! negative argument"++-- | The 'zip' function takes two streams and returns a stream of+-- corresponding pairs.+zip :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b)+zip ~(x :| xs) ~(y :| ys) = (x, y) :| List.zip xs ys++-- | The 'zipWith' function generalizes 'zip'. Rather than tupling+-- the elements, the elements are combined using the function+-- passed as the first argument.+zipWith :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c+zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys++-- | The 'unzip' function is the inverse of the 'zip' function.+unzip :: Functor f => f (a,b) -> (f a, f b)+unzip xs = (fst <$> xs, snd <$> xs)++-- | The 'nub' function removes duplicate elements from a list. In+-- particular, it keeps only the first occurence of each element.+-- (The name 'nub' means \'essence\'.)+-- It is a special case of 'nubBy', which allows the programmer to+-- supply their own inequality test.+nub :: Eq a => NonEmpty a -> NonEmpty a+nub = nubBy (==)++-- | The 'nubBy' function behaves just like 'nub', except it uses a+-- user-supplied equality predicate instead of the overloaded '=='+-- function.+nubBy :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a+nubBy eq (a :| as) = a :| List.nubBy eq (List.filter (\b -> not (eq a b)) as)++-- | 'transpose' for 'NonEmpty', behaves the same as 'Data.List.transpose'+-- The rows/columns need not be the same length, in which case+-- > transpose . transpose /= id+transpose :: NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a)+transpose = fmap fromList+          . fromList . List.transpose . Foldable.toList+          . fmap Foldable.toList++-- | 'sortBy' for 'NonEmpty', behaves the same as 'Data.List.sortBy'+sortBy :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a+sortBy f = lift (List.sortBy f)++-- | 'sortWith' for 'NonEmpty', behaves the same as:+--+-- > sortBy . comparing+sortWith :: Ord o => (a -> o) -> NonEmpty a -> NonEmpty a+sortWith = sortBy . comparing

@@ -144,7 +144,7 @@ -- *** Exception: Maybe.fromJust: Nothing -- fromJust          :: Maybe a -> a-fromJust Nothing  = error "Maybe.fromJust: Nothing" -- yuck+fromJust Nothing  = errorWithoutStackTrace "Maybe.fromJust: Nothing" -- yuck fromJust (Just x) = x  -- | The 'fromMaybe' function takes a default value and and 'Maybe'

@@ -1,6 +1,5 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PolyKinds #-}@@ -75,6 +74,16 @@         mempty = Dual mempty         Dual x `mappend` Dual y = Dual (y `mappend` x) +instance Functor Dual where+    fmap     = coerce++instance Applicative Dual where+    pure     = Dual+    (<*>)    = coerce++instance Monad Dual where+    m >>= k  = k (getDual m)+ -- | The monoid of endomorphisms under composition. newtype Endo a = Endo { appEndo :: a -> a }                deriving (Generic)@@ -108,6 +117,16 @@         mappend = coerce ((+) :: a -> a -> a) --        Sum x `mappend` Sum y = Sum (x + y) +instance Functor Sum where+    fmap     = coerce++instance Applicative Sum where+    pure     = Sum+    (<*>)    = coerce++instance Monad Sum where+    m >>= k  = k (getSum m)+ -- | Monoid under multiplication. newtype Product a = Product { getProduct :: a }         deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)@@ -117,6 +136,16 @@         mappend = coerce ((*) :: a -> a -> a) --        Product x `mappend` Product y = Product (x * y) +instance Functor Product where+    fmap     = coerce++instance Applicative Product where+    pure     = Product+    (<*>)    = coerce++instance Monad Product where+    m >>= k  = k (getProduct m)+ -- $MaybeExamples -- To implement @find@ or @findLast@ on any 'Foldable': --@@ -182,7 +211,7 @@   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+instance Alternative f => Monoid (Alt f a) where         mempty = Alt empty         mappend = coerce ((<|>) :: f a -> f a -> f a) @@ -206,4 +235,3 @@         where listLastToMaybe [] = Nothing               listLastToMaybe lst = Just (last lst) -- -}-

@@ -563,7 +563,7 @@ -- 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 _ []          =  errorWithoutStackTrace "List.maximumBy: empty list" maximumBy cmp xs        =  foldl1 maxBy xs                         where                            maxBy x y = case cmp x y of@@ -574,7 +574,7 @@ -- 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 _ []          =  errorWithoutStackTrace "List.minimumBy: empty list" minimumBy cmp xs        =  foldl1 minBy xs                         where                            minBy x y = case cmp x y of@@ -629,8 +629,8 @@ 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."+ | otherwise = errorWithoutStackTrace "List.genericIndex: negative argument."+genericIndex _ _      = errorWithoutStackTrace "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.@@ -973,7 +973,7 @@ #endif /* USE_REPORT_PRELUDE */  -- | Sort a list by comparing the results of a key function applied to each--- element.  @sortOn f@ is equivalent to @sortBy . comparing f@, but has the+-- element.  @sortOn f@ is equivalent to @sortBy (comparing f)@, but has the -- performance advantage of only evaluating @f@ once for each element in the -- input list.  This is called the decorate-sort-undecorate paradigm, or -- Schwartzian transform.@@ -1044,6 +1044,20 @@  -- | 'lines' breaks a string up into a list of strings at newline -- characters.  The resulting strings do not contain newlines.+--+-- Note that after splitting the string at newline characters, the+-- last part of the string is considered a line even if it doesn't end+-- with a newline. For example,+--+-- > lines "" == []+-- > lines "\n" == [""]+-- > lines "one" == ["one"]+-- > lines "one\n" == ["one"]+-- > lines "one\n\n" == ["one",""]+-- > lines "one\ntwo" == ["one","two"]+-- > lines "one\ntwo\n" == ["one","two"]+--+-- Thus @'lines' s@ contains at least as many elements as newlines in @s@. lines                   :: String -> [String] lines ""                =  [] -- Somehow GHC doesn't detect the selector thunks in the below code,

@@ -52,11 +52,11 @@   readsPrec d = readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ])  instance Enum (Proxy s) where-    succ _               = error "Proxy.succ"-    pred _               = error "Proxy.pred"+    succ _               = errorWithoutStackTrace "Proxy.succ"+    pred _               = errorWithoutStackTrace "Proxy.pred"     fromEnum _           = 0     toEnum 0             = Proxy-    toEnum _             = error "Proxy.toEnum: 0 expected"+    toEnum _             = errorWithoutStackTrace "Proxy.toEnum: 0 expected"     enumFrom _           = [Proxy]     enumFromThen _ _     = [Proxy]     enumFromThenTo _ _ _ = [Proxy]@@ -89,11 +89,17 @@     _ <*> _ = Proxy     {-# INLINE (<*>) #-} +instance Alternative Proxy where+    empty = Proxy+    {-# INLINE empty #-}+    _ <|> _ = Proxy+    {-# INLINE (<|>) #-}+ instance Monad Proxy where-    return _ = Proxy-    {-# INLINE return #-}     _ >>= _ = Proxy     {-# INLINE (>>=) #-}++instance MonadPlus Proxy  -- | 'asProxyTypeOf' is a type-restricted version of 'const'. -- It is usually used as an infix operator, and its typing forces its first

@@ -0,0 +1,634 @@+{-# LANGUAGE DefaultSignatures   #-}+{-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE DeriveGeneric       #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE PolyKinds           #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Trustworthy         #-}+{-# LANGUAGE TypeOperators       #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- In mathematics, a semigroup is an algebraic structure consisting of a+-- set together with an associative binary operation. A semigroup+-- generalizes a monoid in that there might not exist an identity+-- element. It also (originally) generalized a group (a monoid with all+-- inverses) to a type where every element did not have to have an inverse,+-- thus the name semigroup.+--+-- The use of @(\<\>)@ in this module conflicts with an operator with the same+-- name that is being exported by Data.Monoid. However, this package+-- re-exports (most of) the contents of Data.Monoid, so to use semigroups+-- and monoids in the same package just+--+-- > import Data.Semigroup+--+-- @since 4.9.0.0+----------------------------------------------------------------------------+module Data.Semigroup (+    Semigroup(..)+  , stimesMonoid+  , stimesIdempotent+  , stimesIdempotentMonoid+  , mtimesDefault+  -- * Semigroups+  , Min(..)+  , Max(..)+  , First(..)+  , Last(..)+  , WrappedMonoid(..)+  -- * Re-exported monoids from Data.Monoid+  , Monoid(..)+  , Dual(..)+  , Endo(..)+  , All(..)+  , Any(..)+  , Sum(..)+  , Product(..)+  -- * A better monoid for Maybe+  , Option(..)+  , option+  -- * Difference lists of a semigroup+  , diff+  , cycle1+  -- * ArgMin, ArgMax+  , Arg(..)+  , ArgMin+  , ArgMax+  ) where++import           Prelude             hiding (foldr1)++import           Control.Applicative+import           Control.Monad+import           Control.Monad.Fix+import           Data.Bifunctor+import           Data.Coerce+import           Data.Data+import           Data.List.NonEmpty+import           Data.Monoid         (All (..), Any (..), Dual (..), Endo (..),+                                      Product (..), Sum (..))+import           Data.Monoid         (Alt (..))+import qualified Data.Monoid         as Monoid+import           Data.Void+import           GHC.Generics++infixr 6 <>++-- | The class of semigroups (types with an associative binary operation).+--+-- @since 4.9.0.0+class Semigroup a where+  -- | An associative operation.+  --+  -- @+  -- (a '<>' b) '<>' c = a '<>' (b '<>' c)+  -- @+  --+  -- If @a@ is also a 'Monoid' we further require+  --+  -- @+  -- ('<>') = 'mappend'+  -- @+  (<>) :: a -> a -> a++  default (<>) :: Monoid a => a -> a -> a+  (<>) = mappend++  -- | Reduce a non-empty list with @\<\>@+  --+  -- The default definition should be sufficient, but this can be+  -- overridden for efficiency.+  --+  sconcat :: NonEmpty a -> a+  sconcat (a :| as) = go a as where+    go b (c:cs) = b <> go c cs+    go b []     = b++  -- | Repeat a value @n@ times.+  --+  -- Given that this works on a 'Semigroup' it is allowed to fail if+  -- you request 0 or fewer repetitions, and the default definition+  -- will do so.+  --+  -- By making this a member of the class, idempotent semigroups and monoids can+  -- upgrade this to execute in /O(1)/ by picking+  -- @stimes = stimesIdempotent@ or @stimes = stimesIdempotentMonoid@+  -- respectively.+  stimes :: Integral b => b -> a -> a+  stimes y0 x0+    | y0 <= 0   = errorWithoutStackTrace "stimes: positive multiplier expected"+    | otherwise = f x0 y0+    where+      f x y+        | even y = f (x <> x) (y `quot` 2)+        | y == 1 = x+        | otherwise = g (x <> x) (pred y  `quot` 2) x+      g x y z+        | even y = g (x <> x) (y `quot` 2) z+        | y == 1 = x <> z+        | otherwise = g (x <> x) (pred y `quot` 2) (x <> z)++-- | A generalization of 'Data.List.cycle' to an arbitrary 'Semigroup'.+-- May fail to terminate for some values in some semigroups.+cycle1 :: Semigroup m => m -> m+cycle1 xs = xs' where xs' = xs <> xs'++instance Semigroup () where+  _ <> _ = ()+  sconcat _ = ()+  stimes _ _ = ()++instance Semigroup b => Semigroup (a -> b) where+  f <> g = \a -> f a <> g a+  stimes n f e = stimes n (f e)++instance Semigroup [a] where+  (<>) = (++)+  stimes n x+    | n < 0 = errorWithoutStackTrace "stimes: [], negative multiplier"+    | otherwise = rep n+    where+      rep 0 = []+      rep i = x ++ rep (i - 1)++instance Semigroup a => Semigroup (Maybe a) where+  Nothing <> b       = b+  a       <> Nothing = a+  Just a  <> Just b  = Just (a <> b)+  stimes _ Nothing  = Nothing+  stimes n (Just a) = case compare n 0 of+    LT -> errorWithoutStackTrace "stimes: Maybe, negative multiplier"+    EQ -> Nothing+    GT -> Just (stimes n a)++instance Semigroup (Either a b) where+  Left _ <> b = b+  a      <> _ = a+  stimes = stimesIdempotent++instance (Semigroup a, Semigroup b) => Semigroup (a, b) where+  (a,b) <> (a',b') = (a<>a',b<>b')+  stimes n (a,b) = (stimes n a, stimes n b)++instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where+  (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c')+  stimes n (a,b,c) = (stimes n a, stimes n b, stimes n c)++instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d)+         => Semigroup (a, b, c, d) where+  (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d')+  stimes n (a,b,c,d) = (stimes n a, stimes n b, stimes n c, stimes n d)++instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e)+         => Semigroup (a, b, c, d, e) where+  (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e')+  stimes n (a,b,c,d,e) =+      (stimes n a, stimes n b, stimes n c, stimes n d, stimes n e)++instance Semigroup Ordering where+  LT <> _ = LT+  EQ <> y = y+  GT <> _ = GT+  stimes = stimesIdempotentMonoid++instance Semigroup a => Semigroup (Dual a) where+  Dual a <> Dual b = Dual (b <> a)+  stimes n (Dual a) = Dual (stimes n a)++instance Semigroup (Endo a) where+  (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> (a -> a))+  stimes = stimesMonoid++instance Semigroup All where+  (<>) = coerce (&&)+  stimes = stimesIdempotentMonoid++instance Semigroup Any where+  (<>) = coerce (||)+  stimes = stimesIdempotentMonoid+++instance Num a => Semigroup (Sum a) where+  (<>) = coerce ((+) :: a -> a -> a)+  stimes n (Sum a) = Sum (fromIntegral n * a)++instance Num a => Semigroup (Product a) where+  (<>) = coerce ((*) :: a -> a -> a)+  stimes n (Product a) = Product (a ^ n)++-- | This is a valid definition of 'stimes' for a 'Monoid'.+--+-- Unlike the default definition of 'stimes', it is defined for 0+-- and so it should be preferred where possible.+stimesMonoid :: (Integral b, Monoid a) => b -> a -> a+stimesMonoid n x0 = case compare n 0 of+  LT -> errorWithoutStackTrace "stimesMonoid: negative multiplier"+  EQ -> mempty+  GT -> f x0 n+    where+      f x y+        | even y = f (x `mappend` x) (y `quot` 2)+        | y == 1 = x+        | otherwise = g (x `mappend` x) (pred y  `quot` 2) x+      g x y z+        | even y = g (x `mappend` x) (y `quot` 2) z+        | y == 1 = x `mappend` z+        | otherwise = g (x `mappend` x) (pred y `quot` 2) (x `mappend` z)++-- | This is a valid definition of 'stimes' for an idempotent 'Monoid'.+--+-- When @mappend x x = x@, this definition should be preferred, because it+-- works in /O(1)/ rather than /O(log n)/+stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a+stimesIdempotentMonoid n x = case compare n 0 of+  LT -> errorWithoutStackTrace "stimesIdempotentMonoid: negative multiplier"+  EQ -> mempty+  GT -> x++-- | This is a valid definition of 'stimes' for an idempotent 'Semigroup'.+--+-- When @x <> x = x@, this definition should be preferred, because it+-- works in /O(1)/ rather than /O(log n)/.+stimesIdempotent :: Integral b => b -> a -> a+stimesIdempotent n x+  | n <= 0 = errorWithoutStackTrace "stimesIdempotent: positive multiplier expected"+  | otherwise = x++instance Semigroup a => Semigroup (Const a b) where+  (<>) = coerce ((<>) :: a -> a -> a)+  stimes n (Const a) = Const (stimes n a)++instance Semigroup (Monoid.First a) where+  Monoid.First Nothing <> b = b+  a                    <> _ = a+  stimes = stimesIdempotentMonoid++instance Semigroup (Monoid.Last a) where+  a <> Monoid.Last Nothing = a+  _ <> b                   = b+  stimes = stimesIdempotentMonoid++instance Alternative f => Semigroup (Alt f a) where+  (<>) = coerce ((<|>) :: f a -> f a -> f a)+  stimes = stimesMonoid++instance Semigroup Void where+  a <> _ = a+  stimes = stimesIdempotent++instance Semigroup (NonEmpty a) where+  (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs)+++newtype Min a = Min { getMin :: a }+  deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1)++instance Bounded a => Bounded (Min a) where+  minBound = Min minBound+  maxBound = Min maxBound++instance Enum a => Enum (Min a) where+  succ (Min a) = Min (succ a)+  pred (Min a) = Min (pred a)+  toEnum = Min . toEnum+  fromEnum = fromEnum . getMin+  enumFrom (Min a) = Min <$> enumFrom a+  enumFromThen (Min a) (Min b) = Min <$> enumFromThen a b+  enumFromTo (Min a) (Min b) = Min <$> enumFromTo a b+  enumFromThenTo (Min a) (Min b) (Min c) = Min <$> enumFromThenTo a b c+++instance Ord a => Semigroup (Min a) where+  (<>) = coerce (min :: a -> a -> a)+  stimes = stimesIdempotent++instance (Ord a, Bounded a) => Monoid (Min a) where+  mempty = maxBound+  mappend = (<>)++instance Functor Min where+  fmap f (Min x) = Min (f x)++instance Foldable Min where+  foldMap f (Min a) = f a++instance Traversable Min where+  traverse f (Min a) = Min <$> f a++instance Applicative Min where+  pure = Min+  a <* _ = a+  _ *> a = a+  Min f <*> Min x = Min (f x)++instance Monad Min where+  (>>) = (*>)+  Min a >>= f = f a++instance MonadFix Min where+  mfix f = fix (f . getMin)++instance Num a => Num (Min a) where+  (Min a) + (Min b) = Min (a + b)+  (Min a) * (Min b) = Min (a * b)+  (Min a) - (Min b) = Min (a - b)+  negate (Min a) = Min (negate a)+  abs    (Min a) = Min (abs a)+  signum (Min a) = Min (signum a)+  fromInteger    = Min . fromInteger++newtype Max a = Max { getMax :: a }+  deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1)++instance Bounded a => Bounded (Max a) where+  minBound = Max minBound+  maxBound = Max maxBound++instance Enum a => Enum (Max a) where+  succ (Max a) = Max (succ a)+  pred (Max a) = Max (pred a)+  toEnum = Max . toEnum+  fromEnum = fromEnum . getMax+  enumFrom (Max a) = Max <$> enumFrom a+  enumFromThen (Max a) (Max b) = Max <$> enumFromThen a b+  enumFromTo (Max a) (Max b) = Max <$> enumFromTo a b+  enumFromThenTo (Max a) (Max b) (Max c) = Max <$> enumFromThenTo a b c++instance Ord a => Semigroup (Max a) where+  (<>) = coerce (max :: a -> a -> a)+  stimes = stimesIdempotent++instance (Ord a, Bounded a) => Monoid (Max a) where+  mempty = minBound+  mappend = (<>)++instance Functor Max where+  fmap f (Max x) = Max (f x)++instance Foldable Max where+  foldMap f (Max a) = f a++instance Traversable Max where+  traverse f (Max a) = Max <$> f a++instance Applicative Max where+  pure = Max+  a <* _ = a+  _ *> a = a+  Max f <*> Max x = Max (f x)++instance Monad Max where+  (>>) = (*>)+  Max a >>= f = f a++instance MonadFix Max where+  mfix f = fix (f . getMax)++instance Num a => Num (Max a) where+  (Max a) + (Max b) = Max (a + b)+  (Max a) * (Max b) = Max (a * b)+  (Max a) - (Max b) = Max (a - b)+  negate (Max a) = Max (negate a)+  abs    (Max a) = Max (abs a)+  signum (Max a) = Max (signum a)+  fromInteger    = Max . fromInteger++-- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be+-- placed inside 'Min' and 'Max' to compute an arg min or arg max.+data Arg a b = Arg a b deriving+  (Show, Read, Data, Typeable, Generic, Generic1)++type ArgMin a b = Min (Arg a b)+type ArgMax a b = Max (Arg a b)++instance Functor (Arg a) where+  fmap f (Arg x a) = Arg x (f a)++instance Foldable (Arg a) where+  foldMap f (Arg _ a) = f a++instance Traversable (Arg a) where+  traverse f (Arg x a) = Arg x <$> f a++instance Eq a => Eq (Arg a b) where+  Arg a _ == Arg b _ = a == b++instance Ord a => Ord (Arg a b) where+  Arg a _ `compare` Arg b _ = compare a b+  min x@(Arg a _) y@(Arg b _)+    | a <= b    = x+    | otherwise = y+  max x@(Arg a _) y@(Arg b _)+    | a >= b    = x+    | otherwise = y++instance Bifunctor Arg where+  bimap f g (Arg a b) = Arg (f a) (g b)++-- | Use @'Option' ('First' a)@ to get the behavior of+-- 'Data.Monoid.First' from "Data.Monoid".+newtype First a = First { getFirst :: a } deriving+  (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1)++instance Bounded a => Bounded (First a) where+  minBound = First minBound+  maxBound = First maxBound++instance Enum a => Enum (First a) where+  succ (First a) = First (succ a)+  pred (First a) = First (pred a)+  toEnum = First . toEnum+  fromEnum = fromEnum . getFirst+  enumFrom (First a) = First <$> enumFrom a+  enumFromThen (First a) (First b) = First <$> enumFromThen a b+  enumFromTo (First a) (First b) = First <$> enumFromTo a b+  enumFromThenTo (First a) (First b) (First c) = First <$> enumFromThenTo a b c++instance Semigroup (First a) where+  a <> _ = a+  stimes = stimesIdempotent++instance Functor First where+  fmap f (First x) = First (f x)++instance Foldable First where+  foldMap f (First a) = f a++instance Traversable First where+  traverse f (First a) = First <$> f a++instance Applicative First where+  pure x = First x+  a <* _ = a+  _ *> a = a+  First f <*> First x = First (f x)++instance Monad First where+  (>>) = (*>)+  First a >>= f = f a++instance MonadFix First where+  mfix f = fix (f . getFirst)++-- | Use @'Option' ('Last' a)@ to get the behavior of+-- 'Data.Monoid.Last' from "Data.Monoid"+newtype Last a = Last { getLast :: a } deriving+  (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1)++instance Bounded a => Bounded (Last a) where+  minBound = Last minBound+  maxBound = Last maxBound++instance Enum a => Enum (Last a) where+  succ (Last a) = Last (succ a)+  pred (Last a) = Last (pred a)+  toEnum = Last . toEnum+  fromEnum = fromEnum . getLast+  enumFrom (Last a) = Last <$> enumFrom a+  enumFromThen (Last a) (Last b) = Last <$> enumFromThen a b+  enumFromTo (Last a) (Last b) = Last <$> enumFromTo a b+  enumFromThenTo (Last a) (Last b) (Last c) = Last <$> enumFromThenTo a b c++instance Semigroup (Last a) where+  _ <> b = b+  stimes = stimesIdempotent++instance Functor Last where+  fmap f (Last x) = Last (f x)+  a <$ _ = Last a++instance Foldable Last where+  foldMap f (Last a) = f a++instance Traversable Last where+  traverse f (Last a) = Last <$> f a++instance Applicative Last where+  pure = Last+  a <* _ = a+  _ *> a = a+  Last f <*> Last x = Last (f x)++instance Monad Last where+  (>>) = (*>)+  Last a >>= f = f a++instance MonadFix Last where+  mfix f = fix (f . getLast)++-- | Provide a Semigroup for an arbitrary Monoid.+newtype WrappedMonoid m = WrapMonoid { unwrapMonoid :: m }+  deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1)++instance Monoid m => Semigroup (WrappedMonoid m) where+  (<>) = coerce (mappend :: m -> m -> m)++instance Monoid m => Monoid (WrappedMonoid m) where+  mempty = WrapMonoid mempty+  mappend = (<>)++instance Bounded a => Bounded (WrappedMonoid a) where+  minBound = WrapMonoid minBound+  maxBound = WrapMonoid maxBound++instance Enum a => Enum (WrappedMonoid a) where+  succ (WrapMonoid a) = WrapMonoid (succ a)+  pred (WrapMonoid a) = WrapMonoid (pred a)+  toEnum = WrapMonoid . toEnum+  fromEnum = fromEnum . unwrapMonoid+  enumFrom (WrapMonoid a) = WrapMonoid <$> enumFrom a+  enumFromThen (WrapMonoid a) (WrapMonoid b) = WrapMonoid <$> enumFromThen a b+  enumFromTo (WrapMonoid a) (WrapMonoid b) = WrapMonoid <$> enumFromTo a b+  enumFromThenTo (WrapMonoid a) (WrapMonoid b) (WrapMonoid c) =+      WrapMonoid <$> enumFromThenTo a b c++-- | Repeat a value @n@ times.+--+-- > mtimesDefault n a = a <> a <> ... <> a  -- using <> (n-1) times+--+-- Implemented using 'stimes' and 'mempty'.+--+-- This is a suitable definition for an 'mtimes' member of 'Monoid'.+mtimesDefault :: (Integral b, Monoid a) => b -> a -> a+mtimesDefault n x+  | n == 0    = mempty+  | otherwise = unwrapMonoid (stimes n (WrapMonoid x))++-- | 'Option' is effectively 'Maybe' with a better instance of+-- 'Monoid', built off of an underlying 'Semigroup' instead of an+-- underlying 'Monoid'.+--+-- Ideally, this type would not exist at all and we would just fix the+-- 'Monoid' instance of 'Maybe'+newtype Option a = Option { getOption :: Maybe a }+  deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1)++instance Functor Option where+  fmap f (Option a) = Option (fmap f a)++instance Applicative Option where+  pure a = Option (Just a)+  Option a <*> Option b = Option (a <*> b)++  Option Nothing  *>  _ = Option Nothing+  _               *>  b = b++instance Monad Option where+  Option (Just a) >>= k = k a+  _               >>= _ = Option Nothing+  (>>) = (*>)++instance Alternative Option where+  empty = Option Nothing+  Option Nothing <|> b = b+  a <|> _ = a++instance MonadPlus Option where+  mzero = Option Nothing+  mplus = (<|>)++instance MonadFix Option where+  mfix f = Option (mfix (getOption . f))++instance Foldable Option where+  foldMap f (Option (Just m)) = f m+  foldMap _ (Option Nothing)  = mempty++instance Traversable Option where+  traverse f (Option (Just a)) = Option . Just <$> f a+  traverse _ (Option Nothing)  = pure (Option Nothing)++-- | Fold an 'Option' case-wise, just like 'maybe'.+option :: b -> (a -> b) -> Option a -> b+option n j (Option m) = maybe n j m++instance Semigroup a => Semigroup (Option a) where+  (<>) = coerce ((<>) :: Maybe a -> Maybe a -> Maybe a)++  stimes _ (Option Nothing) = Option Nothing+  stimes n (Option (Just a)) = case compare n 0 of+    LT -> errorWithoutStackTrace "stimes: Option, negative multiplier"+    EQ -> Option Nothing+    GT -> Option (Just (stimes n a))++instance Semigroup a => Monoid (Option a) where+  mempty = Option Nothing+  mappend = (<>)++-- | This lets you use a difference list of a 'Semigroup' as a 'Monoid'.+diff :: Semigroup m => m -> Endo m+diff = Endo . (<>)++instance Semigroup (Proxy s) where+  _ <> _ = Proxy+  sconcat _ = Proxy+  stimes _ _ = Proxy

@@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}  ----------------------------------------------------------------------------- -- |@@ -27,6 +28,7 @@  ) where  import GHC.Base+import Data.Functor.Const (Const (Const)) import Data.List (lines, words, unlines, unwords)  -- | Class for string-like datastructures; used by the overloaded string@@ -34,6 +36,48 @@ class IsString a where     fromString :: String -> a -instance IsString [Char] where+{- Note [IsString String]+~~~~~~~~~~~~~~~~~~~~~~~~~+Previously, the IsString instance that covered String was a flexible+instance for [Char]. This is in some sense the most accurate choice,+but there are cases where it can lead to an ambiguity, for instance:++  show $ "foo" ++ "bar"++The use of (++) ensures that "foo" and "bar" must have type [t] for+some t, but a flexible instance for [Char] will _only_ match if+something further determines t to be Char, and nothing in the above+example actually does.++So, the above example generates an error about the ambiguity of t,+and what's worse, the above behavior can be generated by simply+typing:++   "foo" ++ "bar"++into GHCi with the OverloadedStrings extension enabled.++The new instance fixes this by defining an instance that matches all+[a], and forces a to be Char. This instance, of course, overlaps+with things that the [Char] flexible instance doesn't, but this was+judged to be an acceptable cost, for the gain of providing a less+confusing experience for people experimenting with overloaded strings.++It may be possible to fix this via (extended) defaulting. Currently,+the rules are not able to default t to Char in the above example. If+a more flexible system that enabled this defaulting were put in place,+then it would probably make sense to revert to the flexible [Char]+instance, since extended defaulting is enabled in GHCi. However, it+is not clear at the time of this note exactly what such a system+would be, and it certainly hasn't been implemented.++A test case (should_run/overloadedstringsrun01.hs) has been added to+ensure the good behavior of the above example remains in the future.+-}++instance (a ~ Char) => IsString [a] where+         -- See Note [IsString String]     fromString xs = xs +instance IsString a => IsString (Const a b) where+    fromString = Const . fromString

@@ -1,5 +1,9 @@-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeOperators #-}  ----------------------------------------------------------------------------- -- |@@ -46,16 +50,19 @@     foldMapDefault,     ) where -import Control.Applicative ( Const(..) )+-- It is convenient to use 'Const' here but this means we must+-- define a few instances here which really belong in Control.Applicative+import Control.Applicative ( Const(..), ZipList(..) ) import Data.Either ( Either(..) ) import Data.Foldable ( Foldable ) import Data.Functor+import Data.Monoid ( Dual(..), Sum(..), Product(..), First(..), Last(..) ) import Data.Proxy ( Proxy(..) )  import GHC.Arr import GHC.Base ( Applicative(..), Monad(..), Monoid, Maybe(..),                   ($), (.), id, flip )-import qualified GHC.Base as Monad ( mapM )+import GHC.Generics import qualified GHC.List as List ( foldr )  -- | Functors representing data structures that can be traversed from@@ -103,7 +110,7 @@ -- >   instance Functor Identity where -- >     fmap f (Identity x) = Identity (f x) -- >--- >   instance Applicative Indentity where+-- >   instance Applicative Identity where -- >     pure x = Identity x -- >     Identity f <*> Identity x = Identity (f x) -- >@@ -179,8 +186,6 @@     traverse f = List.foldr cons_f (pure [])       where cons_f x ys = (:) <$> f x <*> ys -    mapM = Monad.mapM- instance Traversable (Either a) where     traverse _ (Left x) = pure (Left x)     traverse f (Right y) = Right <$> f y@@ -196,13 +201,57 @@     {-# INLINE traverse #-}     sequenceA _ = pure Proxy     {-# INLINE sequenceA #-}-    mapM _ _ = return Proxy+    mapM _ _ = pure Proxy     {-# INLINE mapM #-}-    sequence _ = return Proxy+    sequence _ = pure Proxy     {-# INLINE sequence #-}  instance Traversable (Const m) where     traverse _ (Const m) = pure $ Const m++instance Traversable Dual where+    traverse f (Dual x) = Dual <$> f x++instance Traversable Sum where+    traverse f (Sum x) = Sum <$> f x++instance Traversable Product where+    traverse f (Product x) = Product <$> f x++instance Traversable First where+    traverse f (First x) = First <$> traverse f x++instance Traversable Last where+    traverse f (Last x) = Last <$> traverse f x++instance Traversable ZipList where+    traverse f (ZipList x) = ZipList <$> traverse f x++-- Instances for GHC.Generics+instance Traversable U1 where+    traverse _ _ = pure U1+    {-# INLINE traverse #-}+    sequenceA _ = pure U1+    {-# INLINE sequenceA #-}+    mapM _ _ = pure U1+    {-# INLINE mapM #-}+    sequence _ = pure U1+    {-# INLINE sequence #-}++deriving instance Traversable V1+deriving instance Traversable Par1+deriving instance Traversable f => Traversable (Rec1 f)+deriving instance Traversable (K1 i c)+deriving instance Traversable f => Traversable (M1 i c f)+deriving instance (Traversable f, Traversable g) => Traversable (f :+: g)+deriving instance (Traversable f, Traversable g) => Traversable (f :*: g)+deriving instance (Traversable f, Traversable g) => Traversable (f :.: g)+deriving instance Traversable UAddr+deriving instance Traversable UChar+deriving instance Traversable UDouble+deriving instance Traversable UFloat+deriving instance Traversable UInt+deriving instance Traversable UWord  -- general functions 

@@ -28,8 +28,8 @@  -- | Type-level "If". @If True a b@ ==> @a@; @If False a b@ ==> @b@ type family If cond tru fls where-  If 'True  tru fls = tru-  If 'False tru fls = fls+  If 'True  tru  fls = tru+  If 'False tru  fls = fls  -- | Type-level "and" type family a && b where

@@ -52,19 +52,17 @@ -- Steenbergen for 'type-equality', Edward Kmett for 'eq', and Gabor Greif -- for 'type-eq' -newtype Sym a b = Sym { unsym :: Coercion b a }- -- | Type-safe cast, using representational equality coerceWith :: Coercion a b -> a -> b coerceWith Coercion x = coerce x  -- | Symmetry of representational equality-sym :: forall a b. Coercion a b -> Coercion b a-sym Coercion = unsym (coerce (Sym Coercion :: Sym a a))+sym :: Coercion a b -> Coercion b a+sym Coercion = Coercion  -- | Transitivity of representational equality trans :: Coercion a b -> Coercion b c -> Coercion a c-trans c Coercion = coerce c+trans Coercion Coercion = Coercion  -- | Convert propositional (nominal) equality to representational equality repr :: (a Eq.:~: b) -> Coercion a b@@ -79,7 +77,7 @@  instance Coercible a b => Enum (Coercion a b) where   toEnum 0 = Coercion-  toEnum _ = error "Data.Type.Coercion.toEnum: bad argument"+  toEnum _ = errorWithoutStackTrace "Data.Type.Coercion.toEnum: bad argument"    fromEnum Coercion = 0 @@ -98,4 +96,4 @@   testCoercion Eq.Refl Eq.Refl = Just Coercion  instance TestCoercion (Coercion a) where-  testCoercion c Coercion = Just $ coerce (sym c)+  testCoercion Coercion Coercion = Just Coercion

@@ -1,15 +1,18 @@-{-# LANGUAGE DeriveGeneric        #-}-{-# LANGUAGE TypeOperators        #-}-{-# LANGUAGE GADTs                #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE StandaloneDeriving   #-}-{-# LANGUAGE NoImplicitPrelude    #-}-{-# LANGUAGE PolyKinds            #-}-{-# LANGUAGE RankNTypes           #-}-{-# LANGUAGE DataKinds            #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ExplicitNamespaces   #-}+{-# LANGUAGE DeriveGeneric          #-}+{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE GADTs                  #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE StandaloneDeriving     #-}+{-# LANGUAGE NoImplicitPrelude      #-}+{-# LANGUAGE PolyKinds              #-}+{-# LANGUAGE RankNTypes             #-}+{-# LANGUAGE DataKinds              #-}+{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE UndecidableInstances   #-}+{-# LANGUAGE ExplicitNamespaces     #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE Trustworthy            #-}  ----------------------------------------------------------------------------- -- |@@ -29,9 +32,9 @@   module Data.Type.Equality (-  -- * The equality type-  (:~:)(..),-  +  -- * The equality types+  (:~:)(..), type (~~),+   -- * Working with equality   sym, trans, castWith, gcastWith, apply, inner, outer, @@ -49,6 +52,25 @@ import GHC.Base import Data.Type.Bool +-- | Lifted, homogeneous equality. By lifted, we mean that it can be+-- bogus (deferred type error). By homogeneous, the two types @a@+-- and @b@ must have the same kind.+class a ~~ b => (a :: k) ~ (b :: k) | a -> b, b -> a+  -- See Note [The equality types story] in TysPrim+  -- NB: All this class does is to wrap its superclass, which is+  --     the "real", inhomogeneous equality; this is needed when+  --     we have a Given (a~b), and we want to prove things from it+  -- NB: Not exported, as (~) is magical syntax. That's also why there's+  -- no fixity.++instance {-# INCOHERENT #-} a ~~ b => a ~ b+  -- See Note [The equality types story] in TysPrim+  -- If we have a Wanted (t1 ~ t2), we want to immediately+  -- simplify it to (t1 ~~ t2) and solve that instead+  --+  -- INCOHERENT because we want to use this instance eagerly, even when+  -- the tyvars are partially unknown.+ infix 4 :~:  -- | Propositional equality. If @a :~: b@ is inhabited by some terminating@@ -57,7 +79,7 @@ -- in the body of the pattern-match, the compiler knows that @a ~ b@. -- -- @since 4.7.0.0-data a :~: b where+data a :~: b where  -- See Note [The equality types story] in TysPrim   Refl :: a :~: a  -- with credit to Conal Elliott for 'ty', Erik Hesselink & Martijn van@@ -101,7 +123,7 @@  instance a ~ b => Enum (a :~: b) where   toEnum 0 = Refl-  toEnum _ = error "Data.Type.Equality.toEnum: bad argument"+  toEnum _ = errorWithoutStackTrace "Data.Type.Equality.toEnum: bad argument"    fromEnum Refl = 0 @@ -196,13 +218,13 @@ type family EqBool a b where   EqBool 'True  'True  = 'True   EqBool 'False 'False = 'True-  EqBool a     b       = 'False+  EqBool a      b      = 'False  type family EqOrdering a b where   EqOrdering 'LT 'LT = 'True   EqOrdering 'EQ 'EQ = 'True   EqOrdering 'GT 'GT = 'True-  EqOrdering a  b    = 'False+  EqOrdering a   b   = 'False  type EqUnit (a :: ()) (b :: ()) = 'True @@ -214,7 +236,7 @@ type family EqMaybe a b where   EqMaybe 'Nothing   'Nothing  = 'True   EqMaybe ('Just x) ('Just y)  = x == y-  EqMaybe a        b           = 'False+  EqMaybe a         b          = 'False  type family Eq2 a b where   Eq2 '(a1, b1) '(a2, b2) = a1 == a2 && b1 == b2

@@ -58,7 +58,7 @@          -- * A canonical proxy type         Proxy (..),-        +         -- * Type representations         TypeRep,        -- abstract, instance of: Eq, Show, Typeable         typeRepFingerprint,@@ -66,6 +66,7 @@         showsTypeRep,          TyCon,          -- abstract, instance of: Eq, Show, Typeable+                        -- For now don't export Module, to avoid name clashes         tyConFingerprint,         tyConString,         tyConPackage,@@ -87,7 +88,7 @@         typeRepArgs,    -- :: TypeRep -> [TypeRep]   ) where -import Data.Typeable.Internal hiding (mkTyCon)+import Data.Typeable.Internal import Data.Type.Equality  import Unsafe.Coerce

@@ -3,7 +3,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NoImplicitPrelude #-}@@ -11,6 +10,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeApplications #-}  ----------------------------------------------------------------------------- -- |@@ -26,15 +26,25 @@  module Data.Typeable.Internal (     Proxy (..),-    TypeRep(..),-    KindRep,     Fingerprint(..),++    -- * Typeable class     typeOf, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7,     Typeable1, Typeable2, Typeable3, Typeable4, Typeable5, Typeable6, Typeable7,-    TyCon(..),++    -- * Module+    Module,  -- Abstract+    moduleName, modulePackage,++    -- * TyCon+    TyCon,   -- Abstract+    tyConPackage, tyConModule, tyConName, tyConString, tyConFingerprint,+    mkTyCon3, mkTyCon3#,+    rnfTyCon,++    -- * TypeRep+    TypeRep(..), KindRep,     typeRep,-    mkTyCon,-    mkTyCon3,     mkTyConApp,     mkPolyTyConApp,     mkAppTy,@@ -48,17 +58,16 @@     typeRepFingerprint,     rnfTypeRep,     showsTypeRep,-    tyConString,-    rnfTyCon,-    listTc, funTc,     typeRepKinds,-    typeLitTypeRep+    typeSymbolTypeRep, typeNatTypeRep   ) where  import GHC.Base+import GHC.Types (TYPE) import GHC.Word import GHC.Show import Data.Proxy+import GHC.TypeLits( KnownNat, KnownSymbol, natVal', symbolVal' )  import GHC.Fingerprint.Type import {-# SOURCE #-} GHC.Fingerprint@@ -67,72 +76,155 @@    -- of Data.Typeable as much as possible so we can optimise the derived    -- instances. --- | A concrete representation of a (monomorphic) type.  'TypeRep'--- supports reasonably efficient equality.-data TypeRep = TypeRep {-# UNPACK #-} !Fingerprint TyCon [KindRep] [TypeRep]+#include "MachDeps.h" -type KindRep = TypeRep+{- *********************************************************************+*                                                                      *+                The TyCon type+*                                                                      *+********************************************************************* -} --- Compare keys for equality-instance Eq TypeRep where-  TypeRep x _ _ _ == TypeRep y _ _ _ = x == y+modulePackage :: Module -> String+modulePackage (Module p _) = trNameString p -instance Ord TypeRep where-  TypeRep x _ _ _ <= TypeRep y _ _ _ = x <= y+moduleName :: Module -> String+moduleName (Module _ m) = trNameString m +tyConPackage :: TyCon -> String+tyConPackage (TyCon _ _ m _) = modulePackage m --- | An abstract representation of a type constructor.  'TyCon' objects can--- be built using 'mkTyCon'.-data TyCon = TyCon {-   tyConFingerprint :: {-# UNPACK #-} !Fingerprint, -- ^ @since 4.8.0.0-   tyConPackage :: String, -- ^ @since 4.5.0.0-   tyConModule  :: String, -- ^ @since 4.5.0.0-   tyConName    :: String  -- ^ @since 4.5.0.0- }+tyConModule :: TyCon -> String+tyConModule (TyCon _ _ m _) = moduleName m -instance Eq TyCon where-  (TyCon t1 _ _ _) == (TyCon t2 _ _ _) = t1 == t2+tyConName :: TyCon -> String+tyConName (TyCon _ _ _ n) = trNameString n -instance Ord TyCon where-  (TyCon k1 _ _ _) <= (TyCon k2 _ _ _) = k1 <= k2+trNameString :: TrName -> String+trNameString (TrNameS s) = unpackCString# s+trNameString (TrNameD s) = s ------------------ Construction --------------------+-- | Observe string encoding of a type representation+{-# DEPRECATED tyConString "renamed to 'tyConName'; 'tyConModule' and 'tyConPackage' are also available." #-}+-- deprecated in 7.4+tyConString :: TyCon   -> String+tyConString = tyConName -#include "MachDeps.h"+tyConFingerprint :: TyCon -> Fingerprint+tyConFingerprint (TyCon hi lo _ _)+  = Fingerprint (W64# hi) (W64# lo) --- mkTyCon is an internal function to make it easier for GHC to--- generate derived instances.  GHC precomputes the MD5 hash for the--- TyCon and passes it as two separate 64-bit values to mkTyCon.  The--- TyCon for a derived Typeable instance will end up being statically--- allocated.+mkTyCon3# :: Addr#       -- ^ package name+          -> Addr#       -- ^ module name+          -> Addr#       -- ^ the name of the type constructor+          -> TyCon       -- ^ A unique 'TyCon' object+mkTyCon3# pkg modl name+  | Fingerprint (W64# hi) (W64# lo) <- fingerprint+  = TyCon hi lo (Module (TrNameS pkg) (TrNameS modl)) (TrNameS name)+  where+    fingerprint :: Fingerprint+    fingerprint = fingerprintString (unpackCString# pkg+                                    ++ (' ': unpackCString# modl)+                                    ++ (' ' : unpackCString# name)) -#if WORD_SIZE_IN_BITS < 64-mkTyCon :: Word64# -> Word64# -> String -> String -> String -> TyCon-#else-mkTyCon :: Word#   -> Word#   -> String -> String -> String -> TyCon-#endif-mkTyCon high# low# pkg modl name-  = TyCon (Fingerprint (W64# high#) (W64# low#)) pkg modl name+mkTyCon3 :: String       -- ^ package name+         -> String       -- ^ module name+         -> String       -- ^ the name of the type constructor+         -> TyCon        -- ^ A unique 'TyCon' object+-- Used when the strings are dynamically allocated,+-- eg from binary deserialisation+mkTyCon3 pkg modl name+  | Fingerprint (W64# hi) (W64# lo) <- fingerprint+  = TyCon hi lo (Module (TrNameD pkg) (TrNameD modl)) (TrNameD name)+  where+    fingerprint :: Fingerprint+    fingerprint = fingerprintString (pkg ++ (' ':modl) ++ (' ':name)) --- | Applies a polymorhic type constructor to a sequence of kinds and types+isTupleTyCon :: TyCon -> Bool+isTupleTyCon tc+  | ('(':',':_) <- tyConName tc = True+  | otherwise                   = False++-- | Helper to fully evaluate 'TyCon' for use as @NFData(rnf)@ implementation+--+-- @since 4.8.0.0+rnfModule :: Module -> ()+rnfModule (Module p m) = rnfTrName p `seq` rnfTrName m++rnfTrName :: TrName -> ()+rnfTrName (TrNameS _) = ()+rnfTrName (TrNameD n) = rnfString n++rnfTyCon :: TyCon -> ()+rnfTyCon (TyCon _ _ m n) = rnfModule m `seq` rnfTrName n++rnfString :: [Char] -> ()+rnfString [] = ()+rnfString (c:cs) = c `seq` rnfString cs+++{- *********************************************************************+*                                                                      *+                The TypeRep type+*                                                                      *+********************************************************************* -}++-- | A concrete representation of a (monomorphic) type.+-- 'TypeRep' supports reasonably efficient equality.+data TypeRep = TypeRep {-# UNPACK #-} !Fingerprint TyCon [KindRep] [TypeRep]+     -- NB: For now I've made this lazy so that it's easy to+     -- optimise code that constructs and deconstructs TypeReps+     -- perf/should_run/T9203 is a good example+     -- Also note that mkAppTy does discards the fingerprint,+     -- so it's a waste to compute it++type KindRep = TypeRep++-- Compare keys for equality+instance Eq TypeRep where+  TypeRep x _ _ _ == TypeRep y _ _ _ = x == y++instance Ord TypeRep where+  TypeRep x _ _ _ <= TypeRep y _ _ _ = x <= y++-- | Observe the 'Fingerprint' of a type representation+--+-- @since 4.8.0.0+typeRepFingerprint :: TypeRep -> Fingerprint+typeRepFingerprint (TypeRep fpr _ _ _) = fpr++-- | Applies a kind-polymorphic type constructor to a sequence of kinds and+-- types mkPolyTyConApp :: TyCon -> [KindRep] -> [TypeRep] -> TypeRep-mkPolyTyConApp tc@(TyCon tc_k _ _ _) [] [] = TypeRep tc_k tc [] []-mkPolyTyConApp tc@(TyCon tc_k _ _ _) kinds types =-  TypeRep (fingerprintFingerprints (tc_k : arg_ks)) tc kinds types+{-# INLINE mkPolyTyConApp #-}+mkPolyTyConApp tc kinds types+  = TypeRep (fingerprintFingerprints sub_fps) tc kinds types   where-  arg_ks = [ k | TypeRep k _ _ _ <- kinds ++ types ]+    !kt_fps = typeRepFingerprints kinds types+    sub_fps = tyConFingerprint tc : kt_fps --- | Applies a monomorphic type constructor to a sequence of types+typeRepFingerprints :: [KindRep] -> [TypeRep] -> [Fingerprint]+-- Builds no thunks+typeRepFingerprints kinds types+  = go1 [] kinds+  where+    go1 acc []     = go2 acc types+    go1 acc (k:ks) = let !fp = typeRepFingerprint k+                     in go1 (fp:acc) ks+    go2 acc []     = acc+    go2 acc (t:ts) = let !fp = typeRepFingerprint t+                     in go2 (fp:acc) ts++-- | Applies a kind-monomorphic type constructor to a sequence of types mkTyConApp  :: TyCon -> [TypeRep] -> TypeRep mkTyConApp tc = mkPolyTyConApp tc []  -- | A special case of 'mkTyConApp', which applies the function -- type constructor to a pair of types. mkFunTy  :: TypeRep -> TypeRep -> TypeRep-mkFunTy f a = mkTyConApp funTc [f,a]+mkFunTy f a = mkTyConApp tcFun [f,a]  -- | Splits a type constructor application.--- Note that if the type construcotr is polymorphic, this will+-- Note that if the type constructor is polymorphic, this will -- not return the kinds that were used. -- See 'splitPolyTyConApp' if you need all parts. splitTyConApp :: TypeRep -> (TyCon,[TypeRep])@@ -149,11 +241,18 @@ funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep funResultTy trFun trArg   = case splitTyConApp trFun of-      (tc, [t1,t2]) | tc == funTc && t1 == trArg -> Just t2+      (tc, [t1,t2]) | tc == tcFun && t1 == trArg -> Just t2       _ -> Nothing +tyConOf :: Typeable a => Proxy a -> TyCon+tyConOf = typeRepTyCon . typeRep++tcFun :: TyCon+tcFun = tyConOf (Proxy :: Proxy (Int -> Int))+ -- | Adds a TypeRep argument to a TypeRep. mkAppTy :: TypeRep -> TypeRep -> TypeRep+{-# INLINE mkAppTy #-} mkAppTy (TypeRep _ tc ks trs) arg_tr = mkPolyTyConApp tc ks (trs ++ [arg_tr])    -- Notice that we call mkTyConApp to construct the fingerprint from tc and    -- the arg fingerprints.  Simply combining the current fingerprint with@@ -161,20 +260,6 @@    -- ensure that a TypeRep of the same shape has the same fingerprint!    -- See Trac #5962 --- | Builds a 'TyCon' object representing a type constructor.  An--- implementation of "Data.Typeable" should ensure that the following holds:------ >  A==A' ^ B==B' ^ C==C' ==> mkTyCon A B C == mkTyCon A' B' C'--------mkTyCon3 :: String       -- ^ package name-         -> String       -- ^ module name-         -> String       -- ^ the name of the type constructor-         -> TyCon        -- ^ A unique 'TyCon' object-mkTyCon3 pkg modl name =-  TyCon (fingerprintString (pkg ++ (' ':modl) ++ (' ':name))) pkg modl name- ----------------- Observation ---------------------  -- | Observe the type constructor of a type representation@@ -189,16 +274,12 @@ typeRepKinds :: TypeRep -> [KindRep] typeRepKinds (TypeRep _ _ ks _) = ks --- | Observe string encoding of a type representation-{-# DEPRECATED tyConString "renamed to 'tyConName'; 'tyConModule' and 'tyConPackage' are also available." #-} -- deprecated in 7.4-tyConString :: TyCon   -> String-tyConString = tyConName --- | Observe the 'Fingerprint' of a type representation------ @since 4.8.0.0-typeRepFingerprint :: TypeRep -> Fingerprint-typeRepFingerprint (TypeRep fpr _ _ _) = fpr+{- *********************************************************************+*                                                                      *+                The Typeable class+*                                                                      *+********************************************************************* -}  ------------------------------------------------------------- --@@ -272,8 +353,20 @@   showsPrec p (TypeRep _ tycon kinds tys) =     case tys of       [] -> showsPrec p tycon-      [x]   | tycon == listTc -> showChar '[' . shows x . showChar ']'-      [a,r] | tycon == funTc  -> showParen (p > 8) $+      [x]+        | tycon == tcList -> showChar '[' . shows x . showChar ']'+        where+          tcList = tyConOf @[] Proxy+      [TypeRep _ ptrRepCon _ []]+        | tycon == tcTYPE && ptrRepCon == tc'PtrRepLifted+          -> showChar '*'+        | tycon == tcTYPE && ptrRepCon == tc'PtrRepUnlifted+          -> showChar '#'+        where+          tcTYPE            = tyConOf @TYPE            Proxy+          tc'PtrRepLifted   = tyConOf @'PtrRepLifted   Proxy+          tc'PtrRepUnlifted = tyConOf @'PtrRepUnlifted Proxy+      [a,r] | tycon == tcFun  -> showParen (p > 8) $                                  showsPrec 9 a .                                  showString " -> " .                                  showsPrec 8 r@@ -287,13 +380,6 @@ showsTypeRep :: TypeRep -> ShowS showsTypeRep = shows -instance Show TyCon where-  showsPrec _ t = showString (tyConName t)--isTupleTyCon :: TyCon -> Bool-isTupleTyCon (TyCon _ _ _ ('(':',':_)) = True-isTupleTyCon _                         = False- -- | Helper to fully evaluate 'TypeRep' for use as @NFData(rnf)@ implementation -- -- @since 4.8.0.0@@ -303,15 +389,6 @@     go [] = ()     go (x:xs) = rnfTypeRep x `seq` go xs --- | Helper to fully evaluate 'TyCon' for use as @NFData(rnf)@ implementation------ @since 4.8.0.0-rnfTyCon :: TyCon -> ()-rnfTyCon (TyCon _ tcp tcm tcn) = go tcp `seq` go tcm `seq` go tcn-  where-    go [] = ()-    go (x:xs) = x `seq` go xs- -- Some (Show.TypeRep) helpers:  showArgs :: Show a => ShowS -> [a] -> ShowS@@ -324,27 +401,25 @@                . showArgs (showChar ',') args                . showChar ')' -listTc :: TyCon-listTc = typeRepTyCon (typeOf [()])+{- *********************************************************+*                                                          *+*       TyCon/TypeRep definitions for type literals        *+*              (Symbol and Nat)                            *+*                                                          *+********************************************************* -} -funTc :: TyCon-funTc = typeRepTyCon (typeRep (Proxy :: Proxy (->))) +mkTypeLitTyCon :: String -> TyCon+mkTypeLitTyCon name = mkTyCon3 "base" "GHC.TypeLits" name +-- | Used to make `'Typeable' instance for things of kind Nat+typeNatTypeRep :: KnownNat a => Proxy# a -> TypeRep+typeNatTypeRep p = typeLitTypeRep (show (natVal' p)) +-- | Used to make `'Typeable' instance for things of kind Symbol+typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TypeRep+typeSymbolTypeRep p = typeLitTypeRep (show (symbolVal' p))+ -- | An internal function, to make representations for type literals. typeLitTypeRep :: String -> TypeRep-typeLitTypeRep nm = rep-    where-    rep = mkTyConApp tc []-    tc = TyCon-           { tyConFingerprint = fingerprintString (mk pack modu nm)-           , tyConPackage  = pack-           , tyConModule   = modu-           , tyConName     = nm-           }-    pack = "base"-    modu = "GHC.TypeLits"-    mk a b c = a ++ " " ++ b ++ " " ++ c--+typeLitTypeRep nm = mkTyConApp (mkTypeLitTyCon nm) []

@@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE MagicHash, AutoDeriveTypeable #-}+{-# LANGUAGE MagicHash #-}  ----------------------------------------------------------------------------- -- |@@ -26,12 +26,11 @@  import GHC.Base import GHC.Num-import Data.Typeable import Data.IORef  -- | An abstract unique object.  Objects of type 'Unique' may be -- compared for equality and ordering and hashed into 'Int'.-newtype Unique = Unique Integer deriving (Eq,Ord,Typeable)+newtype Unique = Unique Integer deriving (Eq,Ord)  uniqSource :: IORef Integer uniqSource = unsafePerformIO (newIORef 0)

@@ -1,5 +1,5 @@ {-# LANGUAGE Safe #-}-{-# LANGUAGE AutoDeriveTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-}  -----------------------------------------------------------------------------@@ -36,7 +36,8 @@         makeVersion   ) where -import Control.Monad    ( Monad(..), liftM )+import Data.Functor     ( Functor(..) )+import Control.Applicative ( Applicative(..) ) import Data.Bool        ( (&&) ) import Data.Char        ( isDigit, isAlphaNum ) import Data.Eq@@ -44,7 +45,7 @@ import Data.List import Data.Ord import Data.String      ( String )-import Data.Typeable    ( Typeable )+import GHC.Generics import GHC.Read import GHC.Show import Text.ParserCombinators.ReadP@@ -93,9 +94,9 @@                 -- The interpretation of the list of tags is entirely dependent                 -- on the entity that this version applies to.         }-  deriving (Read,Show,Typeable)+  deriving (Read,Show,Generic) {-# DEPRECATED versionTags "See GHC ticket #2496" #-}--- TODO. Remove all references to versionTags in GHC 7.12 release.+-- TODO. Remove all references to versionTags in GHC 8.0 release.  instance Eq Version where   v1 == v2  =  versionBranch v1 == versionBranch v2@@ -120,9 +121,9 @@ -- | A parser for versions in the format produced by 'showVersion'. -- parseVersion :: ReadP Version-parseVersion = do branch <- sepBy1 (liftM read (munch1 isDigit)) (char '.')-                  tags   <- many (char '-' >> munch1 isAlphaNum)-                  return Version{versionBranch=branch, versionTags=tags}+parseVersion = do branch <- sepBy1 (fmap read (munch1 isDigit)) (char '.')+                  tags   <- many (char '-' *> munch1 isAlphaNum)+                  pure Version{versionBranch=branch, versionTags=tags}  -- | Construct tag-less 'Version' --

@@ -1,4 +1,3 @@-{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE EmptyCase #-}