base 4.9.1.0 → 4.10.0.0

raw patch · 158 files changed

+33810/−22469 lines, 158 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Applicative.hs +25/−8
• Control/Arrow.hs +18/−3
• Control/Category.hs +8/−0
• Control/Concurrent.hs +2/−2
• Control/Concurrent/Chan.hs +7/−1
• Control/Exception.hs +3/−1
• Control/Exception/Base.hs +17/−39
• Control/Monad.hs +12/−15
• Control/Monad/Fail.hs +3/−0
• Control/Monad/Fix.hs +16/−0
• Control/Monad/IO/Class.hs +1/−0
• Control/Monad/ST/Imp.hs +3/−1
• Control/Monad/ST/Lazy/Imp.hs +138/−26
• Control/Monad/ST/Unsafe.hs +1/−0
• Control/Monad/Zip.hs +20/−0
• Data/Bifoldable.hs +429/−0
• Data/Bifunctor.hs +9/−0
• Data/Bitraversable.hs +248/−0
• Data/Bits.hs +10/−2
• Data/Complex.hs +21/−0
• Data/Data.hs +168/−681
• Data/Dynamic.hs +45/−38
• Data/Either.hs +41/−0
• Data/Fixed.hs +23/−0
• Data/Foldable.hs +45/−66
• Data/Functor.hs +1/−1
• Data/Functor/Classes.hs +351/−47
• Data/Functor/Compose.hs +33/−8
• Data/Functor/Const.hs +8/−0
• Data/Functor/Identity.hs +25/−18
• Data/Functor/Product.hs +32/−4
• Data/Functor/Sum.hs +23/−5
• Data/Functor/Utils.hs +115/−0
• Data/List/NonEmpty.hs +43/−7
• Data/Maybe.hs +1/−1
• Data/Monoid.hs +18/−0
• Data/OldList.hs +7/−1
• Data/Ord.hs +1/−0
• Data/Proxy.hs +14/−6
• Data/Semigroup.hs +140/−42
• Data/String.hs +11/−3
• Data/Traversable.hs +83/−43
• Data/Tuple.hs +1/−1
• Data/Type/Bool.hs +6/−5
• Data/Type/Coercion.hs +18/−3
• Data/Type/Equality.hs +46/−6
• Data/Typeable.hs +172/−60
• Data/Typeable/Internal.hs +484/−248
• Data/Version.hs +2/−0
• Data/Void.hs +6/−0
• Foreign/C/Error.hs +1/−0
• Foreign/C/Types.hs +19/−4
• Foreign/Concurrent.hs +29/−8
• Foreign/ForeignPtr.hs +1/−0
• Foreign/ForeignPtr/Imp.hs +1/−0
• Foreign/Marshal/Alloc.hs +1/−1
• Foreign/Marshal/Utils.hs +1/−1
• Foreign/Ptr.hs +30/−5
• Foreign/Storable.hs +20/−0
• GHC/Arr.hs +16/−1
• GHC/Base.hs +125/−43
• GHC/Conc.hs +3/−1
• GHC/Conc/IO.hs +6/−6
• GHC/Conc/Sync.hs +48/−16
• GHC/ConsoleHandler.hs +4/−4
• GHC/Enum.hs +106/−108
• GHC/Event/Control.hs +25/−7
• GHC/Event/EPoll.hsc +1/−0
• GHC/Event/Internal.hs +6/−1
• GHC/Event/KQueue.hsc +6/−3
• GHC/Event/PSQ.hs +2/−0
• GHC/Event/Poll.hsc +1/−0
• GHC/Event/Unique.hs +17/−21
• GHC/Exception.hs +13/−5
• GHC/Exception.hs-boot +3/−1
• GHC/ExecutionStack/Internal.hsc +1/−1
• GHC/Exts.hs +9/−1
• GHC/Fingerprint.hs +0/−1
• GHC/Fingerprint/Type.hs +1/−0
• GHC/Float.hs +22/−8
• GHC/Foreign.hs +19/−1
• GHC/ForeignPtr.hs +27/−7
• GHC/GHCi.hs +5/−0
• GHC/Generics.hs +231/−98
• GHC/IO.hs +80/−37
• GHC/IO/Buffer.hs +1/−1
• GHC/IO/Encoding.hs +19/−15
• GHC/IO/Encoding/CodePage/API.hs +1/−0
• GHC/IO/Encoding/Latin1.hs +2/−2
• GHC/IO/Encoding/Types.hs +1/−0
• GHC/IO/Exception.hs +61/−1
• GHC/IO/FD.hs +16/−12
• GHC/IO/Handle.hs +16/−1
• GHC/IO/Handle/FD.hs +18/−13
• GHC/IO/Handle/Lock.hsc +164/−0
• GHC/IO/Handle/Text.hs +29/−9
• GHC/IO/Handle/Types.hs +3/−0
• GHC/IO/Unsafe.hs +15/−28
• GHC/IOArray.hs +1/−0
• GHC/IORef.hs +1/−0
• GHC/Int.hs +56/−0
• GHC/List.hs +34/−16
• GHC/MVar.hs +1/−0
• GHC/Natural.hs +60/−33
• GHC/Num.hs +3/−0
• GHC/OverloadedLabels.hs +22/−16
• GHC/Profiling.hs +10/−1
• GHC/Ptr.hs +2/−0
• GHC/RTS/Flags.hsc +74/−60
• GHC/Read.hs +56/−22
• GHC/Real.hs +16/−3
• GHC/Records.hs +34/−0
• GHC/ST.hs +28/−3
• GHC/STRef.hs +1/−0
• GHC/Show.hs +27/−2
• GHC/Stable.hs +1/−0
• GHC/Stack/CCS.hsc +1/−1
• GHC/StaticPtr.hs +18/−9
• GHC/StaticPtr/Internal.hs +27/−0
• GHC/Stats.hsc +202/−58
• GHC/TopHandler.hs +31/−1
• GHC/TypeLits.hs +23/−97
• GHC/TypeNats.hs +160/−0
• GHC/Word.hs +54/−0
• System/CPUTime.hsc +27/−121
• System/CPUTime/Posix/ClockGetTime.hsc +55/−0
• System/CPUTime/Posix/RUsage.hsc +42/−0
• System/CPUTime/Posix/Times.hsc +39/−0
• System/CPUTime/Unsupported.hs +20/−0
• System/CPUTime/Utils.hs +19/−0
• System/CPUTime/Windows.hsc +63/−0
• System/Console/GetOpt.hs +4/−1
• System/Environment.hs +16/−2
• System/Exit.hs +1/−1
• System/IO.hs +15/−8
• System/Mem/StableName.hs +2/−1
• System/Mem/Weak.hs +26/−0
• System/Posix/Types.hs +67/−10
• System/Timeout.hs +2/−0
• Text/ParserCombinators/ReadP.hs +16/−8
• Text/ParserCombinators/ReadPrec.hs +11/−6
• Text/Printf.hs +23/−1
• Text/Show/Functions.hs +1/−0
• Type/Reflection.hs +72/−0
• Type/Reflection/Unsafe.hs +25/−0
• Unsafe/Coerce.hs +3/−5
• aclocal.m4 +36/−18
• base.cabal +22/−4
• cbits/inputReady.c +30/−10
• cbits/rts.c +0/−42
• changelog.md +88/−4
• config.guess +125/−72
• config.sub +66/−24
• configure +27687/−19916
• configure.ac +32/−7
• include/CTypes.h +18/−21
• include/HsBase.h +1/−1
• include/HsBaseConfig.h.in +33/−0

@@ -43,7 +43,7 @@     Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..),     -- * Utility functions     (<$>), (<$), (<**>),-    liftA, liftA2, liftA3,+    liftA, liftA3,     optional,     ) where @@ -66,13 +66,17 @@ newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }                          deriving (Generic, Generic1, Monad) +-- | @since 2.01 instance Monad m => Functor (WrappedMonad m) where     fmap f (WrapMonad v) = WrapMonad (liftM f v) +-- | @since 2.01 instance Monad m => Applicative (WrappedMonad m) where     pure = WrapMonad . pure     WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v)+    liftA2 f (WrapMonad x) (WrapMonad y) = WrapMonad (liftM2 f x y) +-- | @since 2.01 instance MonadPlus m => Alternative (WrappedMonad m) where     empty = WrapMonad mzero     WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)@@ -80,29 +84,42 @@ newtype WrappedArrow a b c = WrapArrow { unwrapArrow :: a b c }                            deriving (Generic, Generic1) +-- | @since 2.01 instance Arrow a => Functor (WrappedArrow a b) where     fmap f (WrapArrow a) = WrapArrow (a >>> arr f) +-- | @since 2.01 instance Arrow a => Applicative (WrappedArrow a b) where     pure x = WrapArrow (arr (const x))-    WrapArrow f <*> WrapArrow v = WrapArrow (f &&& v >>> arr (uncurry id))+    liftA2 f (WrapArrow u) (WrapArrow v) =+      WrapArrow (u &&& v >>> arr (uncurry f)) +-- | @since 2.01 instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where     empty = WrapArrow zeroArrow     WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v) --- | Lists, but with an 'Applicative' functor based on zipping, so that------ @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@---+-- | Lists, but with an 'Applicative' functor based on zipping. newtype ZipList a = ZipList { getZipList :: [a] }                   deriving ( Show, Eq, Ord, Read, Functor                            , Foldable, Generic, Generic1)--- See Data.Traversable for Traversabel instance due to import loops+-- See Data.Traversable for Traversable instance due to import loops +-- |+-- > f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsN+--       = 'ZipList' (zipWithN f xs1 ... xsN)+--+-- where @zipWithN@ refers to the @zipWith@ function of the appropriate arity+-- (@zipWith@, @zipWith3@, @zipWith4@, ...). For example:+--+-- > (\a b c -> stimes c [a, b]) <$> ZipList "abcd" <*> ZipList "567" <*> ZipList [1..]+-- >     = ZipList (zipWith3 (\a b c -> stimes c [a, b]) "abcd" "567" [1..])+-- >     = ZipList {getZipList = ["a5","b6b6","c7c7c7"]}+--+-- @since 2.01 instance Applicative ZipList where     pure x = ZipList (repeat x)-    ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs)+    liftA2 f (ZipList xs) (ZipList ys) = ZipList (zipWith f xs ys)  -- extra functions 

@@ -139,6 +139,7 @@  -- Ordinary functions are arrows. +-- | @since 2.01 instance Arrow (->) where     arr f = f --  (f *** g) ~(x,y) = (f x, g y)@@ -148,10 +149,12 @@ -- | Kleisli arrows of a monad. newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b } +-- | @since 3.0 instance Monad m => Category (Kleisli m) where     id = Kleisli return     (Kleisli f) . (Kleisli g) = Kleisli (\b -> g b >>= f) +-- | @since 2.01 instance Monad m => Arrow (Kleisli m) where     arr f = Kleisli (return . f)     first (Kleisli f) = Kleisli (\ ~(b,d) -> f b >>= \c -> return (c,d))@@ -180,6 +183,7 @@ class Arrow a => ArrowZero a where     zeroArrow :: a b c +-- | @since 2.01 instance MonadPlus m => ArrowZero (Kleisli m) where     zeroArrow = Kleisli (\_ -> mzero) @@ -188,6 +192,7 @@     -- | An associative operation with identity 'zeroArrow'.     (<+>) :: a b c -> a b c -> a b c +-- | @since 2.01 instance MonadPlus m => ArrowPlus (Kleisli m) where     Kleisli f <+> Kleisli g = Kleisli (\x -> f x `mplus` g x) @@ -269,12 +274,14 @@                 right f . right g = right (f . g)  #-} +-- | @since 2.01 instance ArrowChoice (->) where     left f = f +++ id     right f = id +++ f     f +++ g = (Left . f) ||| (Right . g)     (|||) = either +-- | @since 2.01 instance Monad m => ArrowChoice (Kleisli m) where     left f = f +++ arr id     right f = arr id +++ f@@ -295,9 +302,11 @@ class Arrow a => ArrowApply a where     app :: a (a b c, b) c +-- | @since 2.01 instance ArrowApply (->) where     app (f,x) = f x +-- | @since 2.01 instance Monad m => ArrowApply (Kleisli m) where     app = Kleisli (\(Kleisli f, x) -> f x) @@ -306,24 +315,27 @@  newtype ArrowMonad a b = ArrowMonad (a () b) +-- | @since 4.6.0.0 instance Arrow a => Functor (ArrowMonad a) where     fmap f (ArrowMonad m) = ArrowMonad $ m >>> arr f +-- | @since 4.6.0.0 instance Arrow a => Applicative (ArrowMonad a) where    pure x = ArrowMonad (arr (const x))    ArrowMonad f <*> ArrowMonad x = ArrowMonad (f &&& x >>> arr (uncurry id)) +-- | @since 2.01 instance ArrowApply a => Monad (ArrowMonad a) where     ArrowMonad m >>= f = ArrowMonad $         m >>> arr (\x -> let ArrowMonad h = f x in (h, ())) >>> app +-- | @since 4.6.0.0 instance ArrowPlus a => Alternative (ArrowMonad a) where    empty = ArrowMonad zeroArrow    ArrowMonad x <|> ArrowMonad y = ArrowMonad (x <+> y) -instance (ArrowApply a, ArrowPlus a) => MonadPlus (ArrowMonad a) where-   mzero = ArrowMonad zeroArrow-   ArrowMonad x `mplus` ArrowMonad y = ArrowMonad (x <+> y)+-- | @since 4.6.0.0+instance (ArrowApply a, ArrowPlus a) => MonadPlus (ArrowMonad a)  -- | Any instance of 'ArrowApply' can be made into an instance of --   'ArrowChoice' by defining 'left' = 'leftApp'.@@ -363,12 +375,15 @@ class Arrow a => ArrowLoop a where     loop :: a (b,d) (c,d) -> a b c +-- | @since 2.01 instance ArrowLoop (->) where     loop f b = let (c,d) = f (b,d) in c  -- | Beware that for many monads (those for which the '>>=' operation -- is strict) this instance will /not/ satisfy the right-tightening law -- required by the 'ArrowLoop' class.+--+-- @since 2.01 instance MonadFix m => ArrowLoop (Kleisli m) where     loop (Kleisli f) = Kleisli (liftM fst . mfix . f')       where f' x y = f (x, snd y)

@@ -46,14 +46,22 @@                 (p . q) . r = p . (q . r)  #-} +-- | @since 3.0 instance Category (->) where     id = GHC.Base.id     (.) = (GHC.Base..) +-- | @since 4.7.0.0 instance Category (:~:) where   id          = Refl   Refl . Refl = Refl +-- | @since 4.10.0.0+instance Category (:~~:) where+  id            = HRefl+  HRefl . HRefl = HRefl++-- | @since 4.7.0.0 instance Category Coercion where   id = Coercion   (.) Coercion = coerce

@@ -253,7 +253,7 @@ -- If @rtsSupportsBoundThreads@ is 'False', 'isCurrentThreadBound' -- will always return 'False' and both 'forkOS' and 'runInBoundThread' will -- fail.-foreign import ccall rtsSupportsBoundThreads :: Bool+foreign import ccall unsafe rtsSupportsBoundThreads :: Bool   {- |@@ -308,7 +308,7 @@                         MaskedInterruptible -> action0                         MaskedUninterruptible -> uninterruptibleMask_ action0 -            action_plus = catchException action1 childHandler+            action_plus = catch action1 childHandler          entry <- newStablePtr (myThreadId >>= putMVar mv >> action_plus)         err <- forkOS_createThread entry

@@ -100,7 +100,13 @@ -- completes and before modifyMVar_ installs the new value, it will set the -- Chan's write end to a filled hole. --- |Read the next value from the 'Chan'.+-- |Read the next value from the 'Chan'. Blocks when the channel is empty. Since+-- the read end of a channel is an 'MVar', this operation inherits fairness+-- guarantees of 'MVar's (e.g. threads blocked in this operation are woken up in+-- FIFO order).+--+-- Throws 'BlockedIndefinitelyOnMVar' when the channel is empty and no other+-- thread holds a reference to the channel. readChan :: Chan a -> IO a readChan (Chan readVar _) = do   modifyMVarMasked readVar $ \read_end -> do -- Note [modifyMVarMasked]

@@ -49,6 +49,7 @@         BlockedIndefinitelyOnMVar(..),         BlockedIndefinitelyOnSTM(..),         AllocationLimitExceeded(..),+        CompactionFailed(..),         Deadlock(..),         NoMethodError(..),         PatternMatchFail(..),@@ -140,6 +141,7 @@ -- | You need this when using 'catches'. data Handler a = forall e . Exception e => Handler (e -> IO a) +-- | @since 4.6.0.0 instance Functor Handler where      fmap f (Handler h) = Handler (fmap f . h) @@ -304,7 +306,7 @@ interruptible (or call other interruptible operations).  In many cases these operations may themselves raise exceptions, such as I\/O errors, so the caller will usually be prepared to handle exceptions arising from the-operation anyway.  To perfom an explicit poll for asynchronous exceptions+operation anyway.  To perform an explicit poll for asynchronous exceptions inside 'mask', use 'allowInterrupt'.  Sometimes it is too onerous to handle exceptions in the middle of a

@@ -32,6 +32,7 @@         BlockedIndefinitelyOnMVar(..),         BlockedIndefinitelyOnSTM(..),         AllocationLimitExceeded(..),+        CompactionFailed(..),         Deadlock(..),         NoMethodError(..),         PatternMatchFail(..),@@ -110,45 +111,6 @@ ----------------------------------------------------------------------------- -- Catching exceptions --- |This is the simplest of the exception-catching functions.  It--- takes a single argument, runs it, and if an exception is raised--- the \"handler\" is executed, with the value of the exception passed as an--- argument.  Otherwise, the result is returned as normal.  For example:------ >   catch (readFile f)--- >         (\e -> do let err = show (e :: IOException)--- >                   hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err)--- >                   return "")------ Note that we have to give a type signature to @e@, or the program--- will not typecheck as the type is ambiguous. While it is possible--- to catch exceptions of any type, see the section \"Catching all--- exceptions\" (in "Control.Exception") for an explanation of the problems with doing so.------ For catching exceptions in pure (non-'IO') expressions, see the--- function 'evaluate'.------ Note that due to Haskell\'s unspecified evaluation order, an--- expression may throw one of several possible exceptions: consider--- the expression @(error \"urk\") + (1 \`div\` 0)@.  Does--- the expression throw--- @ErrorCall \"urk\"@, or @DivideByZero@?------ The answer is \"it might throw either\"; the choice is--- non-deterministic. If you are catching any type of exception then you--- might catch either. If you are calling @catch@ with type--- @IO Int -> (ArithException -> IO Int) -> IO Int@ then the handler may--- get run with @DivideByZero@ as an argument, or an @ErrorCall \"urk\"@--- exception may be propogated further up. If you call it again, you--- might get a the opposite behaviour. This is ok, because 'catch' is an--- 'IO' computation.----catch   :: Exception e-        => IO a         -- ^ The computation to run-        -> (e -> IO a)  -- ^ Handler to invoke if an exception is raised-        -> IO a-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 -- selects which type of exceptions we\'re interested in.@@ -299,9 +261,11 @@ -- source location of the pattern. newtype PatternMatchFail = PatternMatchFail String +-- | @since 4.0 instance Show PatternMatchFail where     showsPrec _ (PatternMatchFail err) = showString err +-- | @since 4.0 instance Exception PatternMatchFail  -----@@ -313,9 +277,11 @@ -- location of the record selector. newtype RecSelError = RecSelError String +-- | @since 4.0 instance Show RecSelError where     showsPrec _ (RecSelError err) = showString err +-- | @since 4.0 instance Exception RecSelError  -----@@ -325,9 +291,11 @@ -- constructed. newtype RecConError = RecConError String +-- | @since 4.0 instance Show RecConError where     showsPrec _ (RecConError err) = showString err +-- | @since 4.0 instance Exception RecConError  -----@@ -339,9 +307,11 @@ -- location of the record update. newtype RecUpdError = RecUpdError String +-- | @since 4.0 instance Show RecUpdError where     showsPrec _ (RecUpdError err) = showString err +-- | @since 4.0 instance Exception RecUpdError  -----@@ -351,9 +321,11 @@ -- @String@ gives information about which method it was. newtype NoMethodError = NoMethodError String +-- | @since 4.0 instance Show NoMethodError where     showsPrec _ (NoMethodError err) = showString err +-- | @since 4.0 instance Exception NoMethodError  -----@@ -365,9 +337,11 @@ -- @since 4.9.0.0 newtype TypeError = TypeError String +-- | @since 4.9.0.0 instance Show TypeError where     showsPrec _ (TypeError err) = showString err +-- | @since 4.9.0.0 instance Exception TypeError  -----@@ -378,9 +352,11 @@ -- guaranteed to terminate or not. data NonTermination = NonTermination +-- | @since 4.0 instance Show NonTermination where     showsPrec _ NonTermination = showString "<<loop>>" +-- | @since 4.0 instance Exception NonTermination  -----@@ -389,9 +365,11 @@ -- package, inside another call to @atomically@. data NestedAtomically = NestedAtomically +-- | @since 4.0 instance Show NestedAtomically where     showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested" +-- | @since 4.0 instance Exception NestedAtomically  -----

@@ -117,7 +117,7 @@ forever     :: (Applicative f) => f a -> f b {-# INLINE forever #-} forever a   = let a' = a *> a' in a'--- Use explicit sharing here, as it is prevents a space leak regardless of+-- Use explicit sharing here, as it prevents a space leak regardless of -- optimizations.  -- -----------------------------------------------------------------------------@@ -162,21 +162,21 @@ -}  foldM          :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b-{-# INLINEABLE foldM #-}+{-# INLINABLE foldM #-} {-# SPECIALISE foldM :: (a -> b -> IO a) -> a -> [b] -> IO a #-} {-# SPECIALISE foldM :: (a -> b -> Maybe a) -> a -> [b] -> Maybe a #-} foldM          = foldlM  -- | Like 'foldM', but discards the result. foldM_         :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m ()-{-# INLINEABLE foldM_ #-}+{-# INLINABLE foldM_ #-} {-# SPECIALISE foldM_ :: (a -> b -> IO a) -> a -> [b] -> IO () #-} {-# SPECIALISE foldM_ :: (a -> b -> Maybe a) -> a -> [b] -> Maybe () #-} foldM_ f a xs  = foldlM f a xs >> return ()  {--Note [Worker/wrapper transform on replicateM/replicateM_---------------------------------------------------------+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@@ -185,23 +185,20 @@     replicateM_ 0 _ = pure ()     replicateM_ n f = f *> replicateM_ (n - 1) f -However, the self-recrusive nature of this implementation inhibits inlining,+However, the self-recursive 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+inline the entire definition (as happens 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-+Core: https://ghc.haskell.org/trac/ghc/ticket/11795#comment:6 -}  -- | @'replicateM' n act@ performs the action @n@ times, -- gathering the results. replicateM        :: (Applicative m) => Int -> m a -> m [a]-{-# INLINEABLE replicateM #-}+{-# INLINABLE replicateM #-} {-# SPECIALISE replicateM :: Int -> IO a -> IO [a] #-} {-# SPECIALISE replicateM :: Int -> Maybe a -> Maybe [a] #-} replicateM cnt0 f =@@ -213,7 +210,7 @@  -- | Like 'replicateM', but discards the result. replicateM_       :: (Applicative m) => Int -> m a -> m ()-{-# INLINEABLE replicateM_ #-}+{-# INLINABLE replicateM_ #-} {-# SPECIALISE replicateM_ :: Int -> IO a -> IO () #-} {-# SPECIALISE replicateM_ :: Int -> Maybe a -> Maybe () #-} replicateM_ cnt0 f =@@ -226,7 +223,7 @@  -- | The reverse of 'when'. unless            :: (Applicative f) => Bool -> f () -> f ()-{-# INLINEABLE unless #-}+{-# INLINABLE unless #-} {-# SPECIALISE unless :: Bool -> IO () -> IO () #-} {-# SPECIALISE unless :: Bool -> Maybe () -> Maybe () #-} unless p s        =  if p then pure () else s@@ -254,7 +251,7 @@ -- @mfilter odd (Just 2) == Nothing@  mfilter :: (MonadPlus m) => (a -> Bool) -> m a -> m a-{-# INLINEABLE mfilter #-}+{-# INLINABLE mfilter #-} mfilter p ma = do   a <- ma   if p a then return a else mzero

@@ -67,12 +67,15 @@     fail :: String -> m a  +-- | @since 4.9.0.0 instance MonadFail Maybe where     fail _ = Nothing +-- | @since 4.9.0.0 instance MonadFail [] where     {-# INLINE fail #-}     fail _ = [] +-- | @since 4.9.0.0 instance MonadFail IO where     fail = failIO

@@ -62,60 +62,76 @@  -- Instances of MonadFix for Prelude monads +-- | @since 2.01 instance MonadFix Maybe where     mfix f = let a = f (unJust a) in a              where unJust (Just x) = x                    unJust Nothing  = errorWithoutStackTrace "mfix Maybe: Nothing" +-- | @since 2.01 instance MonadFix [] where     mfix f = case fix (f . head) of                []    -> []                (x:_) -> x : mfix (tail . f) +-- | @since 2.01 instance MonadFix IO where     mfix = fixIO +-- | @since 2.01 instance MonadFix ((->) r) where     mfix f = \ r -> let a = f a r in a +-- | @since 4.3.0.0 instance MonadFix (Either e) where     mfix f = let a = f (unRight a) in a              where unRight (Right x) = x                    unRight (Left  _) = errorWithoutStackTrace "mfix Either: Left" +-- | @since 2.01 instance MonadFix (ST s) where         mfix = fixST  -- Instances of Data.Monoid wrappers +-- | @since 4.8.0.0 instance MonadFix Dual where     mfix f   = Dual (fix (getDual . f)) +-- | @since 4.8.0.0 instance MonadFix Sum where     mfix f   = Sum (fix (getSum . f)) +-- | @since 4.8.0.0 instance MonadFix Product where     mfix f   = Product (fix (getProduct . f)) +-- | @since 4.8.0.0 instance MonadFix First where     mfix f   = First (mfix (getFirst . f)) +-- | @since 4.8.0.0 instance MonadFix Last where     mfix f   = Last (mfix (getLast . f)) +-- | @since 4.8.0.0 instance MonadFix f => MonadFix (Alt f) where     mfix f   = Alt (mfix (getAlt . f))  -- Instances for GHC.Generics+-- | @since 4.9.0.0 instance MonadFix Par1 where     mfix f = Par1 (fix (unPar1 . f)) +-- | @since 4.9.0.0 instance MonadFix f => MonadFix (Rec1 f) where     mfix f = Rec1 (mfix (unRec1 . f)) +-- | @since 4.9.0.0 instance MonadFix f => MonadFix (M1 i c f) where     mfix f = M1 (mfix (unM1. f)) +-- | @since 4.9.0.0 instance (MonadFix f, MonadFix g) => MonadFix (f :*: g) where     mfix f = (mfix (fstP . f)) :*: (mfix (sndP . f))       where

@@ -32,5 +32,6 @@     -- | Lift a computation from the 'IO' monad.     liftIO :: IO a -> m a +-- | @since 4.9.0.0 instance MonadIO IO where     liftIO = id

@@ -29,10 +29,12 @@          -- * Unsafe operations         unsafeInterleaveST,+        unsafeDupableInterleaveST,         unsafeIOToST,         unsafeSTToIO     ) where -import GHC.ST           ( ST, runST, fixST, unsafeInterleaveST )+import GHC.ST           ( ST, runST, fixST, unsafeInterleaveST+                        , unsafeDupableInterleaveST ) import GHC.Base         ( RealWorld ) import GHC.IO           ( stToIO, unsafeIOToST, unsafeSTToIO )

@@ -1,4 +1,5 @@ {-# LANGUAGE Unsafe #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash, UnboxedTuples, RankNTypes #-} {-# OPTIONS_HADDOCK hide #-} @@ -43,6 +44,7 @@  import qualified GHC.ST as GHC.ST import GHC.Base+import qualified Control.Monad.Fail as Fail  -- | The lazy state-transformer monad. -- A computation of type @'ST' s a@ transforms an internal state indexed@@ -59,39 +61,148 @@ -- The '>>=' and '>>' operations are not strict in the state.  For example, -- -- @'runST' (writeSTRef _|_ v >>= readSTRef _|_ >> return 2) = 2@-newtype ST s a = ST (State s -> (a, State s))+newtype ST s a = ST { unST :: State s -> (a, State s) }++-- A lifted state token. This can be imagined as a moment in the timeline+-- of a lazy state thread. Forcing the token forces all delayed actions in+-- the thread up until that moment to be performed. data State s = S# (State# s) +{- Note [Lazy ST and multithreading]++We used to imagine that passing a polymorphic state token was all that we+needed to keep state threads separate (see Launchbury and Peyton Jones, 1994:+https://www.microsoft.com/en-us/research/publication/lazy-functional-state-threads/).+But this breaks down in the face of concurrency (see #11760). Whereas a strict+ST computation runs to completion before producing anything, a value produced+by running a lazy ST computation may contain a thunk that, when forced, will+lead to further stateful computations. If such a thunk is entered by more than+one thread, then they may both read from and write to the same references and+arrays, interfering with each other. To work around this, any time we lazily+suspend execution of a lazy ST computation, we bind the result pair to a+NOINLINE binding (ensuring that it is not duplicated) and calculate that+pair using (unsafePerformIO . evaluate), ensuring that only one thread will+enter the thunk. We still use lifted state tokens to actually drive execution,+so in these cases we effectively deal with *two* state tokens: the lifted+one we get from the previous computation, and the unlifted one we pull out of+thin air. -}++{- Note [Lazy ST: not producing lazy pairs]++The fixST and strictToLazyST functions used to construct functions that+produced lazy pairs. Why don't we need that laziness? The ST type is kept+abstract, so no one outside this module can ever get their hands on a (result,+State s) pair. We ourselves never match on such pairs when performing ST+computations unless we also force one of their components. So no one should be+able to detect the change. By refraining from producing such thunks (which+reference delayed ST computations), we avoid having to ask whether we have to+wrap them up with unsafePerformIO. See Note [Lazy ST and multithreading]. -}++-- | This is a terrible hack to prevent a thunk from being entered twice.+-- Simon Peyton Jones would very much like to be rid of it.+noDup :: a -> a+noDup a = runRW# (\s ->+  case noDuplicate# s of+    _ -> a)++-- | @since 2.01 instance Functor (ST s) where     fmap f m = ST $ \ s ->       let-       ST m_a = m-       (r,new_s) = m_a s+        -- See Note [Lazy ST and multithreading]+        {-# NOINLINE res #-}+        res = noDup (unST m s)+        (r,new_s) = res       in-      (f r,new_s)+        (f r,new_s) +    x <$ m = ST $ \ s ->+      let+        {-# NOINLINE s' #-}+        -- See Note [Lazy ST and multithreading]+        s' = noDup (snd (unST m s))+      in (x, s')++-- | @since 2.01 instance Applicative (ST s) where     pure a = ST $ \ s -> (a,s)-    (<*>) = ap +    fm <*> xm = ST $ \ s ->+       let+         {-# NOINLINE res1 #-}+         !res1 = unST fm s+         !(f, s') = res1++         {-# NOINLINE res2 #-}+         -- See Note [Lazy ST and multithreading]+         res2 = noDup (unST xm s')+         (x, s'') = res2+       in (f x, s'')+    -- Why can we use a strict binding for res1? If someone+    -- forces the (f x, s'') pair, then they must need+    -- f or s''. To get s'', they need s'.++    liftA2 f m n = ST $ \ s ->+      let+        {-# NOINLINE res1 #-}+        -- See Note [Lazy ST and multithreading]+        res1 = noDup (unST m s)+        (x, s') = res1++        {-# NOINLINE res2 #-}+        res2 = noDup (unST n s')+        (y, s'') = res2+      in (f x y, s'')+    -- We don't get to be strict in liftA2, but we clear out a+    -- NOINLINE in comparison to the default definition, which may+    -- help the simplifier.++    m *> n = ST $ \s ->+       let+         {-# NOINLINE s' #-}+         -- See Note [Lazy ST and multithreading]+         s' = noDup (snd (unST m s))+       in unST n s'++    m <* n = ST $ \s ->+       let+         {-# NOINLINE res1 #-}+         !res1 = unST m s+         !(mr, s') = res1++         {-# NOINLINE s'' #-}+         -- See Note [Lazy ST and multithreading]+         s'' = noDup (snd (unST n s'))+       in (mr, s'')+    -- Why can we use a strict binding for res1? The same reason as+    -- in <*>. If someone demands the (mr, s'') pair, then they will+    -- force mr or s''. To get s'', they need s'.++-- | @since 2.01 instance Monad (ST s) where -        fail s   = errorWithoutStackTrace s+    fail s   = errorWithoutStackTrace s -        (ST m) >>= k-         = ST $ \ s ->-           let-             (r,new_s) = m s-             ST k_a = k r-           in-           k_a new_s+    (>>) = (*>) -{-# NOINLINE runST #-}+    m >>= k = ST $ \ s ->+       let+         -- See Note [Lazy ST and multithreading]+         {-# NOINLINE res #-}+         res = noDup (unST m s)+         (r,new_s) = res+       in+         unST (k r) new_s++-- | @since 4.10+instance Fail.MonadFail (ST s) where+    fail s = errorWithoutStackTrace s+ -- | Return the value computed by a state transformer computation. -- The @forall@ ensures that the internal state used by the 'ST' -- computation is inaccessible to the rest of the program. runST :: (forall s. ST s a) -> a-runST st = case st of ST the_st -> let (r,_) = the_st (S# realWorld#) in r+runST (ST st) = runRW# (\s -> case st (S# s) of (r, _) -> r)  -- | Allow the result of a state transformer computation to be used (lazily) -- inside the computation.@@ -99,11 +210,15 @@ fixST :: (a -> ST s a) -> ST s a fixST m = ST (\ s ->                  let -                   ST m_r = m r-                   (r,s') = m_r s-                in-                   (r,s'))+                   q@(r,_s') = unST (m r) s+                in q)+-- Why don't we need unsafePerformIO in fixST? We create a thunk, q,+-- to perform a lazy state computation, and we pass a reference to that+-- thunk, r, to m. Uh oh? No, I think it should be fine, because that thunk+-- itself is demanded directly in the `let` body. See also+-- Note [Lazy ST: not producing lazy pairs]. +-- | @since 2.01 instance MonadFix (ST s) where         mfix = fixST @@ -116,13 +231,10 @@ the lazy state thread it returns is demanded. -} strictToLazyST :: ST.ST s a -> ST s a-strictToLazyST m = ST $ \s ->-        let -           pr = case s of { S# s# -> GHC.ST.liftST m s# }-           r  = case pr of { GHC.ST.STret _ v -> v }-           s' = case pr of { GHC.ST.STret s2# _ -> S# s2# }-        in-        (r, s')+strictToLazyST (GHC.ST.ST m) = ST $ \(S# s) ->+  case m s of+    (# s', a #) -> (a, S# s')+-- See Note [Lazy ST: not producing lazy pairs]  {-|  Convert a lazy 'ST' computation into a strict one.

@@ -21,6 +21,7 @@ module Control.Monad.ST.Unsafe (         -- * Unsafe operations         unsafeInterleaveST,+        unsafeDupableInterleaveST,         unsafeIOToST,         unsafeSTToIO     ) where

@@ -19,6 +19,7 @@ module Control.Monad.Zip where  import Control.Monad (liftM, liftM2)+import Data.Functor.Identity import Data.Monoid import Data.Proxy import GHC.Generics@@ -52,48 +53,67 @@     -- you can implement it more efficiently than the     -- above default code.  See Trac #4370 comment by giorgidze +-- | @since 4.3.1.0 instance MonadZip [] where     mzip     = zip     mzipWith = zipWith     munzip   = unzip +-- | @since 4.8.0.0+instance MonadZip Identity where+    mzipWith                 = liftM2+    munzip (Identity (a, b)) = (Identity a, Identity b)++-- | @since 4.8.0.0 instance MonadZip Dual where     -- Cannot use coerce, it's unsafe     mzipWith = liftM2 +-- | @since 4.8.0.0 instance MonadZip Sum where     mzipWith = liftM2 +-- | @since 4.8.0.0 instance MonadZip Product where     mzipWith = liftM2 +-- | @since 4.8.0.0 instance MonadZip Maybe where     mzipWith = liftM2 +-- | @since 4.8.0.0 instance MonadZip First where     mzipWith = liftM2 +-- | @since 4.8.0.0 instance MonadZip Last where     mzipWith = liftM2 +-- | @since 4.8.0.0 instance MonadZip f => MonadZip (Alt f) where     mzipWith f (Alt ma) (Alt mb) = Alt (mzipWith f ma mb) +-- | @since 4.9.0.0 instance MonadZip Proxy where     mzipWith _ _ _ = Proxy  -- Instances for GHC.Generics+-- | @since 4.9.0.0 instance MonadZip U1 where     mzipWith _ _ _ = U1 +-- | @since 4.9.0.0 instance MonadZip Par1 where     mzipWith = liftM2 +-- | @since 4.9.0.0 instance MonadZip f => MonadZip (Rec1 f) where     mzipWith f (Rec1 fa) (Rec1 fb) = Rec1 (mzipWith f fa fb) +-- | @since 4.9.0.0 instance MonadZip f => MonadZip (M1 i c f) where     mzipWith f (M1 fa) (M1 fb) = M1 (mzipWith f fa fb) +-- | @since 4.9.0.0 instance (MonadZip f, MonadZip g) => MonadZip (f :*: g) where     mzipWith f (x1 :*: y1) (x2 :*: y2) = mzipWith f x1 x2 :*: mzipWith f y1 y2

@@ -0,0 +1,429 @@+{-# LANGUAGE Safe #-}+{-# LANGUAGE ScopedTypeVariables #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Bifoldable+-- Copyright   :  (C) 2011-2016 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- @since 4.10.0.0+----------------------------------------------------------------------------+module Data.Bifoldable+  ( Bifoldable(..)+  , bifoldr'+  , bifoldr1+  , bifoldrM+  , bifoldl'+  , bifoldl1+  , bifoldlM+  , bitraverse_+  , bifor_+  , bimapM_+  , biforM_+  , bimsum+  , bisequenceA_+  , bisequence_+  , biasum+  , biList+  , binull+  , bilength+  , bielem+  , bimaximum+  , biminimum+  , bisum+  , biproduct+  , biconcat+  , biconcatMap+  , biand+  , bior+  , biany+  , biall+  , bimaximumBy+  , biminimumBy+  , binotElem+  , bifind+  ) where++import Control.Applicative+import Data.Functor.Utils (Max(..), Min(..), (#.))+import Data.Maybe (fromMaybe)+import Data.Monoid+import GHC.Generics (K1(..))++-- | 'Bifoldable' identifies foldable structures with two different varieties+-- of elements (as opposed to 'Foldable', which has one variety of element).+-- Common examples are 'Either' and '(,)':+--+-- > instance Bifoldable Either where+-- >   bifoldMap f _ (Left  a) = f a+-- >   bifoldMap _ g (Right b) = g b+-- >+-- > instance Bifoldable (,) where+-- >   bifoldr f g z (a, b) = f a (g b z)+--+-- A minimal 'Bifoldable' definition consists of either 'bifoldMap' or+-- 'bifoldr'. When defining more than this minimal set, one should ensure+-- that the following identities hold:+--+-- @+-- 'bifold' ≡ 'bifoldMap' 'id' 'id'+-- 'bifoldMap' f g ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'+-- 'bifoldr' f g z t ≡ 'appEndo' ('bifoldMap' (Endo . f) (Endo . g) t) z+-- @+--+-- If the type is also a 'Bifunctor' instance, it should satisfy:+--+-- > 'bifoldMap' f g ≡ 'bifold' . 'bimap' f g+--+-- which implies that+--+-- > 'bifoldMap' f g . 'bimap' h i ≡ 'bifoldMap' (f . h) (g . i)+--+-- @since 4.10.0.0+class Bifoldable p where+  {-# MINIMAL bifoldr | bifoldMap #-}++  -- | Combines the elements of a structure using a monoid.+  --+  -- @'bifold' ≡ 'bifoldMap' 'id' 'id'@+  --+  -- @since 4.10.0.0+  bifold :: Monoid m => p m m -> m+  bifold = bifoldMap id id++  -- | Combines the elements of a structure, given ways of mapping them to a+  -- common monoid.+  --+  -- @'bifoldMap' f g+  --     ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'@+  --+  -- @since 4.10.0.0+  bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m+  bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty++  -- | Combines the elements of a structure in a right associative manner.+  -- Given a hypothetical function @toEitherList :: p a b -> [Either a b]@+  -- yielding a list of all elements of a structure in order, the following+  -- would hold:+  --+  -- @'bifoldr' f g z ≡ 'foldr' ('either' f g) z . toEitherList@+  --+  -- @since 4.10.0.0+  bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c+  bifoldr f g z t = appEndo (bifoldMap (Endo #. f) (Endo #. g) t) z++  -- | Combines the elments of a structure in a left associative manner. Given+  -- a hypothetical function @toEitherList :: p a b -> [Either a b]@ yielding a+  -- list of all elements of a structure in order, the following would hold:+  --+  -- @'bifoldl' f g z+  --     ≡ 'foldl' (\acc -> 'either' (f acc) (g acc)) z . toEitherList@+  --+  -- Note that if you want an efficient left-fold, you probably want to use+  -- 'bifoldl'' instead of 'bifoldl'. The reason is that the latter does not+  -- force the "inner" results, resulting in a thunk chain which then must be+  -- evaluated from the outside-in.+  --+  -- @since 4.10.0.0+  bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c+  bifoldl f g z t = appEndo (getDual (bifoldMap (Dual . Endo . flip f)+                                                (Dual . Endo . flip g) t)) z++-- | @since 4.10.0.0+instance Bifoldable (,) where+  bifoldMap f g ~(a, b) = f a `mappend` g b++-- | @since 4.10.0.0+instance Bifoldable Const where+  bifoldMap f _ (Const a) = f a++-- | @since 4.10.0.0+instance Bifoldable (K1 i) where+  bifoldMap f _ (K1 c) = f c++-- | @since 4.10.0.0+instance Bifoldable ((,,) x) where+  bifoldMap f g ~(_,a,b) = f a `mappend` g b++-- | @since 4.10.0.0+instance Bifoldable ((,,,) x y) where+  bifoldMap f g ~(_,_,a,b) = f a `mappend` g b++-- | @since 4.10.0.0+instance Bifoldable ((,,,,) x y z) where+  bifoldMap f g ~(_,_,_,a,b) = f a `mappend` g b++-- | @since 4.10.0.0+instance Bifoldable ((,,,,,) x y z w) where+  bifoldMap f g ~(_,_,_,_,a,b) = f a `mappend` g b++-- | @since 4.10.0.0+instance Bifoldable ((,,,,,,) x y z w v) where+  bifoldMap f g ~(_,_,_,_,_,a,b) = f a `mappend` g b++-- | @since 4.10.0.0+instance Bifoldable Either where+  bifoldMap f _ (Left a) = f a+  bifoldMap _ g (Right b) = g b++-- | As 'bifoldr', but strict in the result of the reduction functions at each+-- step.+--+-- @since 4.10.0.0+bifoldr' :: Bifoldable t => (a -> c -> c) -> (b -> c -> c) -> c -> t a b -> c+bifoldr' f g z0 xs = bifoldl f' g' id xs z0 where+  f' k x z = k $! f x z+  g' k x z = k $! g x z++-- | A variant of 'bifoldr' that has no base case,+-- and thus may only be applied to non-empty structures.+--+-- @since 4.10.0.0+bifoldr1 :: Bifoldable t => (a -> a -> a) -> t a a -> a+bifoldr1 f xs = fromMaybe (error "bifoldr1: empty structure")+                  (bifoldr mbf mbf Nothing xs)+  where+    mbf x m = Just (case m of+                      Nothing -> x+                      Just y  -> f x y)++-- | Right associative monadic bifold over a structure.+--+-- @since 4.10.0.0+bifoldrM :: (Bifoldable t, Monad m)+         => (a -> c -> m c) -> (b -> c -> m c) -> c -> t a b -> m c+bifoldrM f g z0 xs = bifoldl f' g' return xs z0 where+  f' k x z = f x z >>= k+  g' k x z = g x z >>= k++-- | As 'bifoldl', but strict in the result of the reduction functions at each+-- step.+--+-- This ensures that each step of the bifold 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 structure to+-- a single, monolithic result (e.g., 'bilength').+--+-- @since 4.10.0.0+bifoldl':: Bifoldable t => (a -> b -> a) -> (a -> c -> a) -> a -> t b c -> a+bifoldl' f g z0 xs = bifoldr f' g' id xs z0 where+  f' x k z = k $! f z x+  g' x k z = k $! g z x++-- | A variant of 'bifoldl' that has no base case,+-- and thus may only be applied to non-empty structures.+--+-- @since 4.10.0.0+bifoldl1 :: Bifoldable t => (a -> a -> a) -> t a a -> a+bifoldl1 f xs = fromMaybe (error "bifoldl1: empty structure")+                  (bifoldl mbf mbf Nothing xs)+  where+    mbf m y = Just (case m of+                      Nothing -> y+                      Just x  -> f x y)++-- | Left associative monadic bifold over a structure.+--+-- @since 4.10.0.0+bifoldlM :: (Bifoldable t, Monad m)+         => (a -> b -> m a) -> (a -> c -> m a) -> a -> t b c -> m a+bifoldlM f g z0 xs = bifoldr f' g' return xs z0 where+  f' x k z = f z x >>= k+  g' x k z = g z x >>= k++-- | Map each element of a structure using one of two actions, evaluate these+-- actions from left to right, and ignore the results. For a version that+-- doesn't ignore the results, see 'Data.Bitraversable.bitraverse'.+--+-- @since 4.10.0.0+bitraverse_ :: (Bifoldable t, Applicative f)+            => (a -> f c) -> (b -> f d) -> t a b -> f ()+bitraverse_ f g = bifoldr ((*>) . f) ((*>) . g) (pure ())++-- | As 'bitraverse_', but with the structure as the primary argument. For a+-- version that doesn't ignore the results, see 'Data.Bitraversable.bifor'.+--+-- >>> > bifor_ ('a', "bc") print (print . reverse)+-- 'a'+-- "cb"+--+-- @since 4.10.0.0+bifor_ :: (Bifoldable t, Applicative f)+       => t a b -> (a -> f c) -> (b -> f d) -> f ()+bifor_ t f g = bitraverse_ f g t++-- | Alias for 'bitraverse_'.+--+-- @since 4.10.0.0+bimapM_ :: (Bifoldable t, Applicative f)+        => (a -> f c) -> (b -> f d) -> t a b -> f ()+bimapM_ = bitraverse_++-- | Alias for 'bifor_'.+--+-- @since 4.10.0.0+biforM_ :: (Bifoldable t, Applicative f)+        => t a b ->  (a -> f c) -> (b -> f d) -> f ()+biforM_ = bifor_++-- | Alias for 'bisequence_'.+--+-- @since 4.10.0.0+bisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f ()+bisequenceA_ = bisequence_++-- | Evaluate each action in the structure from left to right, and ignore the+-- results. For a version that doesn't ignore the results, see+-- 'Data.Bitraversable.bisequence'.+--+-- @since 4.10.0.0+bisequence_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f ()+bisequence_ = bifoldr (*>) (*>) (pure ())++-- | The sum of a collection of actions, generalizing 'biconcat'.+--+-- @since 4.10.0.0+biasum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a+biasum = bifoldr (<|>) (<|>) empty++-- | Alias for 'biasum'.+--+-- @since 4.10.0.0+bimsum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a+bimsum = biasum++-- | Collects the list of elements of a structure, from left to right.+--+-- @since 4.10.0.0+biList :: Bifoldable t => t a a -> [a]+biList = bifoldr (:) (:) []++-- | Test whether the structure is empty.+--+-- @since 4.10.0.0+binull :: Bifoldable t => t a b -> Bool+binull = bifoldr (\_ _ -> False) (\_ _ -> False) True++-- | Returns the size/length of a finite structure as an 'Int'.+--+-- @since 4.10.0.0+bilength :: Bifoldable t => t a b -> Int+bilength = bifoldl' (\c _ -> c+1) (\c _ -> c+1) 0++-- | Does the element occur in the structure?+--+-- @since 4.10.0.0+bielem :: (Bifoldable t, Eq a) => a -> t a a -> Bool+bielem x = biany (== x) (== x)++-- | Reduces a structure of lists to the concatenation of those lists.+--+-- @since 4.10.0.0+biconcat :: Bifoldable t => t [a] [a] -> [a]+biconcat = bifold++-- | The largest element of a non-empty structure.+--+-- @since 4.10.0.0+bimaximum :: forall t a. (Bifoldable t, Ord a) => t a a -> a+bimaximum = fromMaybe (error "bimaximum: empty structure") .+    getMax . bifoldMap mj mj+  where mj = Max #. (Just :: a -> Maybe a)++-- | The least element of a non-empty structure.+--+-- @since 4.10.0.0+biminimum :: forall t a. (Bifoldable t, Ord a) => t a a -> a+biminimum = fromMaybe (error "biminimum: empty structure") .+    getMin . bifoldMap mj mj+  where mj = Min #. (Just :: a -> Maybe a)++-- | The 'bisum' function computes the sum of the numbers of a structure.+--+-- @since 4.10.0.0+bisum :: (Bifoldable t, Num a) => t a a -> a+bisum = getSum #. bifoldMap Sum Sum++-- | The 'biproduct' function computes the product of the numbers of a+-- structure.+--+-- @since 4.10.0.0+biproduct :: (Bifoldable t, Num a) => t a a -> a+biproduct = getProduct #. bifoldMap Product Product++-- | Given a means of mapping the elements of a structure to lists, computes the+-- concatenation of all such lists in order.+--+-- @since 4.10.0.0+biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c]+biconcatMap = bifoldMap++-- | 'biand' returns the conjunction of a container of Bools.  For the+-- result to be 'True', the container must be finite; 'False', however,+-- results from a 'False' value finitely far from the left end.+--+-- @since 4.10.0.0+biand :: Bifoldable t => t Bool Bool -> Bool+biand = getAll #. bifoldMap All All++-- | 'bior' returns the disjunction of a container of Bools.  For the+-- result to be 'False', the container must be finite; 'True', however,+-- results from a 'True' value finitely far from the left end.+--+-- @since 4.10.0.0+bior :: Bifoldable t => t Bool Bool -> Bool+bior = getAny #. bifoldMap Any Any++-- | Determines whether any element of the structure satisfies its appropriate+-- predicate argument.+--+-- @since 4.10.0.0+biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool+biany p q = getAny #. bifoldMap (Any . p) (Any . q)++-- | Determines whether all elements of the structure satisfy their appropriate+-- predicate argument.+--+-- @since 4.10.0.0+biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool+biall p q = getAll #. bifoldMap (All . p) (All . q)++-- | The largest element of a non-empty structure with respect to the+-- given comparison function.+--+-- @since 4.10.0.0+bimaximumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a+bimaximumBy cmp = bifoldr1 max'+  where max' x y = case cmp x y of+                        GT -> x+                        _  -> y++-- | The least element of a non-empty structure with respect to the+-- given comparison function.+--+-- @since 4.10.0.0+biminimumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a+biminimumBy cmp = bifoldr1 min'+  where min' x y = case cmp x y of+                        GT -> y+                        _  -> x++-- | 'binotElem' is the negation of 'bielem'.+--+-- @since 4.10.0.0+binotElem :: (Bifoldable t, Eq a) => a -> t a a-> Bool+binotElem x =  not . bielem x++-- | The 'bifind' function takes a predicate and a structure and returns+-- the leftmost element of the structure matching the predicate, or+-- 'Nothing' if there is no such element.+--+-- @since 4.10.0.0+bifind :: Bifoldable t => (a -> Bool) -> t a a -> Maybe a+bifind p = getFirst . bifoldMap finder finder+  where finder x = First (if p x then Just x else Nothing)

@@ -75,31 +75,40 @@     second = bimap id  +-- | @since 4.8.0.0 instance Bifunctor (,) where     bimap f g ~(a, b) = (f a, g b) +-- | @since 4.8.0.0 instance Bifunctor ((,,) x1) where     bimap f g ~(x1, a, b) = (x1, f a, g b) +-- | @since 4.8.0.0 instance Bifunctor ((,,,) x1 x2) where     bimap f g ~(x1, x2, a, b) = (x1, x2, f a, g b) +-- | @since 4.8.0.0 instance Bifunctor ((,,,,) x1 x2 x3) where     bimap f g ~(x1, x2, x3, a, b) = (x1, x2, x3, f a, g b) +-- | @since 4.8.0.0 instance Bifunctor ((,,,,,) x1 x2 x3 x4) where     bimap f g ~(x1, x2, x3, x4, a, b) = (x1, x2, x3, x4, f a, g b) +-- | @since 4.8.0.0 instance Bifunctor ((,,,,,,) x1 x2 x3 x4 x5) where     bimap f g ~(x1, x2, x3, x4, x5, a, b) = (x1, x2, x3, x4, x5, f a, g b)  +-- | @since 4.8.0.0 instance Bifunctor Either where     bimap f _ (Left a) = Left (f a)     bimap _ g (Right b) = Right (g b) +-- | @since 4.8.0.0 instance Bifunctor Const where     bimap f _ (Const a) = Const (f a) +-- | @since 4.9.0.0 instance Bifunctor (K1 i) where     bimap f _ (K1 c) = K1 (f c)

@@ -0,0 +1,248 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE ScopedTypeVariables #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Bitraversable+-- Copyright   :  (C) 2011-2016 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- @since 4.10.0.0+----------------------------------------------------------------------------+module Data.Bitraversable+  ( Bitraversable(..)+  , bisequenceA+  , bisequence+  , bimapM+  , bifor+  , biforM+  , bimapAccumL+  , bimapAccumR+  , bimapDefault+  , bifoldMapDefault+  ) where++import Control.Applicative+import Data.Bifunctor+import Data.Bifoldable+import Data.Coerce+import Data.Functor.Identity (Identity(..))+import Data.Functor.Utils (StateL(..), StateR(..))+import GHC.Generics (K1(..))++-- | 'Bitraversable' identifies bifunctorial data structures whose elements can+-- be traversed in order, performing 'Applicative' or 'Monad' actions at each+-- element, and collecting a result structure with the same shape.+--+-- As opposed to 'Traversable' data structures, which have one variety of+-- element on which an action can be performed, 'Bitraversable' data structures+-- have two such varieties of elements.+--+-- A definition of 'bitraverse' must satisfy the following laws:+--+-- [/naturality/]+--   @'bitraverse' (t . f) (t . g) ≡ t . 'bitraverse' f g@+--   for every applicative transformation @t@+--+-- [/identity/]+--   @'bitraverse' 'Identity' 'Identity' ≡ 'Identity'@+--+-- [/composition/]+--   @'Compose' . 'fmap' ('bitraverse' g1 g2) . 'bitraverse' f1 f2+--     ≡ 'traverse' ('Compose' . 'fmap' g1 . f1) ('Compose' . 'fmap' g2 . f2)@+--+-- where an /applicative transformation/ is a function+--+-- @t :: ('Applicative' f, 'Applicative' g) => f a -> g a@+--+-- preserving the 'Applicative' operations:+--+-- @+-- t ('pure' x) = 'pure' x+-- t (f '<*>' x) = t f '<*>' t x+-- @+--+-- and the identity functor 'Identity' and composition functors 'Compose' are+-- defined as+--+-- > newtype Identity a = Identity { runIdentity :: a }+-- >+-- > instance Functor Identity where+-- >   fmap f (Identity x) = Identity (f x)+-- >+-- > instance Applicative Identity where+-- >   pure = Identity+-- >   Identity f <*> Identity x = Identity (f x)+-- >+-- > newtype Compose f g a = Compose (f (g a))+-- >+-- > instance (Functor f, Functor g) => Functor (Compose f g) where+-- >   fmap f (Compose x) = Compose (fmap (fmap f) x)+-- >+-- > instance (Applicative f, Applicative g) => Applicative (Compose f g) where+-- >   pure = Compose . pure . pure+-- >   Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)+--+-- Some simple examples are 'Either' and '(,)':+--+-- > instance Bitraversable Either where+-- >   bitraverse f _ (Left x) = Left <$> f x+-- >   bitraverse _ g (Right y) = Right <$> g y+-- >+-- > instance Bitraversable (,) where+-- >   bitraverse f g (x, y) = (,) <$> f x <*> g y+--+-- 'Bitraversable' relates to its superclasses in the following ways:+--+-- @+-- 'bimap' f g ≡ 'runIdentity' . 'bitraverse' ('Identity' . f) ('Identity' . g)+-- 'bifoldMap' f g = 'getConst' . 'bitraverse' ('Const' . f) ('Const' . g)+-- @+--+-- These are available as 'bimapDefault' and 'bifoldMapDefault' respectively.+--+-- @since 4.10.0.0+class (Bifunctor t, Bifoldable t) => Bitraversable t where+  -- | Evaluates the relevant functions at each element in the structure,+  -- running the action, and builds a new structure with the same shape, using+  -- the results produced from sequencing the actions.+  --+  -- @'bitraverse' f g ≡ 'bisequenceA' . 'bimap' f g@+  --+  -- For a version that ignores the results, see 'bitraverse_'.+  --+  -- @since 4.10.0.0+  bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)+  bitraverse f g = bisequenceA . bimap f g++-- | Alias for 'bisequence'.+--+-- @since 4.10.0.0+bisequenceA :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)+bisequenceA = bisequence++-- | Alias for 'bitraverse'.+--+-- @since 4.10.0.0+bimapM :: (Bitraversable t, Applicative f)+       => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)+bimapM = bitraverse++-- | Sequences all the actions in a structure, building a new structure with+-- the same shape using the results of the actions. For a version that ignores+-- the results, see 'bisequence_'.+--+-- @'bisequence' ≡ 'bitraverse' 'id' 'id'@+--+-- @since 4.10.0.0+bisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)+bisequence = bitraverse id id++-- | @since 4.10.0.0+instance Bitraversable (,) where+  bitraverse f g ~(a, b) = liftA2 (,) (f a) (g b)++-- | @since 4.10.0.0+instance Bitraversable ((,,) x) where+  bitraverse f g ~(x, a, b) = liftA2 ((,,) x) (f a) (g b)++-- | @since 4.10.0.0+instance Bitraversable ((,,,) x y) where+  bitraverse f g ~(x, y, a, b) = liftA2 ((,,,) x y) (f a) (g b)++-- | @since 4.10.0.0+instance Bitraversable ((,,,,) x y z) where+  bitraverse f g ~(x, y, z, a, b) = liftA2 ((,,,,) x y z) (f a) (g b)++-- | @since 4.10.0.0+instance Bitraversable ((,,,,,) x y z w) where+  bitraverse f g ~(x, y, z, w, a, b) = liftA2 ((,,,,,) x y z w) (f a) (g b)++-- | @since 4.10.0.0+instance Bitraversable ((,,,,,,) x y z w v) where+  bitraverse f g ~(x, y, z, w, v, a, b) =+    liftA2 ((,,,,,,) x y z w v) (f a) (g b)++-- | @since 4.10.0.0+instance Bitraversable Either where+  bitraverse f _ (Left a) = Left <$> f a+  bitraverse _ g (Right b) = Right <$> g b++-- | @since 4.10.0.0+instance Bitraversable Const where+  bitraverse f _ (Const a) = Const <$> f a++-- | @since 4.10.0.0+instance Bitraversable (K1 i) where+  bitraverse f _ (K1 c) = K1 <$> f c++-- | 'bifor' is 'bitraverse' with the structure as the first argument. For a+-- version that ignores the results, see 'bifor_'.+--+-- @since 4.10.0.0+bifor :: (Bitraversable t, Applicative f)+      => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)+bifor t f g = bitraverse f g t++-- | Alias for 'bifor'.+--+-- @since 4.10.0.0+biforM :: (Bitraversable t, Applicative f)+       => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)+biforM = bifor++-- | The 'bimapAccumL' function behaves like a combination of 'bimap' and+-- 'bifoldl'; it traverses a structure from left to right, threading a state+-- of type @a@ and using the given actions to compute new elements for the+-- structure.+--+-- @since 4.10.0.0+bimapAccumL :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e))+            -> a -> t b d -> (a, t c e)+bimapAccumL f g s t+  = runStateL (bitraverse (StateL . flip f) (StateL . flip g) t) s++-- | The 'bimapAccumR' function behaves like a combination of 'bimap' and+-- 'bifoldl'; it traverses a structure from right to left, threading a state+-- of type @a@ and using the given actions to compute new elements for the+-- structure.+--+-- @since 4.10.0.0+bimapAccumR :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e))+            -> a -> t b d -> (a, t c e)+bimapAccumR f g s t+  = runStateR (bitraverse (StateR . flip f) (StateR . flip g) t) s++-- | A default definition of 'bimap' in terms of the 'Bitraversable'+-- operations.+--+-- @'bimapDefault' f g ≡+--     'runIdentity' . 'bitraverse' ('Identity' . f) ('Identity' . g)@+--+-- @since 4.10.0.0+bimapDefault :: forall t a b c d . Bitraversable t+             => (a -> b) -> (c -> d) -> t a c -> t b d+-- See Note [Function coercion] in Data.Functor.Utils.+bimapDefault = coerce+  (bitraverse :: (a -> Identity b)+              -> (c -> Identity d) -> t a c -> Identity (t b d))+{-# INLINE bimapDefault #-}++-- | A default definition of 'bifoldMap' in terms of the 'Bitraversable'+-- operations.+--+-- @'bifoldMapDefault' f g ≡+--    'getConst' . 'bitraverse' ('Const' . f) ('Const' . g)@+--+-- @since 4.10.0.0+bifoldMapDefault :: forall t m a b . (Bitraversable t, Monoid m)+                 => (a -> m) -> (b -> m) -> t a b -> m+-- See Note [Function coercion] in Data.Functor.Utils.+bifoldMapDefault = coerce+  (bitraverse :: (a -> Const m ())+              -> (b -> Const m ()) -> t a b -> Const m (t () ()))+{-# INLINE bifoldMapDefault #-}

@@ -397,7 +397,9 @@ {-# INLINABLE popCountDefault #-}  --- Interpret 'Bool' as 1-bit bit-field; @since 4.7.0.0+-- | Interpret 'Bool' as 1-bit bit-field+--+--  @since 4.7.0.0 instance Bits Bool where     (.&.) = (&&) @@ -427,11 +429,13 @@     popCount False = 0     popCount True  = 1 +-- | @since 4.7.0.0 instance FiniteBits Bool where     finiteBitSize _ = 1     countTrailingZeros x = if x then 0 else 1     countLeadingZeros  x = if x then 0 else 1 +-- | @since 2.01 instance Bits Int where     {-# INLINE shift #-}     {-# INLINE bit #-}@@ -468,11 +472,13 @@      isSigned _             = True +-- | @since 4.6.0.0 instance FiniteBits Int where     finiteBitSize _ = WORD_SIZE_IN_BITS     countLeadingZeros  (I# x#) = I# (word2Int# (clz# (int2Word# x#)))     countTrailingZeros (I# x#) = I# (word2Int# (ctz# (int2Word# x#))) +-- | @since 2.01 instance Bits Word where     {-# INLINE shift #-}     {-# INLINE bit #-}@@ -503,11 +509,13 @@     bit                      = bitDefault     testBit                  = testBitDefault +-- | @since 4.6.0.0 instance FiniteBits Word where     finiteBitSize _ = WORD_SIZE_IN_BITS     countLeadingZeros  (W# x#) = I# (word2Int# (clz# x#))     countTrailingZeros (W# x#) = I# (word2Int# (ctz# x#)) +-- | @since 2.01 instance Bits Integer where    (.&.) = andInteger    (.|.) = orInteger@@ -582,7 +590,7 @@                             then Just (bit (yW-1)-1)                             else Just (bit yW-1)       | otherwise = Nothing-{-# INLINEABLE toIntegralSized #-}+{-# INLINABLE toIntegralSized #-}  -- | 'True' if the size of @a@ is @<=@ the size of @b@, where size is measured -- by 'bitSizeMaybe' and 'isSigned'.

@@ -36,6 +36,7 @@          )  where +import GHC.Base (Applicative (..)) import GHC.Generics (Generic, Generic1) import GHC.Float (Floating(..)) import Data.Data (Data)@@ -115,6 +116,7 @@ -- ----------------------------------------------------------------------------- -- Instances of Complex +-- | @since 2.01 instance  (RealFloat a) => Num (Complex a)  where     {-# SPECIALISE instance Num (Complex Float) #-}     {-# SPECIALISE instance Num (Complex Double) #-}@@ -127,6 +129,7 @@     signum z@(x:+y)     =  x/r :+ y/r  where r = magnitude z     fromInteger n       =  fromInteger n :+ 0 +-- | @since 2.01 instance  (RealFloat a) => Fractional (Complex a)  where     {-# SPECIALISE instance Fractional (Complex Float) #-}     {-# SPECIALISE instance Fractional (Complex Double) #-}@@ -138,6 +141,7 @@      fromRational a      =  fromRational a :+ 0 +-- | @since 2.01 instance  (RealFloat a) => Floating (Complex a) where     {-# SPECIALISE instance Floating (Complex Float) #-}     {-# SPECIALISE instance Floating (Complex Double) #-}@@ -210,6 +214,7 @@       | otherwise = exp x - 1     {-# INLINE expm1 #-} +-- | @since 4.8.0.0 instance Storable a => Storable (Complex a) where     sizeOf a       = 2 * sizeOf (realPart a)     alignment a    = alignment (realPart a)@@ -223,9 +228,25 @@                         poke q r                         pokeElemOff q 1 i +-- | @since 4.9.0.0 instance Applicative Complex where   pure a = a :+ a   f :+ g <*> a :+ b = f a :+ g b+  liftA2 f (x :+ y) (a :+ b) = f x a :+ f y b +-- | @since 4.9.0.0 instance Monad Complex where   a :+ b >>= f = realPart (f a) :+ imagPart (f b)++-- -----------------------------------------------------------------------------+-- Rules on Complex++{-# RULES++"realToFrac/a->Complex Double"+  realToFrac = \x -> realToFrac x :+ (0 :: Double)++"realToFrac/a->Complex Float"+  realToFrac = \x -> realToFrac x :+ (0 :: Float)++  #-}

@@ -1,9 +1,16 @@-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE RankNTypes, ScopedTypeVariables, PolyKinds, StandaloneDeriving,-             TypeOperators, GADTs, FlexibleInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}  ----------------------------------------------------------------------------- -- |@@ -108,6 +115,7 @@  ------------------------------------------------------------------------------ +import Data.Functor.Const import Data.Either import Data.Eq import Data.Maybe@@ -118,11 +126,13 @@ import GHC.Base hiding (Any, IntRep, FloatRep) import GHC.List import GHC.Num+import GHC.Natural import GHC.Read import GHC.Show import Text.Read( reads )  -- Imports for the instances+import Data.Functor.Identity -- So we can give Data instance for Identity import Data.Int              -- So we can give Data instance for Int8, ... import Data.Type.Coercion import Data.Word             -- So we can give Data instance for Word8, ...@@ -304,24 +314,24 @@   -- isomorphism pair as injection and projection.   gmapT :: (forall b. Data b => b -> b) -> a -> a -  -- Use an identity datatype constructor ID (see below)+  -- Use the Identity datatype constructor   -- to instantiate the type constructor c in the type of gfoldl,-  -- and perform injections ID and projections unID accordingly.+  -- and perform injections Identity and projections runIdentity accordingly.   ---  gmapT f x0 = unID (gfoldl k ID x0)+  gmapT f x0 = runIdentity (gfoldl k Identity x0)     where-      k :: Data d => ID (d->b) -> d -> ID b-      k (ID c) x = ID (c (f x))+      k :: Data d => Identity (d->b) -> d -> Identity b+      k (Identity c) x = Identity (c (f x))     -- | A generic query with a left-associative binary operator   gmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r-  gmapQl o r f = unCONST . gfoldl k z+  gmapQl o r f = getConst . gfoldl k z     where-      k :: Data d => CONST r (d->b) -> d -> CONST r b-      k c x = CONST $ (unCONST c) `o` f x-      z :: g -> CONST r g-      z _   = CONST r+      k :: Data d => Const r (d->b) -> d -> Const r b+      k c x = Const $ (getConst c) `o` f x+      z :: g -> Const r g+      z _   = Const r    -- | A generic query with a right-associative binary operator   gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r@@ -417,14 +427,6 @@              )  --- | The identity type constructor needed for the definition of gmapT-newtype ID x = ID { unID :: x }----- | The constant type constructor needed for the definition of gmapQl-newtype CONST c a = CONST { unCONST :: c }-- -- | Type constructor for adding counters to queries data Qi q a = Qi Int (Maybe q) @@ -455,13 +457,13 @@             => (forall d. Data d => d)             -> Constr             -> a-fromConstrB f = unID . gunfold k z+fromConstrB f = runIdentity . gunfold k z  where-  k :: forall b r. Data b => ID (b -> r) -> ID r-  k c = ID (unID c f)+  k :: forall b r. Data b => Identity (b -> r) -> Identity r+  k c = Identity (runIdentity c f) -  z :: forall r. r -> ID r-  z = ID+  z :: forall r. r -> Identity r+  z = Identity   -- | Monadic variation on 'fromConstrB'@@ -508,11 +510,14 @@                         , datatype  :: DataType                         } +-- | @since 4.0.0.0 instance Show Constr where  show = constring   -- | Equality of constructors+--+-- @since 4.0.0.0 instance Eq Constr where   c == c' = constrRep c == constrRep c' @@ -682,7 +687,7 @@  ------------------------------------------------------------------------------ -----      Convenience funtions: algebraic data types+--      Convenience functions: algebraic data types -- ------------------------------------------------------------------------------ @@ -844,32 +849,15 @@ -- ------------------------------------------------------------------------------ --falseConstr :: Constr-falseConstr  = mkConstr boolDataType "False" [] Prefix-trueConstr :: Constr-trueConstr   = mkConstr boolDataType "True"  [] Prefix--boolDataType :: DataType-boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr]--instance Data Bool where-  toConstr False = falseConstr-  toConstr True  = trueConstr-  gunfold _ z c  = case constrIndex c of-                     1 -> z False-                     2 -> z True-                     _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor "-                                  ++ show c-                                  ++ " is not of type Bool."-  dataTypeOf _ = boolDataType-+-- | @since 4.0.0.0+deriving instance Data Bool  ------------------------------------------------------------------------------  charType :: DataType charType = mkCharType "Prelude.Char" +-- | @since 4.0.0.0 instance Data Char where   toConstr x = mkCharConstr charType x   gunfold _ z c = case constrRep c of@@ -884,6 +872,7 @@ floatType :: DataType floatType = mkFloatType "Prelude.Float" +-- | @since 4.0.0.0 instance Data Float where   toConstr = mkRealConstr floatType   gunfold _ z c = case constrRep c of@@ -898,6 +887,7 @@ doubleType :: DataType doubleType = mkFloatType "Prelude.Double" +-- | @since 4.0.0.0 instance Data Double where   toConstr = mkRealConstr doubleType   gunfold _ z c = case constrRep c of@@ -912,6 +902,7 @@ intType :: DataType intType = mkIntType "Prelude.Int" +-- | @since 4.0.0.0 instance Data Int where   toConstr x = mkIntegralConstr intType x   gunfold _ z c = case constrRep c of@@ -926,6 +917,7 @@ integerType :: DataType integerType = mkIntType "Prelude.Integer" +-- | @since 4.0.0.0 instance Data Integer where   toConstr = mkIntegralConstr integerType   gunfold _ z c = case constrRep c of@@ -937,9 +929,27 @@  ------------------------------------------------------------------------------ +-- This follows the same style as the other integral 'Data' instances+-- defined in "Data.Data"+naturalType :: DataType+naturalType = mkIntType "Numeric.Natural.Natural"++-- | @since 4.8.0.0+instance Data Natural where+  toConstr x = mkIntegralConstr naturalType x+  gunfold _ z c = case constrRep c of+                    (IntConstr x) -> z (fromIntegral x)+                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c+                                 ++ " is not of type Natural"+  dataTypeOf _ = naturalType+++------------------------------------------------------------------------------+ int8Type :: DataType int8Type = mkIntType "Data.Int.Int8" +-- | @since 4.0.0.0 instance Data Int8 where   toConstr x = mkIntegralConstr int8Type x   gunfold _ z c = case constrRep c of@@ -954,6 +964,7 @@ int16Type :: DataType int16Type = mkIntType "Data.Int.Int16" +-- | @since 4.0.0.0 instance Data Int16 where   toConstr x = mkIntegralConstr int16Type x   gunfold _ z c = case constrRep c of@@ -968,6 +979,7 @@ int32Type :: DataType int32Type = mkIntType "Data.Int.Int32" +-- | @since 4.0.0.0 instance Data Int32 where   toConstr x = mkIntegralConstr int32Type x   gunfold _ z c = case constrRep c of@@ -982,6 +994,7 @@ int64Type :: DataType int64Type = mkIntType "Data.Int.Int64" +-- | @since 4.0.0.0 instance Data Int64 where   toConstr x = mkIntegralConstr int64Type x   gunfold _ z c = case constrRep c of@@ -996,6 +1009,7 @@ wordType :: DataType wordType = mkIntType "Data.Word.Word" +-- | @since 4.0.0.0 instance Data Word where   toConstr x = mkIntegralConstr wordType x   gunfold _ z c = case constrRep c of@@ -1010,6 +1024,7 @@ word8Type :: DataType word8Type = mkIntType "Data.Word.Word8" +-- | @since 4.0.0.0 instance Data Word8 where   toConstr x = mkIntegralConstr word8Type x   gunfold _ z c = case constrRep c of@@ -1024,6 +1039,7 @@ word16Type :: DataType word16Type = mkIntType "Data.Word.Word16" +-- | @since 4.0.0.0 instance Data Word16 where   toConstr x = mkIntegralConstr word16Type x   gunfold _ z c = case constrRep c of@@ -1038,6 +1054,7 @@ word32Type :: DataType word32Type = mkIntType "Data.Word.Word32" +-- | @since 4.0.0.0 instance Data Word32 where   toConstr x = mkIntegralConstr word32Type x   gunfold _ z c = case constrRep c of@@ -1052,6 +1069,7 @@ word64Type :: DataType word64Type = mkIntType "Data.Word.Word64" +-- | @since 4.0.0.0 instance Data Word64 where   toConstr x = mkIntegralConstr word64Type x   gunfold _ z c = case constrRep c of@@ -1069,6 +1087,11 @@ ratioDataType :: DataType ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr] +-- NB: This Data instance intentionally uses the (%) smart constructor instead+-- of the internal (:%) constructor to preserve the invariant that a Ratio+-- value is reduced to normal form. See Trac #10011.++-- | @since 4.0.0.0 instance (Data a, Integral a) => Data (Ratio a) where   gfoldl k z (a :% b) = z (%) `k` a `k` b   toConstr _ = ratioConstr@@ -1087,6 +1110,7 @@ listDataType :: DataType listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr] +-- | @since 4.0.0.0 instance Data a => Data [a] where   gfoldl _ z []     = z []   gfoldl f z (x:xs) = z (:) `f` x `f` xs@@ -1113,201 +1137,43 @@  ------------------------------------------------------------------------------ -nothingConstr :: Constr-nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix-justConstr :: Constr-justConstr    = mkConstr maybeDataType "Just"    [] Prefix--maybeDataType :: DataType-maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr]--instance Data a => Data (Maybe a) where-  gfoldl _ z Nothing  = z Nothing-  gfoldl f z (Just x) = z Just `f` x-  toConstr Nothing  = nothingConstr-  toConstr (Just _) = justConstr-  gunfold k z c = case constrIndex c of-                    1 -> z Nothing-                    2 -> k (z Just)-                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Maybe)"-  dataTypeOf _ = maybeDataType-  dataCast1 f  = gcast1 f-----------------------------------------------------------------------------------ltConstr :: Constr-ltConstr         = mkConstr orderingDataType "LT" [] Prefix-eqConstr :: Constr-eqConstr         = mkConstr orderingDataType "EQ" [] Prefix-gtConstr :: Constr-gtConstr         = mkConstr orderingDataType "GT" [] Prefix--orderingDataType :: DataType-orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr]--instance Data Ordering where-  gfoldl _ z LT  = z LT-  gfoldl _ z EQ  = z EQ-  gfoldl _ z GT  = z GT-  toConstr LT  = ltConstr-  toConstr EQ  = eqConstr-  toConstr GT  = gtConstr-  gunfold _ z c = case constrIndex c of-                    1 -> z LT-                    2 -> z EQ-                    3 -> z GT-                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Ordering)"-  dataTypeOf _ = orderingDataType-----------------------------------------------------------------------------------leftConstr :: Constr-leftConstr     = mkConstr eitherDataType "Left"  [] Prefix--rightConstr :: Constr-rightConstr    = mkConstr eitherDataType "Right" [] Prefix--eitherDataType :: DataType-eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr]--instance (Data a, Data b) => Data (Either a b) where-  gfoldl f z (Left a)   = z Left  `f` a-  gfoldl f z (Right a)  = z Right `f` a-  toConstr (Left _)  = leftConstr-  toConstr (Right _) = rightConstr-  gunfold k z c = case constrIndex c of-                    1 -> k (z Left)-                    2 -> k (z Right)-                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Either)"-  dataTypeOf _ = eitherDataType-  dataCast2 f  = gcast2 f-----------------------------------------------------------------------------------tuple0Constr :: Constr-tuple0Constr = mkConstr tuple0DataType "()" [] Prefix--tuple0DataType :: DataType-tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]--instance Data () where-  toConstr ()   = tuple0Constr-  gunfold _ z c | constrIndex c == 1 = z ()-  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(unit)"-  dataTypeOf _  = tuple0DataType-----------------------------------------------------------------------------------tuple2Constr :: Constr-tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix--tuple2DataType :: DataType-tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr]--instance (Data a, Data b) => Data (a,b) where-  gfoldl f z (a,b) = z (,) `f` a `f` b-  toConstr (_,_) = tuple2Constr-  gunfold k z c | constrIndex c == 1 = k (k (z (,)))-  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(tup2)"-  dataTypeOf _  = tuple2DataType-  dataCast2 f   = gcast2 f-----------------------------------------------------------------------------------tuple3Constr :: Constr-tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix--tuple3DataType :: DataType-tuple3DataType = mkDataType "Prelude.(,,)" [tuple3Constr]--instance (Data a, Data b, Data c) => Data (a,b,c) where-  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 _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(tup3)"-  dataTypeOf _  = tuple3DataType-----------------------------------------------------------------------------------tuple4Constr :: Constr-tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix--tuple4DataType :: DataType-tuple4DataType = mkDataType "Prelude.(,,,)" [tuple4Constr]--instance (Data a, Data b, Data c, Data d)-         => Data (a,b,c,d) where-  gfoldl f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d-  toConstr (_,_,_,_) = tuple4Constr-  gunfold k z c = case constrIndex c of-                    1 -> k (k (k (k (z (,,,)))))-                    _ -> errorWithoutStackTrace "Data.Data.gunfold(tup4)"-  dataTypeOf _ = tuple4DataType-----------------------------------------------------------------------------------tuple5Constr :: Constr-tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix--tuple5DataType :: DataType-tuple5DataType = mkDataType "Prelude.(,,,,)" [tuple5Constr]--instance (Data a, Data b, Data c, Data d, Data e)-         => Data (a,b,c,d,e) where-  gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e-  toConstr (_,_,_,_,_) = tuple5Constr-  gunfold k z c = case constrIndex c of-                    1 -> k (k (k (k (k (z (,,,,))))))-                    _ -> errorWithoutStackTrace "Data.Data.gunfold(tup5)"-  dataTypeOf _ = tuple5DataType---------------------------------------------------------------------------------+-- | @since 4.0.0.0+deriving instance Data a => Data (Maybe a) -tuple6Constr :: Constr-tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix+-- | @since 4.0.0.0+deriving instance Data Ordering -tuple6DataType :: DataType-tuple6DataType = mkDataType "Prelude.(,,,,,)" [tuple6Constr]+-- | @since 4.0.0.0+deriving instance (Data a, Data b) => Data (Either a b) -instance (Data a, Data b, Data c, Data d, Data e, Data f)-         => Data (a,b,c,d,e,f) where-  gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f'-  toConstr (_,_,_,_,_,_) = tuple6Constr-  gunfold k z c = case constrIndex c of-                    1 -> k (k (k (k (k (k (z (,,,,,)))))))-                    _ -> errorWithoutStackTrace "Data.Data.gunfold(tup6)"-  dataTypeOf _ = tuple6DataType+-- | @since 4.0.0.0+deriving instance Data () +-- | @since 4.0.0.0+deriving instance (Data a, Data b) => Data (a,b) -------------------------------------------------------------------------------+-- | @since 4.0.0.0+deriving instance (Data a, Data b, Data c) => Data (a,b,c) -tuple7Constr :: Constr-tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix+-- | @since 4.0.0.0+deriving instance (Data a, Data b, Data c, Data d)+         => Data (a,b,c,d) -tuple7DataType :: DataType-tuple7DataType = mkDataType "Prelude.(,,,,,,)" [tuple7Constr]+-- | @since 4.0.0.0+deriving instance (Data a, Data b, Data c, Data d, Data e)+         => Data (a,b,c,d,e) -instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)-         => Data (a,b,c,d,e,f,g) where-  gfoldl f z (a,b,c,d,e,f',g) =-    z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g-  toConstr  (_,_,_,_,_,_,_) = tuple7Constr-  gunfold k z c = case constrIndex c of-                    1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))-                    _ -> errorWithoutStackTrace "Data.Data.gunfold(tup7)"-  dataTypeOf _ = tuple7DataType+-- | @since 4.0.0.0+deriving instance (Data a, Data b, Data c, Data d, Data e, Data f)+         => Data (a,b,c,d,e,f) +-- | @since 4.0.0.0+deriving instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)+         => Data (a,b,c,d,e,f,g)  ------------------------------------------------------------------------------ +-- | @since 4.8.0.0 instance Data a => Data (Ptr a) where   toConstr _   = errorWithoutStackTrace "Data.Data.toConstr(Ptr)"   gunfold _ _  = errorWithoutStackTrace "Data.Data.gunfold(Ptr)"@@ -1316,6 +1182,7 @@  ------------------------------------------------------------------------------ +-- | @since 4.8.0.0 instance Data a => Data (ForeignPtr a) where   toConstr _   = errorWithoutStackTrace "Data.Data.toConstr(ForeignPtr)"   gunfold _ _  = errorWithoutStackTrace "Data.Data.gunfold(ForeignPtr)"@@ -1325,6 +1192,7 @@ ------------------------------------------------------------------------------ -- The Data instance for Array preserves data abstraction at the cost of -- inefficiency. We omit reflection services for the sake of data abstraction.+-- | @since 4.8.0.0 instance (Data a, Data b, Ix a) => Data (Array a b)  where   gfoldl f z a = z (listArray (bounds a)) `f` (elems a)@@ -1336,483 +1204,102 @@ ---------------------------------------------------------------------------- -- Data instance for Proxy -proxyConstr :: Constr-proxyConstr = mkConstr proxyDataType "Proxy" [] Prefix--proxyDataType :: DataType-proxyDataType = mkDataType "Data.Proxy.Proxy" [proxyConstr]--instance (Data t) => Data (Proxy t) where-  gfoldl _ z Proxy  = z Proxy-  toConstr Proxy  = proxyConstr-  gunfold _ z c = case constrIndex c of-                    1 -> z Proxy-                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Proxy)"-  dataTypeOf _ = proxyDataType-  dataCast1 f  = gcast1 f---------------------------------------------------------------------------- instance for (:~:)--reflConstr :: Constr-reflConstr = mkConstr equalityDataType "Refl" [] Prefix--equalityDataType :: DataType-equalityDataType = mkDataType "Data.Type.Equality.(:~:)" [reflConstr]--instance (a ~ b, Data a) => Data (a :~: b) where-  gfoldl _ z Refl = z Refl-  toConstr Refl   = reflConstr-  gunfold _ z c   = case constrIndex c of-                      1 -> z Refl-                      _ -> errorWithoutStackTrace "Data.Data.gunfold(:~:)"-  dataTypeOf _    = equalityDataType-  dataCast2 f     = gcast2 f---------------------------------------------------------------------------- instance for Coercion--coercionConstr :: Constr-coercionConstr = mkConstr equalityDataType "Coercion" [] Prefix--coercionDataType :: DataType-coercionDataType = mkDataType "Data.Type.Coercion.Coercion" [coercionConstr]--instance (Coercible a b, Data a, Data b) => Data (Coercion a b) where-  gfoldl _ z Coercion = z Coercion-  toConstr Coercion = coercionConstr-  gunfold _ z c   = case constrIndex c of-                      1 -> z Coercion-                      _ -> errorWithoutStackTrace "Data.Data.gunfold(Coercion)"-  dataTypeOf _    = coercionDataType-  dataCast2 f     = gcast2 f---------------------------------------------------------------------------- instance for Data.Version--versionConstr :: Constr-versionConstr = mkConstr versionDataType "Version" ["versionBranch","versionTags"] Prefix--versionDataType :: DataType-versionDataType = mkDataType "Data.Version.Version" [versionConstr]--instance Data Version where-  gfoldl k z (Version bs ts) = z Version `k` bs `k` ts-  toConstr (Version _ _) = versionConstr-  gunfold k z c = case constrIndex c of-                    1 -> k (k (z 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-------------------------------------------------------------------------+-- | @since 4.7.0.0+deriving instance (Data t) => Data (Proxy t) -comp1Constr :: Constr-comp1Constr = mkConstr comp1DataType "Comp1" [] Prefix+-- | @since 4.7.0.0+deriving instance (a ~ b, Data a) => Data (a :~: b) -comp1DataType :: DataType-comp1DataType = mkDataType "GHC.Generics.:.:" [comp1Constr]+-- | @since 4.10.0.0+deriving instance (Typeable i, Typeable j, Typeable a, Typeable b,+                    (a :: i) ~~ (b :: j))+    => Data (a :~~: b) -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+-- | @since 4.7.0.0+deriving instance (Coercible a b, Data a, Data b) => Data (Coercion a b) ------------------------------------------------------------------------+-- | @since 4.9.0.0+deriving instance Data a => Data (Identity a) -v1DataType :: DataType-v1DataType = mkDataType "GHC.Generics.V1" []+-- | @since 4.10.0.0+deriving instance (Typeable k, Data a, Typeable (b :: k)) => Data (Const a b) -instance Data p => Data (V1 p) where-  gfoldl _ _ !_ = undefined-  toConstr !_ = undefined-  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(V1)"-  dataTypeOf _ = v1DataType-  dataCast1 f = gcast1 f+-- | @since 4.7.0.0+deriving instance Data Version ------------------------------------------------------------------------+----------------------------------------------------------------------------+-- Data instances for Data.Monoid wrappers -prod1DataType :: DataType-prod1DataType = mkDataType "GHC.Generics.:*:" [prod1Constr]+-- | @since 4.8.0.0+deriving instance Data a => Data (Dual a) -prod1Constr :: Constr-prod1Constr = mkConstr prod1DataType "Prod1" [] Infix+-- | @since 4.8.0.0+deriving instance Data All -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+-- | @since 4.8.0.0+deriving instance Data Any ------------------------------------------------------------------------+-- | @since 4.8.0.0+deriving instance Data a => Data (Sum a) -prefixConstr :: Constr-prefixConstr = mkConstr fixityDataType "Prefix" [] Prefix-infixConstr  :: Constr-infixConstr  = mkConstr fixityDataType "Infix"  [] Prefix+-- | @since 4.8.0.0+deriving instance Data a => Data (Product a) -fixityDataType :: DataType-fixityDataType = mkDataType "GHC.Generics.Fixity" [prefixConstr,infixConstr]+-- | @since 4.8.0.0+deriving instance Data a => Data (First a) -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+-- | @since 4.8.0.0+deriving instance Data a => Data (Last a) ------------------------------------------------------------------------+-- | @since 4.8.0.0+deriving instance (Data (f a), Data a, Typeable f) => Data (Alt f a) -leftAssociativeConstr :: Constr-leftAssociativeConstr-  = mkConstr associativityDataType "LeftAssociative" [] Prefix-rightAssociativeConstr :: Constr-rightAssociativeConstr-  = mkConstr associativityDataType "RightAssociative" [] Prefix-notAssociativeConstr :: Constr-notAssociativeConstr-  = mkConstr associativityDataType "NotAssociative" [] Prefix+----------------------------------------------------------------------------+-- Data instances for GHC.Generics representations -associativityDataType :: DataType-associativityDataType = mkDataType "GHC.Generics.Associativity"-  [leftAssociativeConstr,rightAssociativeConstr,notAssociativeConstr]+-- | @since 4.9.0.0+deriving instance Data p => Data (U1 p) -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+-- | @since 4.9.0.0+deriving instance Data p => Data (Par1 p) ------------------------------------------------------------------------+-- | @since 4.9.0.0+deriving instance (Data (f p), Typeable f, Data p) => Data (Rec1 f p) -noSourceUnpackednessConstr :: Constr-noSourceUnpackednessConstr-  = mkConstr sourceUnpackednessDataType "NoSourceUnpackedness" [] Prefix-sourceNoUnpackConstr :: Constr-sourceNoUnpackConstr-  = mkConstr sourceUnpackednessDataType "SourceNoUnpack" [] Prefix-sourceUnpackConstr :: Constr-sourceUnpackConstr-  = mkConstr sourceUnpackednessDataType "SourceUnpack" [] Prefix+-- | @since 4.9.0.0+deriving instance (Typeable i, Data p, Data c) => Data (K1 i c p) -sourceUnpackednessDataType :: DataType-sourceUnpackednessDataType = mkDataType "GHC.Generics.SourceUnpackedness"-  [noSourceUnpackednessConstr,sourceNoUnpackConstr,sourceUnpackConstr]+-- | @since 4.9.0.0+deriving instance (Data p, Data (f p), Typeable c, Typeable i, Typeable f)+    => Data (M1 i c f p) -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+-- | @since 4.9.0.0+deriving instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p))+    => Data ((f :+: g) p) ------------------------------------------------------------------------+-- | @since 4.9.0.0+deriving instance (Typeable (f :: * -> *), Typeable (g :: * -> *),+          Data p, Data (f (g p)))+    => Data ((f :.: g) p) -noSourceStrictnessConstr :: Constr-noSourceStrictnessConstr-  = mkConstr sourceStrictnessDataType "NoSourceStrictness" [] Prefix-sourceLazyConstr :: Constr-sourceLazyConstr-  = mkConstr sourceStrictnessDataType "SourceLazy" [] Prefix-sourceStrictConstr :: Constr-sourceStrictConstr-  = mkConstr sourceStrictnessDataType "SourceStrict" [] Prefix+-- | @since 4.9.0.0+deriving instance Data p => Data (V1 p) -sourceStrictnessDataType :: DataType-sourceStrictnessDataType = mkDataType "GHC.Generics.SourceStrictness"-  [noSourceStrictnessConstr,sourceLazyConstr,sourceStrictConstr]+-- | @since 4.9.0.0+deriving instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p))+    => Data ((f :*: g) p) -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+-- | @since 4.9.0.0+deriving instance Data Generics.Fixity ------------------------------------------------------------------------+-- | @since 4.9.0.0+deriving instance Data Associativity -decidedLazyConstr :: Constr-decidedLazyConstr-  = mkConstr decidedStrictnessDataType "DecidedLazy" [] Prefix-decidedStrictConstr :: Constr-decidedStrictConstr-  = mkConstr decidedStrictnessDataType "DecidedStrict" [] Prefix-decidedUnpackConstr :: Constr-decidedUnpackConstr-  = mkConstr decidedStrictnessDataType "DecidedUnpack" [] Prefix+-- | @since 4.9.0.0+deriving instance Data SourceUnpackedness -decidedStrictnessDataType :: DataType-decidedStrictnessDataType = mkDataType "GHC.Generics.DecidedStrictness"-  [decidedLazyConstr,decidedStrictConstr,decidedUnpackConstr]+-- | @since 4.9.0.0+deriving instance Data SourceStrictness -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+-- | @since 4.9.0.0+deriving instance Data DecidedStrictness

@@ -1,51 +1,55 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  ----------------------------------------------------------------------------- -- | -- Module      :  Data.Dynamic -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  experimental -- Portability :  portable -- -- The Dynamic interface provides basic support for dynamic types.--- +-- -- Operations for injecting values of arbitrary type into -- a dynamically typed value, Dynamic, are provided, together -- with operations for converting dynamic values into a concrete -- (monomorphic) type.--- +-- -----------------------------------------------------------------------------  module Data.Dynamic   ( -        -- Module Data.Typeable re-exported for convenience-        module Data.Typeable,-         -- * The @Dynamic@ type-        Dynamic,        -- abstract, instance of: Show, Typeable+        Dynamic(..),          -- * Converting to and from @Dynamic@         toDyn,         fromDyn,         fromDynamic,-        +         -- * Applying functions of dynamic type         dynApply,         dynApp,-        dynTypeRep+        dynTypeRep, +        -- * Convenience re-exports+        Typeable+   ) where  -import Data.Typeable+import Data.Type.Equality+import Type.Reflection import Data.Maybe-import Unsafe.Coerce  import GHC.Base import GHC.Show@@ -67,28 +71,30 @@   'Show'ing a value of type 'Dynamic' returns a pretty-printed representation   of the object\'s type; useful for debugging. -}-data Dynamic = Dynamic TypeRep Obj+data Dynamic where+    Dynamic :: forall a. TypeRep a -> a -> Dynamic +-- | @since 2.01 instance Show Dynamic where    -- the instance just prints the type representation.-   showsPrec _ (Dynamic t _) = -          showString "<<" . -          showsPrec 0 t   . +   showsPrec _ (Dynamic t _) =+          showString "<<" .+          showsPrec 0 t   .           showString ">>"  -- here so that it isn't an orphan:+-- | @since 4.0.0.0 instance Exception Dynamic -type Obj = Any  -- Use GHC's primitive 'Any' type to hold the dynamically typed value.  --  -- In GHC's new eval/apply execution model this type must not look- -- like a data type.  If it did, GHC would use the constructor convention - -- when evaluating it, and this will go wrong if the object is really a + -- like a data type.  If it did, GHC would use the constructor convention+ -- when evaluating it, and this will go wrong if the object is really a  -- function.  Using Any forces GHC to use  -- a fallback convention for evaluating it that works for all types. --- | Converts an arbitrary value into an object of type 'Dynamic'.  +-- | Converts an arbitrary value into an object of type 'Dynamic'. -- -- The type of the object must be an instance of 'Typeable', which -- ensures that only monomorphically-typed objects may be converted to@@ -98,47 +104,48 @@ -- >    toDyn (id :: Int -> Int) -- toDyn :: Typeable a => a -> Dynamic-toDyn v = Dynamic (typeOf v) (unsafeCoerce v)+toDyn v = Dynamic typeRep v  -- | Converts a 'Dynamic' object back into an ordinary Haskell value of -- the correct type.  See also 'fromDynamic'. fromDyn :: Typeable a         => Dynamic      -- ^ the dynamically-typed object-        -> a            -- ^ a default value +        -> a            -- ^ a default value         -> a            -- ^ returns: the value of the first argument, if                         -- it has the correct type, otherwise the value of                         -- the second argument. fromDyn (Dynamic t v) def-  | typeOf def == t = unsafeCoerce v-  | otherwise       = def+  | Just HRefl <- t `eqTypeRep` typeOf def = v+  | otherwise                              = def  -- | Converts a 'Dynamic' object back into an ordinary Haskell value of -- the correct type.  See also 'fromDyn'. fromDynamic-        :: Typeable a+        :: forall a. Typeable a         => Dynamic      -- ^ the dynamically-typed object         -> Maybe a      -- ^ returns: @'Just' a@, if the dynamically-typed-                        -- object has the correct type (and @a@ is its value), +                        -- object has the correct type (and @a@ is its value),                         -- or 'Nothing' otherwise.-fromDynamic (Dynamic t v) =-  case unsafeCoerce v of -    r | t == typeOf r -> Just r-      | otherwise     -> Nothing+fromDynamic (Dynamic t v)+  | Just HRefl <- t `eqTypeRep` rep = Just v+  | otherwise                       = Nothing+  where rep = typeRep :: TypeRep a  -- (f::(a->b)) `dynApply` (x::a) = (f a)::b dynApply :: Dynamic -> Dynamic -> Maybe Dynamic-dynApply (Dynamic t1 f) (Dynamic t2 x) =-  case funResultTy t1 t2 of-    Just t3 -> Just (Dynamic t3 ((unsafeCoerce f) x))-    Nothing -> Nothing+dynApply (Dynamic (Fun ta tr) f) (Dynamic ta' x)+  | Just HRefl <- ta `eqTypeRep` ta'+  , Just HRefl <- typeRep @Type `eqTypeRep` typeRepKind tr+  = Just (Dynamic tr (f x))+dynApply _ _+  = Nothing  dynApp :: Dynamic -> Dynamic -> Dynamic-dynApp f x = case dynApply f x of +dynApp f x = case dynApply f x of              Just r -> r              Nothing -> errorWithoutStackTrace ("Type error in dynamic application.\n" ++                                "Can't apply function " ++ show f ++                                " to argument " ++ show x) -dynTypeRep :: Dynamic -> TypeRep-dynTypeRep (Dynamic tr _) = tr -+dynTypeRep :: Dynamic -> SomeTypeRep+dynTypeRep (Dynamic tr _) = SomeTypeRep tr

@@ -24,6 +24,8 @@    rights,    isLeft,    isRight,+   fromLeft,+   fromRight,    partitionEithers,  ) where @@ -124,15 +126,18 @@ data  Either a b  =  Left a | Right b   deriving (Eq, Ord, Read, Show) +-- | @since 3.0 instance Functor (Either a) where     fmap _ (Left x) = Left x     fmap f (Right y) = Right (f y) +-- | @since 3.0 instance Applicative (Either e) where     pure          = Right     Left  e <*> _ = Left e     Right f <*> r = fmap f r +-- | @since 4.4.0.0 instance Monad (Either e) where     Left  l >>= _ = Left l     Right r >>= k = k r@@ -173,6 +178,7 @@ -- lefts   :: [Either a b] -> [a] lefts x = [a | Left a <- x]+{-# INLINEABLE lefts #-} -- otherwise doesnt get an unfolding, see #13689  -- | Extracts from a list of 'Either' all the 'Right' elements. -- All the 'Right' elements are extracted in order.@@ -187,6 +193,7 @@ -- rights   :: [Either a b] -> [b] rights x = [a | Right a <- x]+{-# INLINEABLE rights #-} -- otherwise doesnt get an unfolding, see #13689  -- | Partitions a list of 'Either' into two lists. -- All the 'Left' elements are extracted, in order, to the first@@ -276,6 +283,40 @@ isRight :: Either a b -> Bool isRight (Left  _) = False isRight (Right _) = True++-- | Return the contents of a 'Left'-value or a default value otherwise.+--+-- @since 4.10.0.0+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> fromLeft 1 (Left 3)+-- 3+-- >>> fromLeft 1 (Right "foo")+-- 1+--+fromLeft :: a -> Either a b -> a+fromLeft _ (Left a) = a+fromLeft a _        = a++-- | Return the contents of a 'Right'-value or a default value otherwise.+--+-- @since 4.10.0.0+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> fromRight 1 (Right 3)+-- 3+-- >>> fromRight 1 (Left "foo")+-- 1+--+fromRight :: b -> Either a b -> b+fromRight _ (Right b) = b+fromRight b _         = b  -- instance for the == Boolean type-level equality operator type family EqEither a b where

@@ -66,6 +66,8 @@ tyFixed = mkDataType "Data.Fixed.Fixed" [conMkFixed] conMkFixed :: Constr conMkFixed = mkConstr tyFixed "MkFixed" [] Prefix++-- | @since 4.1.0.0 instance (Typeable a) => Data (Fixed a) where     gfoldl k z (MkFixed a) = k (z MkFixed) a     gunfold k z _ = k (z MkFixed)@@ -81,6 +83,7 @@ withResolution :: (HasResolution a) => (Integer -> f a) -> f a withResolution foo = withType (foo . resolution) +-- | @since 2.01 instance Enum (Fixed a) where     succ (MkFixed a) = MkFixed (succ a)     pred (MkFixed a) = MkFixed (pred a)@@ -91,6 +94,7 @@     enumFromTo (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromTo a b)     enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c) +-- | @since 2.01 instance (HasResolution a) => Num (Fixed a) where     (MkFixed a) + (MkFixed b) = MkFixed (a + b)     (MkFixed a) - (MkFixed b) = MkFixed (a - b)@@ -100,15 +104,18 @@     signum (MkFixed a) = fromInteger (signum a)     fromInteger i = withResolution (\res -> MkFixed (i * res)) +-- | @since 2.01 instance (HasResolution a) => Real (Fixed a) where     toRational fa@(MkFixed a) = (toRational a) / (toRational (resolution fa)) +-- | @since 2.01 instance (HasResolution a) => Fractional (Fixed a) where     fa@(MkFixed a) / (MkFixed b) = MkFixed (div (a * (resolution fa)) b)     recip fa@(MkFixed a) = MkFixed (div (res * res) a) where         res = resolution fa     fromRational r = withResolution (\res -> MkFixed (floor (r * (toRational res)))) +-- | @since 2.01 instance (HasResolution a) => RealFrac (Fixed a) where     properFraction a = (i,a - (fromIntegral i)) where         i = truncate a@@ -146,9 +153,11 @@     fracNum = divCeil (d * maxnum) res     divCeil x y = (x + y - 1) `div` y +-- | @since 2.01 instance (HasResolution a) => Show (Fixed a) where     show = showFixed False +-- | @since 4.3.0.0 instance (HasResolution a) => Read (Fixed a) where     readPrec     = readNumber convertFixed     readListPrec = readListPrecDefault@@ -166,42 +175,56 @@ convertFixed _ = pfail  data E0++-- | @since 4.1.0.0 instance HasResolution E0 where     resolution _ = 1 -- | resolution of 1, this works the same as Integer type Uni = Fixed E0  data E1++-- | @since 4.1.0.0 instance HasResolution E1 where     resolution _ = 10 -- | resolution of 10^-1 = .1 type Deci = Fixed E1  data E2++-- | @since 4.1.0.0 instance HasResolution E2 where     resolution _ = 100 -- | resolution of 10^-2 = .01, useful for many monetary currencies type Centi = Fixed E2  data E3++-- | @since 4.1.0.0 instance HasResolution E3 where     resolution _ = 1000 -- | resolution of 10^-3 = .001 type Milli = Fixed E3  data E6++-- | @since 2.01 instance HasResolution E6 where     resolution _ = 1000000 -- | resolution of 10^-6 = .000001 type Micro = Fixed E6  data E9++-- | @since 4.1.0.0 instance HasResolution E9 where     resolution _ = 1000000000 -- | resolution of 10^-9 = .000000001 type Nano = Fixed E9  data E12++-- | @since 2.01 instance HasResolution E12 where     resolution _ = 1000000000000 -- | resolution of 10^-12 = .000000000001

@@ -21,23 +21,22 @@ -----------------------------------------------------------------------------  module Data.Foldable (-    -- * Folds     Foldable(..),-    -- ** Special biased folds+    -- * Special biased folds     foldrM,     foldlM,-    -- ** Folding actions-    -- *** Applicative actions+    -- * Folding actions+    -- ** Applicative actions     traverse_,     for_,     sequenceA_,     asum,-    -- *** Monadic actions+    -- ** Monadic actions     mapM_,     forM_,     sequence_,     msum,-    -- ** Specialized folds+    -- * Specialized folds     concat,     concatMap,     and,@@ -46,7 +45,7 @@     all,     maximumBy,     minimumBy,-    -- ** Searches+    -- * Searches     notElem,     find     ) where@@ -54,6 +53,7 @@ import Data.Bool import Data.Either import Data.Eq+import Data.Functor.Utils (Max(..), Min(..), (#.)) import qualified GHC.List as List import Data.Maybe import Data.Monoid@@ -268,13 +268,17 @@  -- instances for Prelude types +-- | @since 2.01 instance Foldable Maybe where+    foldMap = maybe mempty+     foldr _ z Nothing = z     foldr f z (Just x) = f x z      foldl _ z Nothing = z     foldl f z (Just x) = f z x +-- | @since 2.01 instance Foldable [] where     elem    = List.elem     foldl   = List.foldl@@ -290,6 +294,7 @@     sum     = List.sum     toList  = id +-- | @since 4.7.0.0 instance Foldable (Either a) where     foldMap _ (Left _) = mempty     foldMap f (Right y) = f y@@ -302,11 +307,13 @@      null             = isLeft +-- | @since 4.7.0.0 instance Foldable ((,) a) where     foldMap f (_, y) = f y      foldr f z (_, y) = f y z +-- | @since 4.8.0.0 instance Foldable (Array i) where     foldr = foldrElems     foldl = foldlElems@@ -318,6 +325,7 @@     length = numElements     null a = numElements a == 0 +-- | @since 4.7.0.0 instance Foldable Proxy where     foldMap _ _ = mempty     {-# INLINE foldMap #-}@@ -335,6 +343,7 @@     sum _      = 0     product _  = 1 +-- | @since 4.8.0.0 instance Foldable Dual where     foldMap            = coerce @@ -353,6 +362,7 @@     sum                = getDual     toList (Dual x)    = [x] +-- | @since 4.8.0.0 instance Foldable Sum where     foldMap            = coerce @@ -371,6 +381,7 @@     sum                = getSum     toList (Sum x)     = [x] +-- | @since 4.8.0.0 instance Foldable Product where     foldMap               = coerce @@ -389,42 +400,16 @@     sum                   = getProduct     toList (Product x)    = [x] +-- | @since 4.8.0.0 instance Foldable First where     foldMap f = foldMap f . getFirst +-- | @since 4.8.0.0 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--- instance. We may eventually want to add both versions, but we don't want to--- trample on anyone's toes by imposing Max = MaxMaybe.--newtype Max a = Max {getMax :: Maybe a}-newtype Min a = Min {getMin :: Maybe a}--instance Ord a => Monoid (Max a) where-  mempty = Max Nothing--  {-# INLINE mappend #-}-  m `mappend` Max Nothing = m-  Max Nothing `mappend` n = n-  (Max m@(Just x)) `mappend` (Max n@(Just y))-    | x >= y    = Max m-    | otherwise = Max n--instance Ord a => Monoid (Min a) where-  mempty = Min Nothing--  {-# INLINE mappend #-}-  m `mappend` Min Nothing = m-  Min Nothing `mappend` n = n-  (Min m@(Just x)) `mappend` (Min n@(Just y))-    | x <= y    = Min m-    | otherwise = Min n- -- Instances for GHC.Generics+-- | @since 4.9.0.0 instance Foldable U1 where     foldMap _ _ = mempty     {-# INLINE foldMap #-}@@ -566,16 +551,20 @@  -- | The largest element of a non-empty structure with respect to the -- given comparison function.++-- See Note [maximumBy/minimumBy space usage] maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a-maximumBy cmp = foldr1 max'+maximumBy cmp = foldl1 max'   where max' x y = case cmp x y of                         GT -> x                         _  -> y  -- | The least element of a non-empty structure with respect to the -- given comparison function.++-- See Note [maximumBy/minimumBy space usage] minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a-minimumBy cmp = foldr1 min'+minimumBy cmp = foldl1 min'   where min' x y = case cmp x y of                         GT -> y                         _  -> x@@ -590,34 +579,24 @@ find :: Foldable t => (a -> Bool) -> t a -> Maybe a find p = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing)) --- See Note [Function coercion]-(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)-(#.) _f = coerce-{-# INLINE (#.) #-}- {--Note [Function coercion]-~~~~~~~~~~~~~~~~~~~~~~~~--Several functions here use (#.) instead of (.) to avoid potential efficiency-problems relating to #7542. The problem, in a nutshell:--If N is a newtype constructor, then N x will always have the same-representation as x (something similar applies for a newtype deconstructor).-However, if f is a function,--N . f = \x -> N (f x)--This looks almost the same as f, but the eta expansion lifts it--the lhs could-be _|_, but the rhs never is. This can lead to very inefficient code.  Thus we-steal a technique from Shachaf and Edward Kmett and adapt it to the current-(rather clean) setting. Instead of using  N . f,  we use  N .## f, which is-just--coerce f `asTypeOf` (N . f)+Note [maximumBy/minimumBy space usage]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When the type signatures of maximumBy and minimumBy were generalized to work+over any Foldable instance (instead of just lists), they were defined using+foldr1. This was problematic for space usage, as the semantics of maximumBy+and minimumBy essentially require that they examine every element of the+data structure. Using foldr1 to examine every element results in space usage+proportional to the size of the data structure. For the common case of lists,+this could be particularly bad (see Trac #10830). -That is, we just *pretend* that f has the right type, and thanks to the safety-of coerce, the type checker guarantees that nothing really goes wrong. We still-have to be a bit careful, though: remember that #. completely ignores the-*value* of its left operand.+For the common case of lists, switching the implementations of maximumBy and+minimumBy to foldl1 solves the issue, as GHC's strictness analysis can then+make these functions only use O(1) stack space. It is perhaps not the optimal+way to fix this problem, as there are other conceivable data structures+(besides lists) which might benefit from specialized implementations for+maximumBy and minimumBy (see+https://ghc.haskell.org/trac/ghc/ticket/10830#comment:26 for a further+discussion). But using foldl1 is at least always better than using foldr1, so+GHC has chosen to adopt that approach for now. -}

@@ -27,7 +27,7 @@  -- $setup -- Allow the use of Prelude in doctests.--- >>> import Prelude+-- >>> import Prelude hiding ((<$>))  infixl 4 <$> 

@@ -26,7 +26,9 @@ -- -- > 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 (Read1 f, Read a) => Read (T f a) where+-- >   readPrec     = readPrec1+-- >   readListPrec = readListPrecDefault -- > instance (Show1 f, Show a) => Show (T f a) where showsPrec = showsPrec1 -- -- @since 4.9.0.0@@ -37,18 +39,20 @@     -- ** For unary constructors     Eq1(..), eq1,     Ord1(..), compare1,-    Read1(..), readsPrec1,+    Read1(..), readsPrec1, readPrec1,+    liftReadListDefault, liftReadListPrecDefault,     Show1(..), showsPrec1,     -- ** For binary constructors     Eq2(..), eq2,     Ord2(..), compare2,-    Read2(..), readsPrec2,+    Read2(..), readsPrec2, readPrec2,+    liftReadList2Default, liftReadListPrec2Default,     Show2(..), showsPrec2,     -- * Helper functions     -- $example-    readsData,-    readsUnaryWith,-    readsBinaryWith,+    readsData, readData,+    readsUnaryWith, readUnaryWith,+    readsBinaryWith, readBinaryWith,     showsUnaryWith,     showsBinaryWith,     -- ** Obsolete helpers@@ -60,13 +64,22 @@     showsBinary1,   ) where -import Control.Applicative (Const(Const))+import Control.Applicative (Alternative((<|>)), Const(Const))+ import Data.Functor.Identity (Identity(Identity)) import Data.Proxy (Proxy(Proxy)) import Data.Monoid (mappend)++import GHC.Read (expectP, list, paren)++import Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec)+import Text.Read (Read(..), parens, prec, step)+import Text.Read.Lex (Lexeme(..)) import Text.Show (showListWith)  -- | Lifting of the 'Eq' class to unary type constructors.+--+-- @since 4.9.0.0 class Eq1 f where     -- | Lift an equality test through the type constructor.     --@@ -74,13 +87,19 @@     -- but the more general type ensures that the implementation uses     -- it to compare elements of the first container with elements of     -- the second.+    --+    -- @since 4.9.0.0     liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool  -- | Lift the standard @('==')@ function through the type constructor.+--+-- @since 4.9.0.0 eq1 :: (Eq1 f, Eq a) => f a -> f a -> Bool eq1 = liftEq (==)  -- | Lifting of the 'Ord' class to unary type constructors.+--+-- @since 4.9.0.0 class (Eq1 f) => Ord1 f where     -- | Lift a 'compare' function through the type constructor.     --@@ -88,45 +107,112 @@     -- but the more general type ensures that the implementation uses     -- it to compare elements of the first container with elements of     -- the second.+    --+    -- @since 4.9.0.0     liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering  -- | Lift the standard 'compare' function through the type constructor.+--+-- @since 4.9.0.0 compare1 :: (Ord1 f, Ord a) => f a -> f a -> Ordering compare1 = liftCompare compare  -- | Lifting of the 'Read' class to unary type constructors.+--+-- Both 'liftReadsPrec' and 'liftReadPrec' exist to match the interface+-- provided in the 'Read' type class, but it is recommended to implement+-- 'Read1' instances using 'liftReadPrec' as opposed to 'liftReadsPrec', since+-- the former is more efficient than the latter. For example:+--+-- @+-- instance 'Read1' T where+--   'liftReadPrec'     = ...+--   'liftReadListPrec' = 'liftReadListPrecDefault'+-- @+--+-- For more information, refer to the documentation for the 'Read' class.+--+-- @since 4.9.0.0 class Read1 f where+    {-# MINIMAL liftReadsPrec | liftReadPrec #-}+     -- | 'readsPrec' function for an application of the type constructor     -- based on 'readsPrec' and 'readList' functions for the argument type.+    --+    -- @since 4.9.0.0     liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)+    liftReadsPrec rp rl = readPrec_to_S $+        liftReadPrec (readS_to_Prec rp) (readS_to_Prec (const rl))      -- | '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.+    --+    -- @since 4.9.0.0     liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]-    liftReadList rp rl = readListWith (liftReadsPrec rp rl 0)+    liftReadList rp rl = readPrec_to_S+        (list $ liftReadPrec (readS_to_Prec rp) (readS_to_Prec (const 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]+    -- | 'readPrec' function for an application of the type constructor+    -- based on 'readPrec' and 'readListPrec' functions for the argument type.+    --+    -- @since 4.10.0.0+    liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)+    liftReadPrec rp rl = readS_to_Prec $+        liftReadsPrec (readPrec_to_S rp) (readPrec_to_S rl 0) +    -- | 'readListPrec' function for an application of the type constructor+    -- based on 'readPrec' and 'readListPrec' functions for the argument type.+    --+    -- The default definition uses 'liftReadList'. Instances that define+    -- 'liftReadPrec' should also define 'liftReadListPrec' as+    -- 'liftReadListPrecDefault'.+    --+    -- @since 4.10.0.0+    liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]+    liftReadListPrec rp rl = readS_to_Prec $ \_ ->+        liftReadList (readPrec_to_S rp) (readPrec_to_S rl 0)+ -- | Lift the standard 'readsPrec' and 'readList' functions through the -- type constructor.+--+-- @since 4.9.0.0 readsPrec1 :: (Read1 f, Read a) => Int -> ReadS (f a) readsPrec1 = liftReadsPrec readsPrec readList +-- | Lift the standard 'readPrec' and 'readListPrec' functions through the+-- type constructor.+--+-- @since 4.10.0.0+readPrec1 :: (Read1 f, Read a) => ReadPrec (f a)+readPrec1 = liftReadPrec readPrec readListPrec++-- | A possible replacement definition for the 'liftReadList' method.+-- This is only needed for 'Read1' instances where 'liftReadListPrec' isn't+-- defined as 'liftReadListPrecDefault'.+--+-- @since 4.10.0.0+liftReadListDefault :: Read1 f => (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]+liftReadListDefault rp rl = readPrec_to_S+    (liftReadListPrec (readS_to_Prec rp) (readS_to_Prec (const rl))) 0++-- | A possible replacement definition for the 'liftReadListPrec' method,+-- defined using 'liftReadPrec'.+--+-- @since 4.10.0.0+liftReadListPrecDefault :: Read1 f => ReadPrec a -> ReadPrec [a]+                        -> ReadPrec [f a]+liftReadListPrecDefault rp rl = list (liftReadPrec rp rl)+ -- | Lifting of the 'Show' class to unary type constructors.+--+-- @since 4.9.0.0 class Show1 f where     -- | 'showsPrec' function for an application of the type constructor     -- based on 'showsPrec' and 'showList' functions for the argument type.+    --+    -- @since 4.9.0.0     liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->         Int -> f a -> ShowS @@ -134,16 +220,22 @@     -- based on 'showsPrec' and 'showList' functions for the argument type.     -- The default implementation using standard list syntax is correct     -- for most types.+    --+    -- @since 4.9.0.0     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.+--+-- @since 4.9.0.0 showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS showsPrec1 = liftShowsPrec showsPrec showList  -- | Lifting of the 'Eq' class to binary type constructors.+--+-- @since 4.9.0.0 class Eq2 f where     -- | Lift equality tests through the type constructor.     --@@ -151,13 +243,19 @@     -- but the more general type ensures that the implementation uses     -- them to compare elements of the first container with elements of     -- the second.+    --+    -- @since 4.9.0.0     liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool  -- | Lift the standard @('==')@ function through the type constructor.+--+-- @since 4.9.0.0 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.+--+-- @since 4.9.0.0 class (Eq2 f) => Ord2 f where     -- | Lift 'compare' functions through the type constructor.     --@@ -165,37 +263,120 @@     -- but the more general type ensures that the implementation uses     -- them to compare elements of the first container with elements of     -- the second.+    --+    -- @since 4.9.0.0     liftCompare2 :: (a -> b -> Ordering) -> (c -> d -> Ordering) ->         f a c -> f b d -> Ordering  -- | Lift the standard 'compare' function through the type constructor.+--+-- @since 4.9.0.0 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.+--+-- Both 'liftReadsPrec2' and 'liftReadPrec2' exist to match the interface+-- provided in the 'Read' type class, but it is recommended to implement+-- 'Read2' instances using 'liftReadPrec2' as opposed to 'liftReadsPrec2',+-- since the former is more efficient than the latter. For example:+--+-- @+-- instance 'Read2' T where+--   'liftReadPrec2'     = ...+--   'liftReadListPrec2' = 'liftReadListPrec2Default'+-- @+--+-- For more information, refer to the documentation for the 'Read' class.+-- @since 4.9.0.0 class Read2 f where+    {-# MINIMAL liftReadsPrec2 | liftReadPrec2 #-}+     -- | 'readsPrec' function for an application of the type constructor     -- based on 'readsPrec' and 'readList' functions for the argument types.+    --+    -- @since 4.9.0.0     liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] ->         (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f a b)+    liftReadsPrec2 rp1 rl1 rp2 rl2 = readPrec_to_S $+        liftReadPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))+                      (readS_to_Prec rp2) (readS_to_Prec (const rl2))      -- | '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.+    --+    -- @since 4.9.0.0     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)+    liftReadList2 rp1 rl1 rp2 rl2 = readPrec_to_S+       (list $ liftReadPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))+                             (readS_to_Prec rp2) (readS_to_Prec (const rl2))) 0 +    -- | 'readPrec' function for an application of the type constructor+    -- based on 'readPrec' and 'readListPrec' functions for the argument types.+    --+    -- @since 4.10.0.0+    liftReadPrec2 :: ReadPrec a -> ReadPrec [a] ->+        ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)+    liftReadPrec2 rp1 rl1 rp2 rl2 = readS_to_Prec $+        liftReadsPrec2 (readPrec_to_S rp1) (readPrec_to_S rl1 0)+                       (readPrec_to_S rp2) (readPrec_to_S rl2 0)++    -- | 'readListPrec' function for an application of the type constructor+    -- based on 'readPrec' and 'readListPrec' functions for the argument types.+    --+    -- The default definition uses 'liftReadList2'. Instances that define+    -- 'liftReadPrec2' should also define 'liftReadListPrec2' as+    -- 'liftReadListPrec2Default'.+    --+    -- @since 4.10.0.0+    liftReadListPrec2 :: ReadPrec a -> ReadPrec [a] ->+        ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]+    liftReadListPrec2 rp1 rl1 rp2 rl2 = readS_to_Prec $ \_ ->+        liftReadList2 (readPrec_to_S rp1) (readPrec_to_S rl1 0)+                      (readPrec_to_S rp2) (readPrec_to_S rl2 0)+ -- | Lift the standard 'readsPrec' function through the type constructor.+--+-- @since 4.9.0.0 readsPrec2 :: (Read2 f, Read a, Read b) => Int -> ReadS (f a b) readsPrec2 = liftReadsPrec2 readsPrec readList readsPrec readList +-- | Lift the standard 'readPrec' function through the type constructor.+--+-- @since 4.10.0.0+readPrec2 :: (Read2 f, Read a, Read b) => ReadPrec (f a b)+readPrec2 = liftReadPrec2 readPrec readListPrec readPrec readListPrec++-- | A possible replacement definition for the 'liftReadList2' method.+-- This is only needed for 'Read2' instances where 'liftReadListPrec2' isn't+-- defined as 'liftReadListPrec2Default'.+--+-- @since 4.10.0.0+liftReadList2Default :: Read2 f => (Int -> ReadS a) -> ReadS [a] ->+    (Int -> ReadS b) -> ReadS [b] ->ReadS [f a b]+liftReadList2Default rp1 rl1 rp2 rl2 = readPrec_to_S+    (liftReadListPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))+                       (readS_to_Prec rp2) (readS_to_Prec (const rl2))) 0++-- | A possible replacement definition for the 'liftReadListPrec2' method,+-- defined using 'liftReadPrec2'.+--+-- @since 4.10.0.0+liftReadListPrec2Default :: Read2 f => ReadPrec a -> ReadPrec [a] ->+    ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]+liftReadListPrec2Default rp1 rl1 rp2 rl2 = list (liftReadPrec2 rp1 rl1 rp2 rl2)+ -- | Lifting of the 'Show' class to binary type constructors.+--+-- @since 4.9.0.0 class Show2 f where     -- | 'showsPrec' function for an application of the type constructor     -- based on 'showsPrec' and 'showList' functions for the argument types.+    --+    -- @since 4.9.0.0     liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->         (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f a b -> ShowS @@ -203,155 +384,220 @@     -- based on 'showsPrec' and 'showList' functions for the argument types.     -- The default implementation using standard list syntax is correct     -- for most types.+    --+    -- @since 4.9.0.0     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.+--+-- @since 4.9.0.0 showsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS showsPrec2 = liftShowsPrec2 showsPrec showList showsPrec showList  -- Instances for Prelude type constructors +-- | @since 4.9.0.0 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 +-- | @since 4.9.0.0 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 +-- | @since 4.9.0.0 instance Read1 Maybe where-    liftReadsPrec rp _ d =-         readParen False (\ r -> [(Nothing,s) | ("Nothing",s) <- lex r])-         `mappend`-         readsData (readsUnaryWith rp "Just" Just) d+    liftReadPrec rp _ =+        parens (expectP (Ident "Nothing") *> pure Nothing)+        <|>+        readData (readUnaryWith rp "Just" Just) +    liftReadListPrec = liftReadListPrecDefault+    liftReadList     = liftReadListDefault++-- | @since 4.9.0.0 instance Show1 Maybe where     liftShowsPrec _ _ _ Nothing = showString "Nothing"     liftShowsPrec sp _ d (Just x) = showsUnaryWith sp "Just" d x +-- | @since 4.9.0.0 instance Eq1 [] where     liftEq _ [] [] = True     liftEq _ [] (_:_) = False     liftEq _ (_:_) [] = False     liftEq eq (x:xs) (y:ys) = eq x y && liftEq eq xs ys +-- | @since 4.9.0.0 instance Ord1 [] where     liftCompare _ [] [] = EQ     liftCompare _ [] (_:_) = LT     liftCompare _ (_:_) [] = GT     liftCompare comp (x:xs) (y:ys) = comp x y `mappend` liftCompare comp xs ys +-- | @since 4.9.0.0 instance Read1 [] where-    liftReadsPrec _ rl _ = rl+    liftReadPrec _ rl = rl+    liftReadListPrec  = liftReadListPrecDefault+    liftReadList      = liftReadListDefault +-- | @since 4.9.0.0 instance Show1 [] where     liftShowsPrec _ sl _ = sl +-- | @since 4.9.0.0 instance Eq2 (,) where     liftEq2 e1 e2 (x1, y1) (x2, y2) = e1 x1 x2 && e2 y1 y2 +-- | @since 4.9.0.0 instance Ord2 (,) where     liftCompare2 comp1 comp2 (x1, y1) (x2, y2) =         comp1 x1 x2 `mappend` comp2 y1 y2 +-- | @since 4.9.0.0 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]+    liftReadPrec2 rp1 _ rp2 _ = parens $ paren $ do+        x <- rp1+        expectP (Punc ",")+        y <- rp2+        return (x,y) +    liftReadListPrec2 = liftReadListPrec2Default+    liftReadList2     = liftReadList2Default++-- | @since 4.9.0.0 instance Show2 (,) where     liftShowsPrec2 sp1 _ sp2 _ _ (x, y) =         showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')' +-- | @since 4.9.0.0 instance (Eq a) => Eq1 ((,) a) where     liftEq = liftEq2 (==) +-- | @since 4.9.0.0 instance (Ord a) => Ord1 ((,) a) where     liftCompare = liftCompare2 compare +-- | @since 4.9.0.0 instance (Read a) => Read1 ((,) a) where-    liftReadsPrec = liftReadsPrec2 readsPrec readList+    liftReadPrec = liftReadPrec2 readPrec readListPrec +    liftReadListPrec = liftReadListPrecDefault+    liftReadList     = liftReadListDefault++-- | @since 4.9.0.0 instance (Show a) => Show1 ((,) a) where     liftShowsPrec = liftShowsPrec2 showsPrec showList +-- | @since 4.9.0.0 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 +-- | @since 4.9.0.0 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 +-- | @since 4.9.0.0 instance Read2 Either where-    liftReadsPrec2 rp1 _ rp2 _ = readsData $-         readsUnaryWith rp1 "Left" Left `mappend`-         readsUnaryWith rp2 "Right" Right+    liftReadPrec2 rp1 _ rp2 _ = readData $+         readUnaryWith rp1 "Left" Left <|>+         readUnaryWith rp2 "Right" Right +    liftReadListPrec2 = liftReadListPrec2Default+    liftReadList2     = liftReadList2Default++-- | @since 4.9.0.0 instance Show2 Either where     liftShowsPrec2 sp1 _ _ _ d (Left x) = showsUnaryWith sp1 "Left" d x     liftShowsPrec2 _ _ sp2 _ d (Right x) = showsUnaryWith sp2 "Right" d x +-- | @since 4.9.0.0 instance (Eq a) => Eq1 (Either a) where     liftEq = liftEq2 (==) +-- | @since 4.9.0.0 instance (Ord a) => Ord1 (Either a) where     liftCompare = liftCompare2 compare +-- | @since 4.9.0.0 instance (Read a) => Read1 (Either a) where-    liftReadsPrec = liftReadsPrec2 readsPrec readList+    liftReadPrec = liftReadPrec2 readPrec readListPrec +    liftReadListPrec = liftReadListPrecDefault+    liftReadList     = liftReadListDefault++-- | @since 4.9.0.0 instance (Show a) => Show1 (Either a) where     liftShowsPrec = liftShowsPrec2 showsPrec showList  -- Instances for other functors defined in the base package +-- | @since 4.9.0.0 instance Eq1 Identity where     liftEq eq (Identity x) (Identity y) = eq x y +-- | @since 4.9.0.0 instance Ord1 Identity where     liftCompare comp (Identity x) (Identity y) = comp x y +-- | @since 4.9.0.0 instance Read1 Identity where-    liftReadsPrec rp _ = readsData $-         readsUnaryWith rp "Identity" Identity+    liftReadPrec rp _ = readData $+         readUnaryWith rp "Identity" Identity +    liftReadListPrec = liftReadListPrecDefault+    liftReadList     = liftReadListDefault++-- | @since 4.9.0.0 instance Show1 Identity where     liftShowsPrec sp _ d (Identity x) = showsUnaryWith sp "Identity" d x +-- | @since 4.9.0.0 instance Eq2 Const where     liftEq2 eq _ (Const x) (Const y) = eq x y +-- | @since 4.9.0.0 instance Ord2 Const where     liftCompare2 comp _ (Const x) (Const y) = comp x y +-- | @since 4.9.0.0 instance Read2 Const where-    liftReadsPrec2 rp _ _ _ = readsData $-         readsUnaryWith rp "Const" Const+    liftReadPrec2 rp _ _ _ = readData $+         readUnaryWith rp "Const" Const +    liftReadListPrec2 = liftReadListPrec2Default+    liftReadList2     = liftReadList2Default++-- | @since 4.9.0.0 instance Show2 Const where     liftShowsPrec2 sp _ _ _ d (Const x) = showsUnaryWith sp "Const" d x +-- | @since 4.9.0.0 instance (Eq a) => Eq1 (Const a) where     liftEq = liftEq2 (==)+-- | @since 4.9.0.0 instance (Ord a) => Ord1 (Const a) where     liftCompare = liftCompare2 compare+-- | @since 4.9.0.0 instance (Read a) => Read1 (Const a) where-    liftReadsPrec = liftReadsPrec2 readsPrec readList+    liftReadPrec = liftReadPrec2 readPrec readListPrec++    liftReadListPrec = liftReadListPrecDefault+    liftReadList     = liftReadListDefault+-- | @since 4.9.0.0 instance (Show a) => Show1 (Const a) where     liftShowsPrec = liftShowsPrec2 showsPrec showList @@ -371,9 +617,11 @@  -- | @since 4.9.0.0 instance Read1 Proxy where-  liftReadsPrec _ _ d =-    readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ])+  liftReadPrec _ _ = parens (expectP (Ident "Proxy") *> pure Proxy) +  liftReadListPrec = liftReadListPrecDefault+  liftReadList     = liftReadListDefault+ -- Building blocks  -- | @'readsData' p d@ is a parser for datatypes where each alternative@@ -381,27 +629,68 @@ -- passes it to @p@.  Parsers for various constructors can be constructed -- with 'readsUnary', 'readsUnary1' and 'readsBinary1', and combined with -- @mappend@ from the @Monoid@ class.+--+-- @since 4.9.0.0 readsData :: (String -> ReadS a) -> Int -> ReadS a readsData reader d =     readParen (d > 10) $ \ r -> [res | (kw,s) <- lex r, res <- reader kw s] +-- | @'readData' p@ 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 'readUnaryWith' and 'readBinaryWith', and combined with+-- '(<|>)' from the 'Alternative' class.+--+-- @since 4.10.0.0+readData :: ReadPrec a -> ReadPrec a+readData reader = parens $ prec 10 reader+ -- | @'readsUnaryWith' rp n c n'@ matches the name of a unary data constructor -- and then parses its argument using @rp@.+--+-- @since 4.9.0.0 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] +-- | @'readUnaryWith' rp n c'@ matches the name of a unary data constructor+-- and then parses its argument using @rp@.+--+-- @since 4.10.0.0+readUnaryWith :: ReadPrec a -> String -> (a -> t) -> ReadPrec t+readUnaryWith rp name cons = do+    expectP $ Ident name+    x <- step rp+    return $ cons x+ -- | @'readsBinaryWith' rp1 rp2 n c n'@ matches the name of a binary -- data constructor and then parses its arguments using @rp1@ and @rp2@ -- respectively.+--+-- @since 4.9.0.0 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] +-- | @'readBinaryWith' rp1 rp2 n c'@ matches the name of a binary+-- data constructor and then parses its arguments using @rp1@ and @rp2@+-- respectively.+--+-- @since 4.10.0.0+readBinaryWith :: ReadPrec a -> ReadPrec b ->+    String -> (a -> b -> t) -> ReadPrec t+readBinaryWith rp1 rp2 name cons = do+    expectP $ Ident name+    x <- step rp1+    y <- step rp2+    return $ cons x y+ -- | @'showsUnaryWith' sp n d x@ produces the string representation of a -- unary data constructor with name @n@ and argument @x@, in precedence -- context @d@.+--+-- @since 4.9.0.0 showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS showsUnaryWith sp name d x = showParen (d > 10) $     showString name . showChar ' ' . sp 11 x@@ -409,6 +698,8 @@ -- | @'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@.+--+-- @since 4.9.0.0 showsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) ->     String -> Int -> a -> b -> ShowS showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $@@ -418,6 +709,8 @@  -- | @'readsUnary' n c n'@ matches the name of a unary data constructor -- and then parses its argument using 'readsPrec'.+--+-- @since 4.9.0.0 {-# DEPRECATED readsUnary "Use readsUnaryWith to define liftReadsPrec" #-} readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t readsUnary name cons kw s =@@ -425,6 +718,8 @@  -- | @'readsUnary1' n c n'@ matches the name of a unary data constructor -- and then parses its argument using 'readsPrec1'.+--+-- @since 4.9.0.0 {-# DEPRECATED readsUnary1 "Use readsUnaryWith to define liftReadsPrec" #-} readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t readsUnary1 name cons kw s =@@ -432,6 +727,8 @@  -- | @'readsBinary1' n c n'@ matches the name of a binary data constructor -- and then parses its arguments using 'readsPrec1'.+--+-- @since 4.9.0.0 {-# DEPRECATED readsBinary1 "Use readsBinaryWith to define liftReadsPrec" #-} readsBinary1 :: (Read1 f, Read1 g, Read a) =>     String -> (f a -> g a -> t) -> String -> ReadS t@@ -441,6 +738,8 @@  -- | @'showsUnary' n d x@ produces the string representation of a unary data -- constructor with name @n@ and argument @x@, in precedence context @d@.+--+-- @since 4.9.0.0 {-# DEPRECATED showsUnary "Use showsUnaryWith to define liftShowsPrec" #-} showsUnary :: (Show a) => String -> Int -> a -> ShowS showsUnary name d x = showParen (d > 10) $@@ -448,6 +747,8 @@  -- | @'showsUnary1' n d x@ produces the string representation of a unary data -- constructor with name @n@ and argument @x@, in precedence context @d@.+--+-- @since 4.9.0.0 {-# DEPRECATED showsUnary1 "Use showsUnaryWith to define liftShowsPrec" #-} showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS showsUnary1 name d x = showParen (d > 10) $@@ -456,6 +757,8 @@ -- | @'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@.+--+-- @since 4.9.0.0 {-# DEPRECATED showsBinary1 "Use showsBinaryWith to define liftShowsPrec" #-} showsBinary1 :: (Show1 f, Show1 g, Show a) =>     String -> Int -> f a -> g a -> ShowS@@ -472,10 +775,11 @@ 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+>     liftReadPrec rp rl = readData $+>         readUnaryWith rp "Zero" Zero <|>+>         readUnaryWith (liftReadPrec rp rl) "One" One <|>+>         readBinaryWith rp (liftReadPrec rp rl) "Two" Two+>     liftReadListPrec = liftReadListPrecDefault  and the corresponding 'Show1' instance as 

@@ -1,7 +1,8 @@+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PolyKinds #-}-{-# LANGUAGE Safe #-}+{-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Functor.Compose@@ -24,10 +25,12 @@ import Data.Functor.Classes  import Control.Applicative+import Data.Coerce (coerce) import Data.Data (Data) import Data.Foldable (Foldable(foldMap)) import Data.Traversable (Traversable(traverse)) import GHC.Generics (Generic, Generic1)+import Text.Read (Read(..), readListDefault, readListPrecDefault)  infixr 9 `Compose` @@ -39,20 +42,27 @@  -- Instances of lifted Prelude classes +-- | @since 4.9.0.0 instance (Eq1 f, Eq1 g) => Eq1 (Compose f g) where     liftEq eq (Compose x) (Compose y) = liftEq (liftEq eq) x y +-- | @since 4.9.0.0 instance (Ord1 f, Ord1 g) => Ord1 (Compose f g) where     liftCompare comp (Compose x) (Compose y) =         liftCompare (liftCompare comp) x y +-- | @since 4.9.0.0 instance (Read1 f, Read1 g) => Read1 (Compose f g) where-    liftReadsPrec rp rl = readsData $-        readsUnaryWith (liftReadsPrec rp' rl') "Compose" Compose+    liftReadPrec rp rl = readData $+        readUnaryWith (liftReadPrec rp' rl') "Compose" Compose       where-        rp' = liftReadsPrec rp rl-        rl' = liftReadList rp rl+        rp' = liftReadPrec     rp rl+        rl' = liftReadListPrec rp rl +    liftReadListPrec = liftReadListPrecDefault+    liftReadList     = liftReadListDefault++-- | @since 4.9.0.0 instance (Show1 f, Show1 g) => Show1 (Compose f g) where     liftShowsPrec sp sl d (Compose x) =         showsUnaryWith (liftShowsPrec sp' sl') "Compose" d x@@ -62,33 +72,48 @@  -- Instances of Prelude classes +-- | @since 4.9.0.0 instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where     (==) = eq1 +-- | @since 4.9.0.0 instance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where     compare = compare1 +-- | @since 4.9.0.0 instance (Read1 f, Read1 g, Read a) => Read (Compose f g a) where-    readsPrec = readsPrec1+    readPrec = readPrec1 +    readListPrec = readListPrecDefault+    readList     = readListDefault++-- | @since 4.9.0.0 instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where     showsPrec = showsPrec1  -- Functor instances +-- | @since 4.9.0.0 instance (Functor f, Functor g) => Functor (Compose f g) where     fmap f (Compose x) = Compose (fmap (fmap f) x) +-- | @since 4.9.0.0 instance (Foldable f, Foldable g) => Foldable (Compose f g) where     foldMap f (Compose t) = foldMap (foldMap f) t +-- | @since 4.9.0.0 instance (Traversable f, Traversable g) => Traversable (Compose f g) where     traverse f (Compose t) = Compose <$> traverse (traverse f) t +-- | @since 4.9.0.0 instance (Applicative f, Applicative g) => Applicative (Compose f g) where     pure x = Compose (pure (pure x))-    Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)+    Compose f <*> Compose x = Compose (liftA2 (<*>) f x)+    liftA2 f (Compose x) (Compose y) =+      Compose (liftA2 (liftA2 f) x y) +-- | @since 4.9.0.0 instance (Alternative f, Applicative g) => Alternative (Compose f g) where     empty = Compose empty-    Compose x <|> Compose y = Compose (x <|> y)+    (<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a))+      :: forall a . Compose f g a -> Compose f g a -> Compose f g a

@@ -43,24 +43,32 @@  -- | This instance would be equivalent to the derived instances of the -- 'Const' newtype if the 'runConst' field were removed+--+-- @since 4.8.0.0 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+--+-- @since 4.8.0.0 instance Show a => Show (Const a b) where     showsPrec d (Const x) = showParen (d > 10) $                             showString "Const " . showsPrec 11 x +-- | @since 4.7.0.0 instance Foldable (Const m) where     foldMap _ _ = mempty +-- | @since 2.01 instance Functor (Const m) where     fmap _ (Const v) = Const v +-- | @since 2.0.1 instance Monoid m => Applicative (Const m) where     pure _ = Const mempty+    liftA2 _ (Const x) (Const y) = Const (x `mappend` y)     (<*>) = coerce (mappend :: m -> m -> m) -- This is pretty much the same as -- Const f <*> Const v = Const (f `mappend` v)

@@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Trustworthy #-}  -----------------------------------------------------------------------------@@ -35,33 +36,43 @@   ) where  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 Data.Functor.Utils ((#.)) import Foreign.Storable (Storable)+import GHC.Arr (Ix)+import GHC.Base ( Applicative(..), Eq(..), Functor(..), Monad(..)+                , Monoid, Ord(..), ($), (.) )+import GHC.Enum (Bounded, Enum)+import GHC.Float (Floating, RealFloat) import GHC.Generics (Generic, Generic1)+import GHC.Num (Num)+import GHC.Read (Read(..), lex, readParen)+import GHC.Real (Fractional, Integral, Real, RealFrac)+import GHC.Show (Show(..), showParen, showString)+import GHC.Types (Bool(..))  -- | Identity functor and monad. (a non-strict monad) -- -- @since 4.8.0.0 newtype Identity a = Identity { runIdentity :: a }-    deriving ( Bits, Bounded, Data, Enum, Eq, FiniteBits, Floating, Fractional-             , Generic, Generic1, Integral, IsString, Ix, Monoid, Num, Ord-             , Real, RealFrac, RealFloat , Semigroup, Storable, Traversable)+    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 -- 'Identity' newtype if the 'runIdentity' field were removed+--+-- @since 4.8.0.0 instance (Read a) => Read (Identity a) where     readsPrec d = readParen (d > 10) $ \ r ->         [(Identity x,t) | ("Identity",s) <- lex r, (x,t) <- readsPrec 11 s]  -- | This instance would be equivalent to the derived instances of the -- 'Identity' newtype if the 'runIdentity' field were removed+--+-- @since 4.8.0.0 instance (Show a) => Show (Identity a) where     showsPrec d (Identity x) = showParen (d > 10) $         showString "Identity " . showsPrec 11 x@@ -69,6 +80,7 @@ -- --------------------------------------------------------------------------- -- Identity instances for Functor and Monad +-- | @since 4.8.0.0 instance Foldable Identity where     foldMap                = coerce @@ -87,25 +99,20 @@     sum                    = runIdentity     toList (Identity x)    = [x] +-- | @since 4.8.0.0 instance Functor Identity where     fmap     = coerce +-- | @since 4.8.0.0 instance Applicative Identity where     pure     = Identity     (<*>)    = coerce+    liftA2   = coerce +-- | @since 4.8.0.0 instance Monad Identity where     m >>= k  = k (runIdentity m) +-- | @since 4.8.0.0 instance MonadFix Identity where     mfix f   = Identity (fix (runIdentity . f))--instance MonadZip Identity where-    mzipWith = coerce-    munzip   = coerce---- | Internal (non-exported) 'Coercible' helper for 'elem'------ See Note [Function coercion] in "Data.Foldable" for more details.-(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c-(#.) _f = coerce

@@ -31,67 +31,95 @@ import Data.Monoid (mappend) import Data.Traversable (Traversable(traverse)) import GHC.Generics (Generic, Generic1)+import Text.Read (Read(..), readListDefault, readListPrecDefault)  -- | Lifted product of functors. data Product f g a = Pair (f a) (g a)   deriving (Data, Generic, Generic1) +-- | @since 4.9.0.0 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 +-- | @since 4.9.0.0 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 +-- | @since 4.9.0.0 instance (Read1 f, Read1 g) => Read1 (Product f g) where-    liftReadsPrec rp rl = readsData $-        readsBinaryWith (liftReadsPrec rp rl) (liftReadsPrec rp rl) "Pair" Pair+    liftReadPrec rp rl = readData $+        readBinaryWith (liftReadPrec rp rl) (liftReadPrec rp rl) "Pair" Pair +    liftReadListPrec = liftReadListPrecDefault+    liftReadList     = liftReadListDefault++-- | @since 4.9.0.0 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 +-- | @since 4.9.0.0 instance (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a)     where (==) = eq1++-- | @since 4.9.0.0 instance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where     compare = compare1++-- | @since 4.9.0.0 instance (Read1 f, Read1 g, Read a) => Read (Product f g a) where-    readsPrec = readsPrec1+    readPrec = readPrec1++    readListPrec = readListPrecDefault+    readList     = readListDefault++-- | @since 4.9.0.0 instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where     showsPrec = showsPrec1 +-- | @since 4.9.0.0 instance (Functor f, Functor g) => Functor (Product f g) where     fmap f (Pair x y) = Pair (fmap f x) (fmap f y) +-- | @since 4.9.0.0 instance (Foldable f, Foldable g) => Foldable (Product f g) where     foldMap f (Pair x y) = foldMap f x `mappend` foldMap f y +-- | @since 4.9.0.0 instance (Traversable f, Traversable g) => Traversable (Product f g) where-    traverse f (Pair x y) = Pair <$> traverse f x <*> traverse f y+    traverse f (Pair x y) = liftA2 Pair (traverse f x) (traverse f y) +-- | @since 4.9.0.0 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)+    liftA2 f (Pair a b) (Pair x y) = Pair (liftA2 f a x) (liftA2 f b y) +-- | @since 4.9.0.0 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) +-- | @since 4.9.0.0 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 +-- | @since 4.9.0.0 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) +-- | @since 4.9.0.0 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 +-- | @since 4.9.0.0 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)

@@ -21,57 +21,75 @@     Sum(..),   ) where +import Control.Applicative ((<|>)) 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)+import Text.Read (Read(..), readListDefault, readListPrecDefault)  -- | Lifted sum of functors. data Sum f g a = InL (f a) | InR (g a)   deriving (Data, Generic, Generic1) +-- | @since 4.9.0.0 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 +-- | @since 4.9.0.0 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 +-- | @since 4.9.0.0 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+    liftReadPrec rp rl = readData $+        readUnaryWith (liftReadPrec rp rl) "InL" InL <|>+        readUnaryWith (liftReadPrec rp rl) "InR" InR +    liftReadListPrec = liftReadListPrecDefault+    liftReadList     = liftReadListDefault++-- | @since 4.9.0.0 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 +-- | @since 4.9.0.0 instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where     (==) = eq1+-- | @since 4.9.0.0 instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where     compare = compare1+-- | @since 4.9.0.0 instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where-    readsPrec = readsPrec1+    readPrec = readPrec1++    readListPrec = readListPrecDefault+    readList     = readListDefault+-- | @since 4.9.0.0 instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where     showsPrec = showsPrec1 +-- | @since 4.9.0.0 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) +-- | @since 4.9.0.0 instance (Foldable f, Foldable g) => Foldable (Sum f g) where     foldMap f (InL x) = foldMap f x     foldMap f (InR y) = foldMap f y +-- | @since 4.9.0.0 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

@@ -0,0 +1,115 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}++-----------------------------------------------------------------------------+-- This is a non-exposed internal module.+--+-- This code contains utility function and data structures that are used+-- to improve the efficiency of several instances in the Data.* namespace.+-----------------------------------------------------------------------------+module Data.Functor.Utils where++import Data.Coerce (Coercible, coerce)+import GHC.Base ( Applicative(..), Functor(..), Maybe(..), Monoid(..), Ord(..)+                , ($), otherwise )++-- We don't expose Max and Min because, as Edward Kmett pointed out to me,+-- there are two reasonable ways to define them. One way is to use Maybe, as we+-- do here; the other way is to impose a Bounded constraint on the Monoid+-- instance. We may eventually want to add both versions, but we don't want to+-- trample on anyone's toes by imposing Max = MaxMaybe.++newtype Max a = Max {getMax :: Maybe a}+newtype Min a = Min {getMin :: Maybe a}++-- | @since 4.8.0.0+instance Ord a => Monoid (Max a) where+  mempty = Max Nothing++  {-# INLINE mappend #-}+  m `mappend` Max Nothing = m+  Max Nothing `mappend` n = n+  (Max m@(Just x)) `mappend` (Max n@(Just y))+    | x >= y    = Max m+    | otherwise = Max n++-- | @since 4.8.0.0+instance Ord a => Monoid (Min a) where+  mempty = Min Nothing++  {-# INLINE mappend #-}+  m `mappend` Min Nothing = m+  Min Nothing `mappend` n = n+  (Min m@(Just x)) `mappend` (Min n@(Just y))+    | x <= y    = Min m+    | otherwise = Min n++-- left-to-right state transformer+newtype StateL s a = StateL { runStateL :: s -> (s, a) }++-- | @since 4.0+instance Functor (StateL s) where+    fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)++-- | @since 4.0+instance Applicative (StateL s) where+    pure x = StateL (\ s -> (s, x))+    StateL kf <*> StateL kv = StateL $ \ s ->+        let (s', f) = kf s+            (s'', v) = kv s'+        in (s'', f v)+    liftA2 f (StateL kx) (StateL ky) = StateL $ \s ->+        let (s', x) = kx s+            (s'', y) = ky s'+        in (s'', f x y)++-- right-to-left state transformer+newtype StateR s a = StateR { runStateR :: s -> (s, a) }++-- | @since 4.0+instance Functor (StateR s) where+    fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)++-- | @since 4.0+instance Applicative (StateR s) where+    pure x = StateR (\ s -> (s, x))+    StateR kf <*> StateR kv = StateR $ \ s ->+        let (s', v) = kv s+            (s'', f) = kf s'+        in (s'', f v)+    liftA2 f (StateR kx) (StateR ky) = StateR $ \ s ->+        let (s', y) = ky s+            (s'', x) = kx s'+        in (s'', f x y)++-- See Note [Function coercion]+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)+(#.) _f = coerce+{-# INLINE (#.) #-}++{-+Note [Function coercion]+~~~~~~~~~~~~~~~~~~~~~~~++Several functions here use (#.) instead of (.) to avoid potential efficiency+problems relating to #7542. The problem, in a nutshell:++If N is a newtype constructor, then N x will always have the same+representation as x (something similar applies for a newtype deconstructor).+However, if f is a function,++N . f = \x -> N (f x)++This looks almost the same as f, but the eta expansion lifts it--the lhs could+be _|_, but the rhs never is. This can lead to very inefficient code.  Thus we+steal a technique from Shachaf and Edward Kmett and adapt it to the current+(rather clean) setting. Instead of using  N . f,  we use  N #. f, which is+just++coerce f `asTypeOf` (N . f)++That is, we just *pretend* that f has the right type, and thanks to the safety+of coerce, the type checker guarantees that nothing really goes wrong. We still+have to be a bit careful, though: remember that #. completely ignores the+*value* of its left operand.+-}

@@ -101,15 +101,17 @@                                       unzip, zip, zipWith, (!!)) import qualified Prelude -import           Control.Applicative (Alternative, many)-import           Control.Monad       (ap)+import           Control.Applicative (Applicative (..), Alternative (many))+import           Control.Monad       (ap, liftM2) 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           Data.Functor.Classes (Eq1(..), Ord1(..), Read1(..), Show1(..)) import qualified Data.List           as List+import           Data.Monoid         ((<>)) import           Data.Ord            (comparing) import qualified GHC.Exts            as Exts (IsList(..)) import           GHC.Generics        (Generic, Generic1)@@ -122,15 +124,39 @@ data NonEmpty a = a :| [a]   deriving ( Eq, Ord, Show, Read, Data, Generic, Generic1 ) +-- | @since 4.10.0.0+instance Eq1 NonEmpty where+  liftEq eq (a :| as) (b :| bs) = eq a b && liftEq eq as bs++-- | @since 4.10.0.0+instance Ord1 NonEmpty where+  liftCompare cmp (a :| as) (b :| bs) = cmp a b <> liftCompare cmp as bs++-- | @since 4.10.0.0+instance Read1 NonEmpty where+  liftReadsPrec rdP rdL p s = readParen (p > 5) (\s' -> do+    (a, s'') <- rdP 6 s'+    (":|", s''') <- lex s''+    (as, s'''') <- rdL s'''+    return (a :| as, s'''')) s++-- | @since 4.10.0.0+instance Show1 NonEmpty where+  liftShowsPrec shwP shwL p (a :| as) = showParen (p > 5) $+    shwP 6 a . showString " :| " . shwL as++-- | @since 4.9.0.0 instance Exts.IsList (NonEmpty a) where   type Item (NonEmpty a) = a   fromList               = fromList   toList                 = toList +-- | @since 4.9.0.0 instance MonadFix NonEmpty where   mfix f = case fix (f . head) of              ~(x :| _) -> x :| mfix (tail . f) +-- | @since 4.9.0.0 instance MonadZip NonEmpty where   mzip     = zip   mzipWith = zipWith@@ -154,6 +180,8 @@ unfold f a = case f a of   (b, Nothing) -> b :| []   (b, Just c)  -> b <| unfold f c+{-# DEPRECATED unfold "Use unfoldr" #-}+-- Deprecated in 8.2.1, remove in 8.4  -- | 'nonEmpty' efficiently turns a normal list into a 'NonEmpty' stream, -- producing 'Nothing' if the input is empty.@@ -175,28 +203,36 @@     go c = case f c of       (d, me) -> d : maybe [] go me +-- | @since 4.9.0.0 instance Functor NonEmpty where   fmap f ~(a :| as) = f a :| fmap f as   b <$ ~(_ :| as)   = b   :| (b <$ as) +-- | @since 4.9.0.0 instance Applicative NonEmpty where   pure a = a :| []   (<*>) = ap+  liftA2 = liftM2 +-- | @since 4.9.0.0 instance Monad NonEmpty where   ~(a :| as) >>= f = b :| (bs ++ bs')     where b :| bs = f a           bs' = as >>= toList . f +-- | @since 4.9.0.0 instance Traversable NonEmpty where-  traverse f ~(a :| as) = (:|) <$> f a <*> traverse f as+  traverse f ~(a :| as) = liftA2 (:|) (f a) (traverse f as) +-- | @since 4.9.0.0 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+  length = length+  toList = toList  -- | Extract the first element of the stream. head :: NonEmpty a -> a@@ -266,7 +302,7 @@  -- | @'some1' x@ sequences @x@ one or more times. some1 :: Alternative f => f a -> f (NonEmpty a)-some1 x = (:|) <$> x <*> many x+some1 x = liftA2 (:|) x (many x)  -- | 'scanl' is similar to 'foldl', but returns a stream of successive -- reduced values from the left:@@ -458,7 +494,7 @@ 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.+-- particular, it keeps only the first occurrence of each element. -- (The name 'nub' means \'essence\'.) -- It is a special case of 'nubBy', which allows the programmer to -- supply their own inequality test.@@ -476,8 +512,8 @@ -- > transpose . transpose /= id transpose :: NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a) transpose = fmap fromList-          . fromList . List.transpose . Foldable.toList-          . fmap Foldable.toList+          . fromList . List.transpose . toList+          . fmap toList  -- | 'sortBy' for 'NonEmpty', behaves the same as 'Data.List.sortBy' sortBy :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a

@@ -293,7 +293,7 @@ "mapMaybeList" [1]  forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f   #-} -{-# NOINLINE [0] mapMaybeFB #-}+{-# INLINE [0] mapMaybeFB #-} -- See Note [Inline FB functions] in GHC.List mapMaybeFB :: (b -> r -> r) -> (a -> Maybe b) -> a -> r -> r mapMaybeFB cons f x next = case f x of   Nothing -> next

@@ -70,17 +70,21 @@ newtype Dual a = Dual { getDual :: a }         deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1) +-- | @since 2.01 instance Monoid a => Monoid (Dual a) where         mempty = Dual mempty         Dual x `mappend` Dual y = Dual (y `mappend` x) +-- | @since 4.8.0.0 instance Functor Dual where     fmap     = coerce +-- | @since 4.8.0.0 instance Applicative Dual where     pure     = Dual     (<*>)    = coerce +-- | @since 4.8.0.0 instance Monad Dual where     m >>= k  = k (getDual m) @@ -88,6 +92,7 @@ newtype Endo a = Endo { appEndo :: a -> a }                deriving (Generic) +-- | @since 2.01 instance Monoid (Endo a) where         mempty = Endo id         Endo f `mappend` Endo g = Endo (f . g)@@ -96,6 +101,7 @@ newtype All = All { getAll :: Bool }         deriving (Eq, Ord, Read, Show, Bounded, Generic) +-- | @since 2.01 instance Monoid All where         mempty = All True         All x `mappend` All y = All (x && y)@@ -104,6 +110,7 @@ newtype Any = Any { getAny :: Bool }         deriving (Eq, Ord, Read, Show, Bounded, Generic) +-- | @since 2.01 instance Monoid Any where         mempty = Any False         Any x `mappend` Any y = Any (x || y)@@ -112,18 +119,22 @@ newtype Sum a = Sum { getSum :: a }         deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num) +-- | @since 2.01 instance Num a => Monoid (Sum a) where         mempty = Sum 0         mappend = coerce ((+) :: a -> a -> a) --        Sum x `mappend` Sum y = Sum (x + y) +-- | @since 4.8.0.0 instance Functor Sum where     fmap     = coerce +-- | @since 4.8.0.0 instance Applicative Sum where     pure     = Sum     (<*>)    = coerce +-- | @since 4.8.0.0 instance Monad Sum where     m >>= k  = k (getSum m) @@ -131,18 +142,22 @@ newtype Product a = Product { getProduct :: a }         deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num) +-- | @since 2.01 instance Num a => Monoid (Product a) where         mempty = Product 1         mappend = coerce ((*) :: a -> a -> a) --        Product x `mappend` Product y = Product (x * y) +-- | @since 4.8.0.0 instance Functor Product where     fmap     = coerce +-- | @since 4.8.0.0 instance Applicative Product where     pure     = Product     (<*>)    = coerce +-- | @since 4.8.0.0 instance Monad Product where     m >>= k  = k (getProduct m) @@ -186,6 +201,7 @@         deriving (Eq, Ord, Read, Show, Generic, Generic1,                   Functor, Applicative, Monad) +-- | @since 2.01 instance Monoid (First a) where         mempty = First Nothing         First Nothing `mappend` r = r@@ -199,6 +215,7 @@         deriving (Eq, Ord, Read, Show, Generic, Generic1,                   Functor, Applicative, Monad) +-- | @since 2.01 instance Monoid (Last a) where         mempty = Last Nothing         l `mappend` Last Nothing = l@@ -211,6 +228,7 @@   deriving (Generic, Generic1, Read, Show, Eq, Ord, Num, Enum,             Monad, MonadPlus, Applicative, Alternative, Functor) +-- | @since 4.8.0.0 instance Alternative f => Monoid (Alt f a) where         mempty = Alt empty         mappend = coerce ((<|>) :: f a -> f a -> f a)

@@ -815,6 +815,9 @@ -- | The 'sort' function implements a stable sorting algorithm. -- It is a special case of 'sortBy', which allows the programmer to supply -- their own comparison function.+--+-- Elements are arranged from from lowest to highest, keeping duplicates in+-- the order they appeared in the input. sort :: (Ord a) => [a] -> [a]  -- | The 'sortBy' function is the non-overloaded version of 'sort'.@@ -978,6 +981,9 @@ -- input list.  This is called the decorate-sort-undecorate paradigm, or -- Schwartzian transform. --+-- Elements are arranged from from lowest to highest, keeping duplicates in+-- the order they appeared in the input.+-- -- @since 4.8.0.0 sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f =@@ -1098,7 +1104,7 @@ "wordsList" [1] wordsFB (:) [] = words  #-} wordsFB :: ([Char] -> b -> b) -> b -> String -> b-{-# NOINLINE [0] wordsFB #-}+{-# INLINE [0] wordsFB #-} -- See Note [Inline FB functions] in GHC.List wordsFB c n = go   where     go s = case dropWhile isSpace s of

@@ -48,5 +48,6 @@ -- @since 4.6.0.0 newtype Down a = Down a deriving (Eq, Show, Read) +-- | @since 4.6.0.0 instance Ord a => Ord (Down a) where     compare (Down x) (Down y) = y `compare` x

@@ -29,7 +29,7 @@ import GHC.Arr  -- | A concrete, poly-kinded proxy type-data Proxy t = Proxy+data Proxy t = Proxy deriving Bounded  -- | A concrete, promotable proxy type, for use at the kind level -- There are no instances for this because it is intended at the kind level only@@ -39,18 +39,23 @@ -- interchangeably, so all of these instances are hand-written to be -- lazy in Proxy arguments. +-- | @since 4.7.0.0 instance Eq (Proxy s) where   _ == _ = True +-- | @since 4.7.0.0 instance Ord (Proxy s) where   compare _ _ = EQ +-- | @since 4.7.0.0 instance Show (Proxy s) where   showsPrec _ _ = showString "Proxy" +-- | @since 4.7.0.0 instance Read (Proxy s) where   readsPrec d = readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ]) +-- | @since 4.7.0.0 instance Enum (Proxy s) where     succ _               = errorWithoutStackTrace "Proxy.succ"     pred _               = errorWithoutStackTrace "Proxy.pred"@@ -62,6 +67,7 @@     enumFromThenTo _ _ _ = [Proxy]     enumFromTo _ _       = [Proxy] +-- | @since 4.7.0.0 instance Ix (Proxy s) where     range _           = [Proxy]     index _ _         = 0@@ -70,41 +76,43 @@     unsafeIndex _ _   = 0     unsafeRangeSize _ = 1 -instance Bounded (Proxy s) where-    minBound = Proxy-    maxBound = Proxy-+-- | @since 4.7.0.0 instance Monoid (Proxy s) where     mempty = Proxy     mappend _ _ = Proxy     mconcat _ = Proxy +-- | @since 4.7.0.0 instance Functor Proxy where     fmap _ _ = Proxy     {-# INLINE fmap #-} +-- | @since 4.7.0.0 instance Applicative Proxy where     pure _ = Proxy     {-# INLINE pure #-}     _ <*> _ = Proxy     {-# INLINE (<*>) #-} +-- | @since 4.9.0.0 instance Alternative Proxy where     empty = Proxy     {-# INLINE empty #-}     _ <|> _ = Proxy     {-# INLINE (<|>) #-} +-- | @since 4.7.0.0 instance Monad Proxy where     _ >>= _ = Proxy     {-# INLINE (>>=) #-} +-- | @since 4.9.0.0 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 -- argument (which is usually overloaded) to have the same type as the tag -- of the second.-asProxyTypeOf :: a -> Proxy a -> a+asProxyTypeOf :: a -> proxy a -> a asProxyTypeOf = const {-# INLINE asProxyTypeOf #-}

@@ -1,11 +1,13 @@-{-# LANGUAGE DefaultSignatures   #-}-{-# LANGUAGE DeriveDataTypeable  #-}-{-# LANGUAGE DeriveGeneric       #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE PolyKinds           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE Trustworthy         #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DefaultSignatures          #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PolyKinds                  #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE Trustworthy                #-}+{-# LANGUAGE TypeOperators              #-}  ----------------------------------------------------------------------------- -- |@@ -70,15 +72,21 @@ import           Control.Applicative import           Control.Monad import           Control.Monad.Fix+import           Data.Bifoldable import           Data.Bifunctor+import           Data.Bitraversable import           Data.Coerce import           Data.Data+import           Data.Functor.Identity 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+#ifndef mingw32_HOST_OS+import           GHC.Event           (Event, Lifetime)+#endif import           GHC.Generics  infixr 6 <>@@ -142,15 +150,18 @@ cycle1 :: Semigroup m => m -> m cycle1 xs = xs' where xs' = xs <> xs' +-- | @since 4.9.0.0 instance Semigroup () where   _ <> _ = ()   sconcat _ = ()   stimes _ _ = () +-- | @since 4.9.0.0 instance Semigroup b => Semigroup (a -> b) where   f <> g = \a -> f a <> g a   stimes n f e = stimes n (f e) +-- | @since 4.9.0.0 instance Semigroup [a] where   (<>) = (++)   stimes n x@@ -160,6 +171,7 @@       rep 0 = []       rep i = x ++ rep (i - 1) +-- | @since 4.9.0.0 instance Semigroup a => Semigroup (Maybe a) where   Nothing <> b       = b   a       <> Nothing = a@@ -170,57 +182,69 @@     EQ -> Nothing     GT -> Just (stimes n a) +-- | @since 4.9.0.0 instance Semigroup (Either a b) where   Left _ <> b = b   a      <> _ = a   stimes = stimesIdempotent +-- | @since 4.9.0.0 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) +-- | @since 4.9.0.0 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) +-- | @since 4.9.0.0 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) +-- | @since 4.9.0.0 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) +-- | @since 4.9.0.0 instance Semigroup Ordering where   LT <> _ = LT   EQ <> y = y   GT <> _ = GT   stimes = stimesIdempotentMonoid +-- | @since 4.9.0.0 instance Semigroup a => Semigroup (Dual a) where   Dual a <> Dual b = Dual (b <> a)   stimes n (Dual a) = Dual (stimes n a) +-- | @since 4.9.0.0 instance Semigroup (Endo a) where   (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> (a -> a))   stimes = stimesMonoid +-- | @since 4.9.0.0 instance Semigroup All where   (<>) = coerce (&&)   stimes = stimesIdempotentMonoid +-- | @since 4.9.0.0 instance Semigroup Any where   (<>) = coerce (||)   stimes = stimesIdempotentMonoid  +-- | @since 4.9.0.0 instance Num a => Semigroup (Sum a) where   (<>) = coerce ((+) :: a -> a -> a)   stimes n (Sum a) = Sum (fromIntegral n * a) +-- | @since 4.9.0.0 instance Num a => Semigroup (Product a) where   (<>) = coerce ((*) :: a -> a -> a)   stimes n (Product a) = Product (a ^ n)@@ -263,39 +287,47 @@   | n <= 0 = errorWithoutStackTrace "stimesIdempotent: positive multiplier expected"   | otherwise = x +-- | @since 4.9.0.0+instance Semigroup a => Semigroup (Identity a) where+  (<>) = coerce ((<>) :: a -> a -> a)+  stimes n (Identity a) = Identity (stimes n a)++-- | @since 4.9.0.0 instance Semigroup a => Semigroup (Const a b) where   (<>) = coerce ((<>) :: a -> a -> a)   stimes n (Const a) = Const (stimes n a) +-- | @since 4.9.0.0 instance Semigroup (Monoid.First a) where   Monoid.First Nothing <> b = b   a                    <> _ = a   stimes = stimesIdempotentMonoid +-- | @since 4.9.0.0 instance Semigroup (Monoid.Last a) where   a <> Monoid.Last Nothing = a   _ <> b                   = b   stimes = stimesIdempotentMonoid +-- | @since 4.9.0.0 instance Alternative f => Semigroup (Alt f a) where   (<>) = coerce ((<|>) :: f a -> f a -> f a)   stimes = stimesMonoid +-- | @since 4.9.0.0 instance Semigroup Void where   a <> _ = a   stimes = stimesIdempotent +-- | @since 4.9.0.0 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+  deriving (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1) +-- | @since 4.9.0.0 instance Enum a => Enum (Min a) where   succ (Min a) = Min (succ a)   pred (Min a) = Min (pred a)@@ -307,36 +339,46 @@   enumFromThenTo (Min a) (Min b) (Min c) = Min <$> enumFromThenTo a b c  +-- | @since 4.9.0.0 instance Ord a => Semigroup (Min a) where   (<>) = coerce (min :: a -> a -> a)   stimes = stimesIdempotent +-- | @since 4.9.0.0 instance (Ord a, Bounded a) => Monoid (Min a) where   mempty = maxBound   mappend = (<>) +-- | @since 4.9.0.0 instance Functor Min where   fmap f (Min x) = Min (f x) +-- | @since 4.9.0.0 instance Foldable Min where   foldMap f (Min a) = f a +-- | @since 4.9.0.0 instance Traversable Min where   traverse f (Min a) = Min <$> f a +-- | @since 4.9.0.0 instance Applicative Min where   pure = Min   a <* _ = a   _ *> a = a-  Min f <*> Min x = Min (f x)+  (<*>) = coerce+  liftA2 = coerce +-- | @since 4.9.0.0 instance Monad Min where   (>>) = (*>)   Min a >>= f = f a +-- | @since 4.9.0.0 instance MonadFix Min where   mfix f = fix (f . getMin) +-- | @since 4.9.0.0 instance Num a => Num (Min a) where   (Min a) + (Min b) = Min (a + b)   (Min a) * (Min b) = Min (a * b)@@ -347,12 +389,9 @@   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+  deriving (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1) +-- | @since 4.9.0.0 instance Enum a => Enum (Max a) where   succ (Max a) = Max (succ a)   pred (Max a) = Max (pred a)@@ -363,36 +402,46 @@   enumFromTo (Max a) (Max b) = Max <$> enumFromTo a b   enumFromThenTo (Max a) (Max b) (Max c) = Max <$> enumFromThenTo a b c +-- | @since 4.9.0.0 instance Ord a => Semigroup (Max a) where   (<>) = coerce (max :: a -> a -> a)   stimes = stimesIdempotent +-- | @since 4.9.0.0 instance (Ord a, Bounded a) => Monoid (Max a) where   mempty = minBound   mappend = (<>) +-- | @since 4.9.0.0 instance Functor Max where   fmap f (Max x) = Max (f x) +-- | @since 4.9.0.0 instance Foldable Max where   foldMap f (Max a) = f a +-- | @since 4.9.0.0 instance Traversable Max where   traverse f (Max a) = Max <$> f a +-- | @since 4.9.0.0 instance Applicative Max where   pure = Max   a <* _ = a   _ *> a = a-  Max f <*> Max x = Max (f x)+  (<*>) = coerce+  liftA2 = coerce +-- | @since 4.9.0.0 instance Monad Max where   (>>) = (*>)   Max a >>= f = f a +-- | @since 4.9.0.0 instance MonadFix Max where   mfix f = fix (f . getMax) +-- | @since 4.9.0.0 instance Num a => Num (Max a) where   (Max a) + (Max b) = Max (a + b)   (Max a) * (Max b) = Max (a * b)@@ -405,23 +454,28 @@ -- | '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)+  (Show, Read, Data, Generic, Generic1)  type ArgMin a b = Min (Arg a b) type ArgMax a b = Max (Arg a b) +-- | @since 4.9.0.0 instance Functor (Arg a) where   fmap f (Arg x a) = Arg x (f a) +-- | @since 4.9.0.0 instance Foldable (Arg a) where   foldMap f (Arg _ a) = f a +-- | @since 4.9.0.0 instance Traversable (Arg a) where   traverse f (Arg x a) = Arg x <$> f a +-- | @since 4.9.0.0 instance Eq a => Eq (Arg a b) where   Arg a _ == Arg b _ = a == b +-- | @since 4.9.0.0 instance Ord a => Ord (Arg a b) where   Arg a _ `compare` Arg b _ = compare a b   min x@(Arg a _) y@(Arg b _)@@ -431,18 +485,24 @@     | a >= b    = x     | otherwise = y +-- | @since 4.9.0.0 instance Bifunctor Arg where   bimap f g (Arg a b) = Arg (f a) (g b) +-- | @since 4.10.0.0+instance Bifoldable Arg where+  bifoldMap f g (Arg a b) = f a `mappend` g b++-- | @since 4.10.0.0+instance Bitraversable Arg where+  bitraverse 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+  (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1) +-- | @since 4.9.0.0 instance Enum a => Enum (First a) where   succ (First a) = First (succ a)   pred (First a) = First (pred a)@@ -453,41 +513,46 @@   enumFromTo (First a) (First b) = First <$> enumFromTo a b   enumFromThenTo (First a) (First b) (First c) = First <$> enumFromThenTo a b c +-- | @since 4.9.0.0 instance Semigroup (First a) where   a <> _ = a   stimes = stimesIdempotent +-- | @since 4.9.0.0 instance Functor First where   fmap f (First x) = First (f x) +-- | @since 4.9.0.0 instance Foldable First where   foldMap f (First a) = f a +-- | @since 4.9.0.0 instance Traversable First where   traverse f (First a) = First <$> f a +-- | @since 4.9.0.0 instance Applicative First where   pure x = First x   a <* _ = a   _ *> a = a-  First f <*> First x = First (f x)+  (<*>) = coerce+  liftA2 = coerce +-- | @since 4.9.0.0 instance Monad First where   (>>) = (*>)   First a >>= f = f a +-- | @since 4.9.0.0 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+  (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1) +-- | @since 4.9.0.0 instance Enum a => Enum (Last a) where   succ (Last a) = Last (succ a)   pred (Last a) = Last (pred a)@@ -498,48 +563,55 @@   enumFromTo (Last a) (Last b) = Last <$> enumFromTo a b   enumFromThenTo (Last a) (Last b) (Last c) = Last <$> enumFromThenTo a b c +-- | @since 4.9.0.0 instance Semigroup (Last a) where   _ <> b = b   stimes = stimesIdempotent +-- | @since 4.9.0.0 instance Functor Last where   fmap f (Last x) = Last (f x)   a <$ _ = Last a +-- | @since 4.9.0.0 instance Foldable Last where   foldMap f (Last a) = f a +-- | @since 4.9.0.0 instance Traversable Last where   traverse f (Last a) = Last <$> f a +-- | @since 4.9.0.0 instance Applicative Last where   pure = Last   a <* _ = a   _ *> a = a-  Last f <*> Last x = Last (f x)+  (<*>) = coerce+  liftA2 = coerce +-- | @since 4.9.0.0 instance Monad Last where   (>>) = (*>)   Last a >>= f = f a +-- | @since 4.9.0.0 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)+  deriving (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1) +-- | @since 4.9.0.0 instance Monoid m => Semigroup (WrappedMonoid m) where   (<>) = coerce (mappend :: m -> m -> m) +-- | @since 4.9.0.0 instance Monoid m => Monoid (WrappedMonoid m) where   mempty = WrapMonoid mempty   mappend = (<>) -instance Bounded a => Bounded (WrappedMonoid a) where-  minBound = WrapMonoid minBound-  maxBound = WrapMonoid maxBound-+-- | @since 4.9.0.0 instance Enum a => Enum (WrappedMonoid a) where   succ (WrapMonoid a) = WrapMonoid (succ a)   pred (WrapMonoid a) = WrapMonoid (pred a)@@ -570,39 +642,46 @@ -- 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)+  deriving (Eq, Ord, Show, Read, Data, Generic, Generic1) +-- | @since 4.9.0.0 instance Functor Option where   fmap f (Option a) = Option (fmap f a) +-- | @since 4.9.0.0 instance Applicative Option where   pure a = Option (Just a)   Option a <*> Option b = Option (a <*> b)+  liftA2 f (Option x) (Option y) = Option (liftA2 f x y)    Option Nothing  *>  _ = Option Nothing   _               *>  b = b +-- | @since 4.9.0.0 instance Monad Option where   Option (Just a) >>= k = k a   _               >>= _ = Option Nothing   (>>) = (*>) +-- | @since 4.9.0.0 instance Alternative Option where   empty = Option Nothing   Option Nothing <|> b = b   a <|> _ = a -instance MonadPlus Option where-  mzero = Option Nothing-  mplus = (<|>)+-- | @since 4.9.0.0+instance MonadPlus Option +-- | @since 4.9.0.0 instance MonadFix Option where   mfix f = Option (mfix (getOption . f)) +-- | @since 4.9.0.0 instance Foldable Option where   foldMap f (Option (Just m)) = f m   foldMap _ (Option Nothing)  = mempty +-- | @since 4.9.0.0 instance Traversable Option where   traverse f (Option (Just a)) = Option . Just <$> f a   traverse _ (Option Nothing)  = pure (Option Nothing)@@ -611,6 +690,7 @@ option :: b -> (a -> b) -> Option a -> b option n j (Option m) = maybe n j m +-- | @since 4.9.0.0 instance Semigroup a => Semigroup (Option a) where   (<>) = coerce ((<>) :: Maybe a -> Maybe a -> Maybe a) @@ -620,6 +700,7 @@     EQ -> Option Nothing     GT -> Option (Just (stimes n a)) +-- | @since 4.9.0.0 instance Semigroup a => Monoid (Option a) where   mempty = Option Nothing   mappend = (<>)@@ -628,7 +709,24 @@ diff :: Semigroup m => m -> Endo m diff = Endo . (<>) +-- | @since 4.9.0.0 instance Semigroup (Proxy s) where   _ <> _ = Proxy   sconcat _ = Proxy   stimes _ _ = Proxy++-- | @since 4.10.0.0+instance Semigroup a => Semigroup (IO a) where+    (<>) = liftA2 (<>)++#ifndef mingw32_HOST_OS+-- | @since 4.10.0.0+instance Semigroup Event where+    (<>) = mappend+    stimes = stimesMonoid++-- | @since 4.10.0.0+instance Semigroup Lifetime where+    (<>) = mappend+    stimes = stimesMonoid+#endif

@@ -1,5 +1,8 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE NoImplicitPrelude, FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-}  -----------------------------------------------------------------------------@@ -29,6 +32,7 @@  import GHC.Base import Data.Functor.Const (Const (Const))+import Data.Functor.Identity (Identity (Identity)) import Data.List (lines, words, unlines, unwords)  -- | Class for string-like datastructures; used by the overloaded string@@ -75,9 +79,13 @@ ensure the good behavior of the above example remains in the future. -} +-- | @(a ~ Char)@ context was introduced in @4.9.0.0@+--+-- @since 2.01 instance (a ~ Char) => IsString [a] where          -- See Note [IsString String]     fromString xs = xs -instance IsString a => IsString (Const a b) where-    fromString = Const . fromString+-- | @since 4.9.0.0+deriving instance IsString a => IsString (Const a b)+deriving instance IsString a => IsString (Identity a)

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeOperators #-}@@ -53,9 +54,12 @@ -- 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.Coerce import Data.Either ( Either(..) ) import Data.Foldable ( Foldable ) import Data.Functor+import Data.Functor.Identity ( Identity(..) )+import Data.Functor.Utils ( StateL(..), StateR(..) ) import Data.Monoid ( Dual(..), Sum(..), Product(..), First(..), Last(..) ) import Data.Proxy ( Proxy(..) ) @@ -155,47 +159,98 @@     -- from left to right, and collect the results. For a version that ignores     -- the results see 'Data.Foldable.traverse_'.     traverse :: Applicative f => (a -> f b) -> t a -> f (t b)+    {-# INLINE traverse #-}  -- See Note [Inline default methods]     traverse f = sequenceA . fmap f      -- | Evaluate each action in the structure from left to right, and     -- and collect the results. For a version that ignores the results     -- see 'Data.Foldable.sequenceA_'.     sequenceA :: Applicative f => t (f a) -> f (t a)+    {-# INLINE sequenceA #-}  -- See Note [Inline default methods]     sequenceA = traverse id      -- | Map each element of a structure to a monadic action, evaluate     -- these actions from left to right, and collect the results. For     -- a version that ignores the results see 'Data.Foldable.mapM_'.     mapM :: Monad m => (a -> m b) -> t a -> m (t b)+    {-# INLINE mapM #-}  -- See Note [Inline default methods]     mapM = traverse      -- | Evaluate each monadic action in the structure from left to     -- right, and collect the results. For a version that ignores the     -- results see 'Data.Foldable.sequence_'.     sequence :: Monad m => t (m a) -> m (t a)+    {-# INLINE sequence #-}  -- See Note [Inline default methods]     sequence = sequenceA +{- Note [Inline default methods]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider++   class ... => Traversable t where+       ...+       mapM :: Monad m => (a -> m b) -> t a -> m (t b)+       mapM = traverse   -- Default method++   instance Traversable [] where+       {-# INLINE traverse #-}+       traverse = ...code for traverse on lists ...++This gives rise to a list-instance of mapM looking like this++  $fTraversable[]_$ctaverse = ...code for traverse on lists...+       {-# INLINE $fTraversable[]_$ctaverse #-}+  $fTraversable[]_$cmapM    = $fTraversable[]_$ctraverse++Now the $ctraverse obediently inlines into the RHS of $cmapM, /but/+that's all!  We get++  $fTraversable[]_$cmapM = ...code for traverse on lists...++with NO INLINE pragma!  This happens even though 'traverse' had an+INLINE pragma because the author knew it should be inlined pretty+vigorously.++Indeed, it turned out that the rhs of $cmapM was just too big to+inline, so all uses of mapM on lists used a terribly inefficient+dictionary-passing style, because of its 'Monad m =>' type.  Disaster!++Solution: add an INLINE pragma on the default method:++   class ... => Traversable t where+       ...+       mapM :: Monad m => (a -> m b) -> t a -> m (t b)+       {-# INLINE mapM #-}     -- VERY IMPORTANT!+       mapM = traverse+-}+ -- instances for Prelude types +-- | @since 2.01 instance Traversable Maybe where     traverse _ Nothing = pure Nothing     traverse f (Just x) = Just <$> f x +-- | @since 2.01 instance Traversable [] where     {-# INLINE traverse #-} -- so that traverse can fuse     traverse f = List.foldr cons_f (pure [])-      where cons_f x ys = (:) <$> f x <*> ys+      where cons_f x ys = liftA2 (:) (f x) ys +-- | @since 4.7.0.0 instance Traversable (Either a) where     traverse _ (Left x) = pure (Left x)     traverse f (Right y) = Right <$> f y +-- | @since 4.7.0.0 instance Traversable ((,) a) where     traverse f (x, y) = (,) x <$> f y +-- | @since 2.01 instance Ix i => Traversable (Array i) where     traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr) +-- | @since 4.7.0.0 instance Traversable Proxy where     traverse _ _ = pure Proxy     {-# INLINE traverse #-}@@ -206,28 +261,38 @@     sequence _ = pure Proxy     {-# INLINE sequence #-} +-- | @since 4.7.0.0 instance Traversable (Const m) where     traverse _ (Const m) = pure $ Const m +-- | @since 4.8.0.0 instance Traversable Dual where     traverse f (Dual x) = Dual <$> f x +-- | @since 4.8.0.0 instance Traversable Sum where     traverse f (Sum x) = Sum <$> f x +-- | @since 4.8.0.0 instance Traversable Product where     traverse f (Product x) = Product <$> f x +-- | @since 4.8.0.0 instance Traversable First where     traverse f (First x) = First <$> traverse f x +-- | @since 4.8.0.0 instance Traversable Last where     traverse f (Last x) = Last <$> traverse f x +-- | @since 4.9.0.0 instance Traversable ZipList where     traverse f (ZipList x) = ZipList <$> traverse f x +deriving instance Traversable Identity+ -- Instances for GHC.Generics+-- | @since 4.9.0.0 instance Traversable U1 where     traverse _ _ = pure U1     {-# INLINE traverse #-}@@ -267,19 +332,6 @@ {-# INLINE forM #-} forM = flip mapM --- left-to-right state transformer-newtype StateL s a = StateL { runStateL :: s -> (s, a) }--instance Functor (StateL s) where-    fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)--instance Applicative (StateL s) where-    pure x = StateL (\ s -> (s, x))-    StateL kf <*> StateL kv = StateL $ \ s ->-        let (s', f) = kf s-            (s'', v) = kv s'-        in (s'', f v)- -- |The 'mapAccumL' function behaves like a combination of 'fmap' -- and 'foldl'; it applies a function to each element of a structure, -- passing an accumulating parameter from left to right, and returning@@ -287,19 +339,6 @@ mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumL f s t = runStateL (traverse (StateL . flip f) t) s --- right-to-left state transformer-newtype StateR s a = StateR { runStateR :: s -> (s, a) }--instance Functor (StateR s) where-    fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)--instance Applicative (StateR s) where-    pure x = StateR (\ s -> (s, x))-    StateR kf <*> StateR kv = StateR $ \ s ->-        let (s', v) = kv s-            (s'', f) = kf s'-        in (s'', f v)- -- |The 'mapAccumR' function behaves like a combination of 'fmap' -- and 'foldr'; it applies a function to each element of a structure, -- passing an accumulating parameter from right to left, and returning@@ -311,23 +350,24 @@ --   instance, provided that 'traverse' is defined. (Using --   `fmapDefault` with a `Traversable` instance defined only by --   'sequenceA' will result in infinite recursion.)-fmapDefault :: Traversable t => (a -> b) -> t a -> t b+--+-- @+-- 'fmapDefault' f ≡ 'runIdentity' . 'traverse' ('Identity' . f)+-- @+fmapDefault :: forall t a b . Traversable t+            => (a -> b) -> t a -> t b {-# INLINE fmapDefault #-}-fmapDefault f = getId . traverse (Id . f)+-- See Note [Function coercion] in Data.Functor.Utils.+fmapDefault = coerce (traverse :: (a -> Identity b) -> t a -> Identity (t b))  -- | This function may be used as a value for `Data.Foldable.foldMap` -- in a `Foldable` instance.-foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m-foldMapDefault f = getConst . traverse (Const . f)---- local instances--newtype Id a = Id { getId :: a }--instance Functor Id where-    fmap f (Id x) = Id (f x)--instance Applicative Id where-    pure = Id-    Id f <*> Id x = Id (f x)-+--+-- @+-- 'foldMapDefault' f ≡ 'getConst' . 'traverse' ('Const' . f)+-- @+foldMapDefault :: forall t m a . (Traversable t, Monoid m)+               => (a -> m) -> t a -> m+{-# INLINE foldMapDefault #-}+-- See Note [Function coercion] in Data.Functor.Utils.+foldMapDefault = coerce (traverse :: (a -> Const m ()) -> t a -> Const m (t ()))

@@ -11,7 +11,7 @@ -- Stability   :  experimental -- Portability :  portable ----- The tuple data types, and associated functions.+-- Functions associated with the tuple data types. -- ----------------------------------------------------------------------------- 

@@ -1,6 +1,5 @@-{-# LANGUAGE Safe #-}-{-# LANGUAGE TypeFamilies, TypeOperators, DataKinds, NoImplicitPrelude,-             PolyKinds #-}+{-# LANGUAGE TypeFamilyDependencies, Safe, PolyKinds #-}+{-# LANGUAGE TypeFamilies, TypeOperators, DataKinds, NoImplicitPrelude #-}  ----------------------------------------------------------------------------- -- |@@ -49,7 +48,9 @@   a      || a      = a infixr 2 || --- | Type-level "not"-type family Not a where+-- | Type-level "not". An injective type family since @4.10.0.0@.+--+-- @since 4.7.0.0+type family Not a = res | res -> a where   Not 'False = 'True   Not 'True  = 'False

@@ -7,6 +7,7 @@ {-# LANGUAGE StandaloneDeriving  #-} {-# LANGUAGE NoImplicitPrelude   #-} {-# LANGUAGE PolyKinds           #-}+{-# LANGUAGE RankNTypes          #-}  ----------------------------------------------------------------------------- -- |@@ -25,6 +26,7 @@ module Data.Type.Coercion   ( Coercion(..)   , coerceWith+  , gcoerceWith   , sym   , trans   , repr@@ -56,6 +58,12 @@ coerceWith :: Coercion a b -> a -> b coerceWith Coercion x = coerce x +-- | Generalized form of type-safe cast using representational equality+--+-- @since 4.10.0.0+gcoerceWith :: Coercion a b -> (Coercible a b => r) -> r+gcoerceWith Coercion x = x+ -- | Symmetry of representational equality sym :: Coercion a b -> Coercion b a sym Coercion = Coercion@@ -72,18 +80,19 @@ deriving instance Show (Coercion a b) deriving instance Ord  (Coercion a b) +-- | @since 4.7.0.0 instance Coercible a b => Read (Coercion a b) where   readsPrec d = readParen (d > 10) (\r -> [(Coercion, s) | ("Coercion",s) <- lex r ]) +-- | @since 4.7.0.0 instance Coercible a b => Enum (Coercion a b) where   toEnum 0 = Coercion   toEnum _ = errorWithoutStackTrace "Data.Type.Coercion.toEnum: bad argument"    fromEnum Coercion = 0 -instance Coercible a b => Bounded (Coercion a b) where-  minBound = Coercion-  maxBound = Coercion+-- | @since 4.7.0.0+deriving instance Coercible a b => Bounded (Coercion a b)  -- | This class contains types where you can learn the equality of two types -- from information contained in /terms/. Typically, only singleton types should@@ -92,8 +101,14 @@   -- | Conditionally prove the representational equality of @a@ and @b@.   testCoercion :: f a -> f b -> Maybe (Coercion a b) +-- | @since 4.7.0.0 instance TestCoercion ((Eq.:~:) a) where   testCoercion Eq.Refl Eq.Refl = Just Coercion +-- | @since 4.10.0.0+instance TestCoercion ((Eq.:~~:) a) where+  testCoercion Eq.HRefl Eq.HRefl = Just Coercion++-- | @since 4.7.0.0 instance TestCoercion (Coercion a) where   testCoercion Coercion Coercion = Just Coercion

@@ -34,6 +34,7 @@ module Data.Type.Equality (   -- * The equality types   (:~:)(..), type (~~),+  (:~~:)(..),    -- * Working with equality   sym, trans, castWith, gcastWith, apply, inner, outer,@@ -55,7 +56,7 @@ -- | 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+class a ~~ b => (a :: k) ~ (b :: k)   -- 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@@ -63,6 +64,11 @@   -- NB: Not exported, as (~) is magical syntax. That's also why there's   -- no fixity. +  -- It's tempting to put functional dependencies on (~), but it's not+  -- necessary because the functional-dependency coverage check looks+  -- through superclasses, and (~#) is handled in that check.++-- | @since 4.9.0.0 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@@ -71,7 +77,7 @@   -- INCOHERENT because we want to use this instance eagerly, even when   -- the tyvars are partially unknown. -infix 4 :~:+infix 4 :~:, :~~:  -- | Propositional equality. If @a :~: b@ is inhabited by some terminating -- value, then the type @a@ is the same as the type @b@. To use this equality@@ -106,7 +112,7 @@ apply :: (f :~: g) -> (a :~: b) -> (f a :~: g b) apply Refl Refl = Refl --- | Extract equality of the arguments from an equality of a applied types+-- | Extract equality of the arguments from an equality of applied types inner :: (f a :~: g b) -> (a :~: b) inner Refl = Refl @@ -118,19 +124,48 @@ deriving instance Show (a :~: b) deriving instance Ord  (a :~: b) +-- | @since 4.7.0.0 instance a ~ b => Read (a :~: b) where   readsPrec d = readParen (d > 10) (\r -> [(Refl, s) | ("Refl",s) <- lex r ]) +-- | @since 4.7.0.0 instance a ~ b => Enum (a :~: b) where   toEnum 0 = Refl   toEnum _ = errorWithoutStackTrace "Data.Type.Equality.toEnum: bad argument"    fromEnum Refl = 0 -instance a ~ b => Bounded (a :~: b) where-  minBound = Refl-  maxBound = Refl+-- | @since 4.7.0.0+deriving instance a ~ b => Bounded (a :~: b) +-- | Kind heterogeneous propositional equality. Like '(:~:)', @a :~~: b@ is+-- inhabited by a terminating value if and only if @a@ is the same type as @b@.+--+-- @since 4.10.0.0+data (a :: k1) :~~: (b :: k2) where+   HRefl :: a :~~: a++-- | @since 4.10.0.0+deriving instance Eq   (a :~~: b)+-- | @since 4.10.0.0+deriving instance Show (a :~~: b)+-- | @since 4.10.0.0+deriving instance Ord  (a :~~: b)++-- | @since 4.10.0.0+instance a ~~ b => Read (a :~~: b) where+  readsPrec d = readParen (d > 10) (\r -> [(HRefl, s) | ("HRefl",s) <- lex r ])++-- | @since 4.10.0.0+instance a ~~ b => Enum (a :~~: b) where+  toEnum 0 = HRefl+  toEnum _ = errorWithoutStackTrace "Data.Type.Equality.toEnum: bad argument"++  fromEnum HRefl = 0++-- | @since 4.10.0.0+deriving instance a ~~ b => Bounded (a :~~: b)+ -- | This class contains types where you can learn the equality of two types -- from information contained in /terms/. Typically, only singleton types should -- inhabit this class.@@ -138,8 +173,13 @@   -- | Conditionally prove the equality of @a@ and @b@.   testEquality :: f a -> f b -> Maybe (a :~: b) +-- | @since 4.7.0.0 instance TestEquality ((:~:) a) where   testEquality Refl Refl = Just Refl++-- | @since 4.10.0.0+instance TestEquality ((:~~:) a) where+  testEquality HRefl HRefl = Just Refl  -- | A type family to compute Boolean equality. Instances are provided -- only for /open/ kinds, such as @*@ and function kinds. Instances are

@@ -3,6 +3,8 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeOperators #-}  -----------------------------------------------------------------------------@@ -10,7 +12,7 @@ -- Module      :  Data.Typeable -- Copyright   :  (c) The University of Glasgow, CWI 2001--2004 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  experimental -- Portability :  portable@@ -26,6 +28,11 @@ -- -- == Compatibility Notes --+-- Since GHC 8.2, GHC has supported type-indexed type representations.+-- "Data.Typeable" provides type representations which are qualified over this+-- index, providing an interface very similar to the "Typeable" notion seen in+-- previous releases. For the type-indexed interface, see "Type.Reflection".+-- -- Since GHC 7.8, 'Typeable' is poly-kinded. The changes required for this might -- break some old programs involving 'Typeable'. More details on this, including -- how to fix your code, can be found on the@@ -34,86 +41,102 @@ -----------------------------------------------------------------------------  module Data.Typeable-  (-        -- * The Typeable class-        Typeable,-        typeRep,--        -- * Propositional equality-        (:~:)(Refl),+    ( -- * The Typeable class+      Typeable+    , typeOf+    , typeRep -        -- * For backwards compatibility-        typeOf, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7,-        Typeable1, Typeable2, Typeable3, Typeable4, Typeable5, Typeable6,-        Typeable7,+      -- * Propositional equality+    , (:~:)(Refl)+    , (:~~:)(HRefl) -        -- * Type-safe cast-        cast,-        eqT,-        gcast,                  -- a generalisation of cast+      -- * Type-safe cast+    , cast+    , eqT+    , gcast                -- a generalisation of cast -        -- * Generalized casts for higher-order kinds-        gcast1,                 -- :: ... => c (t a) -> Maybe (c (t' a))-        gcast2,                 -- :: ... => c (t a b) -> Maybe (c (t' a b))+      -- * Generalized casts for higher-order kinds+    , gcast1               -- :: ... => c (t a) -> Maybe (c (t' a))+    , gcast2               -- :: ... => c (t a b) -> Maybe (c (t' a b)) -        -- * A canonical proxy type-        Proxy (..),+      -- * A canonical proxy type+    , Proxy (..) -        -- * Type representations-        TypeRep,        -- abstract, instance of: Eq, Show, Typeable-        typeRepFingerprint,-        rnfTypeRep,-        showsTypeRep,+      -- * Type representations+    , TypeRep+    , rnfTypeRep+    , showsTypeRep+    , mkFunTy -        TyCon,          -- abstract, instance of: Eq, Show, Typeable-                        -- For now don't export Module, to avoid name clashes-        tyConFingerprint,-        tyConString,-        tyConPackage,-        tyConModule,-        tyConName,-        rnfTyCon,+      -- * Observing type representations+    , funResultTy+    , splitTyConApp+    , typeRepArgs+    , typeRepTyCon+    , typeRepFingerprint -        -- * Construction of type representations-        -- mkTyCon,        -- :: String  -> TyCon-        mkTyCon3,       -- :: String  -> String -> String -> TyCon-        mkTyConApp,     -- :: TyCon   -> [TypeRep] -> TypeRep-        mkAppTy,        -- :: TypeRep -> TypeRep   -> TypeRep-        mkFunTy,        -- :: TypeRep -> TypeRep   -> TypeRep+      -- * Type constructors+    , I.TyCon          -- abstract, instance of: Eq, Show, Typeable+                       -- For now don't export Module to avoid name clashes+    , I.tyConPackage+    , I.tyConModule+    , I.tyConName+    , I.rnfTyCon+    , I.tyConFingerprint -        -- * Observation of type representations-        splitTyConApp,  -- :: TypeRep -> (TyCon, [TypeRep])-        funResultTy,    -- :: TypeRep -> TypeRep   -> Maybe TypeRep-        typeRepTyCon,   -- :: TypeRep -> TyCon-        typeRepArgs,    -- :: TypeRep -> [TypeRep]-  ) where+      -- * For backwards compatibility+    , typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7+    , Typeable1, Typeable2, Typeable3, Typeable4+    , Typeable5, Typeable6, Typeable7+    ) where -import Data.Typeable.Internal+import qualified Data.Typeable.Internal as I+import Data.Typeable.Internal (Typeable) import Data.Type.Equality -import Unsafe.Coerce import Data.Maybe+import Data.Proxy+import GHC.Fingerprint.Type+import GHC.Show import GHC.Base --------------------------------------------------------------------              Type-safe cast+-- | A quantified type representation.+type TypeRep = I.SomeTypeRep++-- | Observe a type representation for the type of a value.+typeOf :: forall a. Typeable a => a -> TypeRep+typeOf _ = I.someTypeRep (Proxy :: Proxy a)++-- | Takes a value of type @a@ and returns a concrete representation+-- of that type. ----------------------------------------------------------------+-- @since 4.7.0.0+typeRep :: forall proxy a. Typeable a => proxy a -> TypeRep+typeRep = I.someTypeRep +-- | Show a type representation+showsTypeRep :: TypeRep -> ShowS+showsTypeRep = shows+ -- | The type-safe cast operation cast :: forall a b. (Typeable a, Typeable b) => a -> Maybe b-cast x = if typeRep (Proxy :: Proxy a) == typeRep (Proxy :: Proxy b)-           then Just $ unsafeCoerce x-           else Nothing+cast x+  | Just HRefl <- ta `I.eqTypeRep` tb = Just x+  | otherwise                         = Nothing+  where+    ta = I.typeRep :: I.TypeRep a+    tb = I.typeRep :: I.TypeRep b  -- | Extract a witness of equality of two types -- -- @since 4.7.0.0 eqT :: forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)-eqT = if typeRep (Proxy :: Proxy a) == typeRep (Proxy :: Proxy b)-      then Just $ unsafeCoerce Refl-      else Nothing+eqT+  | Just HRefl <- ta `I.eqTypeRep` tb = Just Refl+  | otherwise                         = Nothing+  where+    ta = I.typeRep :: I.TypeRep a+    tb = I.typeRep :: I.TypeRep b  -- | A flexible variation parameterised in a type constructor gcast :: forall a b c. (Typeable a, Typeable b) => c a -> Maybe (c b)@@ -121,11 +144,100 @@  -- | Cast over @k1 -> k2@ gcast1 :: forall c t t' a. (Typeable t, Typeable t')-       => c (t a) -> Maybe (c (t' a)) +       => c (t a) -> Maybe (c (t' a)) gcast1 x = fmap (\Refl -> x) (eqT :: Maybe (t :~: t'))  -- | Cast over @k1 -> k2 -> k3@ gcast2 :: forall c t t' a b. (Typeable t, Typeable t')-       => c (t a b) -> Maybe (c (t' a b)) +       => c (t a b) -> Maybe (c (t' a b)) gcast2 x = fmap (\Refl -> x) (eqT :: Maybe (t :~: t')) +-- | Applies a type to a function type. Returns: @Just u@ if the first argument+-- represents a function of type @t -> u@ and the second argument represents a+-- function of type @t@. Otherwise, returns @Nothing@.+funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep+funResultTy (I.SomeTypeRep f) (I.SomeTypeRep x)+  | Just HRefl <- (I.typeRep :: I.TypeRep Type) `I.eqTypeRep` I.typeRepKind f+  , I.Fun arg res <- f+  , Just HRefl <- arg `I.eqTypeRep` x+  = Just (I.SomeTypeRep res)+  | otherwise = Nothing++-- | Build a function type.+mkFunTy :: TypeRep -> TypeRep -> TypeRep+mkFunTy (I.SomeTypeRep arg) (I.SomeTypeRep res)+  | Just HRefl <- I.typeRepKind arg `I.eqTypeRep` liftedTy+  , Just HRefl <- I.typeRepKind res `I.eqTypeRep` liftedTy+  = I.SomeTypeRep (I.Fun arg res)+  | otherwise+  = error $ "mkFunTy: Attempted to construct function type from non-lifted "+++            "type: arg="++show arg++", res="++show res+  where liftedTy = I.typeRep :: I.TypeRep Type++-- | Splits a type constructor application. Note that if the type constructor is+-- polymorphic, this will not return the kinds that were used.+splitTyConApp :: TypeRep -> (TyCon, [TypeRep])+splitTyConApp (I.SomeTypeRep x) = I.splitApps x++-- | Observe the argument types of a type representation+typeRepArgs :: TypeRep -> [TypeRep]+typeRepArgs ty = case splitTyConApp ty of (_, args) -> args++-- | Observe the type constructor of a quantified type representation.+typeRepTyCon :: TypeRep -> TyCon+typeRepTyCon = I.someTypeRepTyCon++-- | Takes a value of type @a@ and returns a concrete representation+-- of that type.+--+-- @since 4.7.0.0+typeRepFingerprint :: TypeRep -> Fingerprint+typeRepFingerprint = I.someTypeRepFingerprint++-- | Force a 'TypeRep' to normal form.+rnfTypeRep :: TypeRep -> ()+rnfTypeRep = I.rnfSomeTypeRep+++-- Keeping backwards-compatibility+typeOf1 :: forall t (a :: *). Typeable t => t a -> TypeRep+typeOf1 _ = I.someTypeRep (Proxy :: Proxy t)++typeOf2 :: forall t (a :: *) (b :: *). Typeable t => t a b -> TypeRep+typeOf2 _ = I.someTypeRep (Proxy :: Proxy t)++typeOf3 :: forall t (a :: *) (b :: *) (c :: *). Typeable t+        => t a b c -> TypeRep+typeOf3 _ = I.someTypeRep (Proxy :: Proxy t)++typeOf4 :: forall t (a :: *) (b :: *) (c :: *) (d :: *). Typeable t+        => t a b c d -> TypeRep+typeOf4 _ = I.someTypeRep (Proxy :: Proxy t)++typeOf5 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *). Typeable t+        => t a b c d e -> TypeRep+typeOf5 _ = I.someTypeRep (Proxy :: Proxy t)++typeOf6 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *).+                Typeable t => t a b c d e f -> TypeRep+typeOf6 _ = I.someTypeRep (Proxy :: Proxy t)++typeOf7 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *)+                (g :: *). Typeable t => t a b c d e f g -> TypeRep+typeOf7 _ = I.someTypeRep (Proxy :: Proxy t)++type Typeable1 (a :: * -> *)                               = Typeable a+type Typeable2 (a :: * -> * -> *)                          = Typeable a+type Typeable3 (a :: * -> * -> * -> *)                     = Typeable a+type Typeable4 (a :: * -> * -> * -> * -> *)                = Typeable a+type Typeable5 (a :: * -> * -> * -> * -> * -> *)           = Typeable a+type Typeable6 (a :: * -> * -> * -> * -> * -> * -> *)      = Typeable a+type Typeable7 (a :: * -> * -> * -> * -> * -> * -> * -> *) = Typeable a++{-# DEPRECATED Typeable1 "renamed to 'Typeable'" #-} -- deprecated in 7.8+{-# DEPRECATED Typeable2 "renamed to 'Typeable'" #-} -- deprecated in 7.8+{-# DEPRECATED Typeable3 "renamed to 'Typeable'" #-} -- deprecated in 7.8+{-# DEPRECATED Typeable4 "renamed to 'Typeable'" #-} -- deprecated in 7.8+{-# DEPRECATED Typeable5 "renamed to 'Typeable'" #-} -- deprecated in 7.8+{-# DEPRECATED Typeable6 "renamed to 'Typeable'" #-} -- deprecated in 7.8+{-# DEPRECATED Typeable7 "renamed to 'Typeable'" #-} -- deprecated in 7.8