diff options
Diffstat (limited to 'libraries/base')
87 files changed, 1029 insertions, 4 deletions
diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs index 0892808dd9..6398a5791a 100644 --- a/libraries/base/Control/Applicative.hs +++ b/libraries/base/Control/Applicative.hs @@ -66,13 +66,16 @@ import GHC.Show (Show) 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) +-- | @since 2.01 instance MonadPlus m => Alternative (WrappedMonad m) where empty = WrapMonad mzero WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v) @@ -80,13 +83,16 @@ instance MonadPlus m => Alternative (WrappedMonad m) where 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)) +-- | @since 2.01 instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where empty = WrapArrow zeroArrow WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v) @@ -100,6 +106,7 @@ newtype ZipList a = ZipList { getZipList :: [a] } , Foldable, Generic, Generic1) -- See Data.Traversable for Traversabel instance due to import loops +-- | @since 2.01 instance Applicative ZipList where pure x = ZipList (repeat x) ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs) diff --git a/libraries/base/Control/Arrow.hs b/libraries/base/Control/Arrow.hs index 9fc2ee5c90..377870c88c 100644 --- a/libraries/base/Control/Arrow.hs +++ b/libraries/base/Control/Arrow.hs @@ -139,6 +139,7 @@ class Category a => Arrow a where -- 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 @@ instance Arrow (->) where -- | 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 @@ f ^<< a = arr f <<< a 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 @@ class ArrowZero a => ArrowPlus a where -- | 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 @@ class Arrow a => ArrowChoice a where 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 @@ instance Monad m => ArrowChoice (Kleisli m) where 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,21 +315,26 @@ instance Monad m => ArrowApply (Kleisli m) where 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) +-- | @since 4.6.0.0 instance (ArrowApply a, ArrowPlus a) => MonadPlus (ArrowMonad a) -- | Any instance of 'ArrowApply' can be made into an instance of @@ -361,12 +375,15 @@ leftApp f = arr ((\b -> (arr (\() -> b) >>> f >>> arr Left, ())) ||| 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) diff --git a/libraries/base/Control/Category.hs b/libraries/base/Control/Category.hs index b638189b60..cc7648060c 100644 --- a/libraries/base/Control/Category.hs +++ b/libraries/base/Control/Category.hs @@ -46,14 +46,17 @@ class Category cat where (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.7.0.0 instance Category Coercion where id = Coercion (.) Coercion = coerce diff --git a/libraries/base/Control/Exception.hs b/libraries/base/Control/Exception.hs index 9c388f4450..cf52d1dbae 100644 --- a/libraries/base/Control/Exception.hs +++ b/libraries/base/Control/Exception.hs @@ -140,6 +140,7 @@ import GHC.IO (interruptible) -- | 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) diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs index 5b3d47cf09..9dd96488bc 100644 --- a/libraries/base/Control/Exception/Base.hs +++ b/libraries/base/Control/Exception/Base.hs @@ -299,9 +299,11 @@ bracketOnError before after thing = -- 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 +315,11 @@ instance Exception PatternMatchFail -- 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 +329,11 @@ instance Exception RecSelError -- 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 +345,11 @@ instance Exception RecConError -- 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 +359,11 @@ instance Exception RecUpdError -- @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 +375,11 @@ instance Exception NoMethodError -- @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 +390,11 @@ instance Exception TypeError -- 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 +403,11 @@ instance Exception NonTermination -- 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 ----- diff --git a/libraries/base/Control/Monad/Fail.hs b/libraries/base/Control/Monad/Fail.hs index 9c5afbe57a..91ef3ed349 100644 --- a/libraries/base/Control/Monad/Fail.hs +++ b/libraries/base/Control/Monad/Fail.hs @@ -67,12 +67,15 @@ class Monad m => MonadFail m where 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 diff --git a/libraries/base/Control/Monad/Fix.hs b/libraries/base/Control/Monad/Fix.hs index 4862770f26..c8a9ddab58 100644 --- a/libraries/base/Control/Monad/Fix.hs +++ b/libraries/base/Control/Monad/Fix.hs @@ -62,60 +62,76 @@ class (Monad m) => MonadFix m where -- 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 diff --git a/libraries/base/Control/Monad/IO/Class.hs b/libraries/base/Control/Monad/IO/Class.hs index b2c419c3a7..76806e132d 100644 --- a/libraries/base/Control/Monad/IO/Class.hs +++ b/libraries/base/Control/Monad/IO/Class.hs @@ -32,5 +32,6 @@ class (Monad m) => MonadIO m where -- | Lift a computation from the 'IO' monad. liftIO :: IO a -> m a +-- | @since 4.9.0.0 instance MonadIO IO where liftIO = id diff --git a/libraries/base/Control/Monad/ST/Lazy/Imp.hs b/libraries/base/Control/Monad/ST/Lazy/Imp.hs index 51b1d86e09..45d2219dce 100644 --- a/libraries/base/Control/Monad/ST/Lazy/Imp.hs +++ b/libraries/base/Control/Monad/ST/Lazy/Imp.hs @@ -62,6 +62,7 @@ import GHC.Base newtype ST s a = ST (State s -> (a, State s)) data State s = S# (State# s) +-- | @since 2.01 instance Functor (ST s) where fmap f m = ST $ \ s -> let @@ -70,10 +71,12 @@ instance Functor (ST s) where in (f r,new_s) +-- | @since 2.01 instance Applicative (ST s) where pure a = ST $ \ s -> (a,s) (<*>) = ap +-- | @since 2.01 instance Monad (ST s) where fail s = errorWithoutStackTrace s @@ -104,6 +107,7 @@ fixST m = ST (\ s -> in (r,s')) +-- | @since 2.01 instance MonadFix (ST s) where mfix = fixST diff --git a/libraries/base/Control/Monad/Zip.hs b/libraries/base/Control/Monad/Zip.hs index fa44438176..f102ff06ad 100644 --- a/libraries/base/Control/Monad/Zip.hs +++ b/libraries/base/Control/Monad/Zip.hs @@ -52,48 +52,62 @@ class Monad m => MonadZip m where -- 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 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 diff --git a/libraries/base/Data/Bifunctor.hs b/libraries/base/Data/Bifunctor.hs index 9cc3c1c11b..5441605ecf 100644 --- a/libraries/base/Data/Bifunctor.hs +++ b/libraries/base/Data/Bifunctor.hs @@ -75,31 +75,40 @@ class Bifunctor p where 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) diff --git a/libraries/base/Data/Bits.hs b/libraries/base/Data/Bits.hs index 3c319995b8..e64df2e6f7 100644 --- a/libraries/base/Data/Bits.hs +++ b/libraries/base/Data/Bits.hs @@ -397,7 +397,9 @@ popCountDefault = go 0 {-# 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 @@ instance Bits Bool where 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 @@ instance Bits Int where 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 @@ instance Bits Word where 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 diff --git a/libraries/base/Data/Complex.hs b/libraries/base/Data/Complex.hs index dd831bbb91..17ef805410 100644 --- a/libraries/base/Data/Complex.hs +++ b/libraries/base/Data/Complex.hs @@ -115,6 +115,7 @@ phase (x:+y) = atan2 y x -- ----------------------------------------------------------------------------- -- 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 +128,7 @@ instance (RealFloat a) => Num (Complex a) where 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 +140,7 @@ instance (RealFloat a) => Fractional (Complex a) where 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 +213,7 @@ instance (RealFloat a) => Floating (Complex a) where | 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 +227,11 @@ instance Storable a => Storable (Complex a) where 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 +-- | @since 4.9.0.0 instance Monad Complex where a :+ b >>= f = realPart (f a) :+ imagPart (f b) diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs index 516ebffd4e..32e3832401 100644 --- a/libraries/base/Data/Data.hs +++ b/libraries/base/Data/Data.hs @@ -514,11 +514,14 @@ data Constr = Constr , 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' @@ -850,6 +853,7 @@ tyconModule x = let (a,b) = break ((==) '.') x -- ------------------------------------------------------------------------------ +-- | @since 4.0.0.0 deriving instance Data Bool ------------------------------------------------------------------------------ @@ -857,6 +861,7 @@ 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 @@ -871,6 +876,7 @@ instance Data Char where 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 @@ -885,6 +891,7 @@ instance Data Float where 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 @@ -899,6 +906,7 @@ instance Data Double where 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 @@ -913,6 +921,7 @@ instance Data Int where 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 @@ -927,6 +936,7 @@ instance Data Integer where 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 @@ -941,6 +951,7 @@ instance Data Int8 where 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 @@ -955,6 +966,7 @@ instance Data Int16 where 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 @@ -969,6 +981,7 @@ instance Data Int32 where 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 @@ -983,6 +996,7 @@ instance Data Int64 where 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 @@ -997,6 +1011,7 @@ instance Data Word where 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 @@ -1011,6 +1026,7 @@ instance Data Word8 where 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 @@ -1025,6 +1041,7 @@ instance Data Word16 where 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 @@ -1039,6 +1056,7 @@ instance Data Word32 where 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 @@ -1059,6 +1077,8 @@ 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 @@ -1077,6 +1097,7 @@ consConstr = mkConstr listDataType "(:)" [] Infix 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 @@ -1103,23 +1124,43 @@ instance Data a => Data [a] where ------------------------------------------------------------------------------ +-- | @since 4.0.0.0 deriving instance Data a => Data (Maybe a) + +-- | @since 4.0.0.0 deriving instance Data Ordering + +-- | @since 4.0.0.0 deriving instance (Data a, Data b) => Data (Either a b) + +-- | @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) + +-- | @since 4.0.0.0 deriving instance (Data a, Data b, Data c, Data d) => Data (a,b,c,d) + +-- | @since 4.0.0.0 deriving instance (Data a, Data b, Data c, Data d, Data e) => Data (a,b,c,d,e) + +-- | @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)" @@ -1128,6 +1169,7 @@ instance Data a => Data (Ptr a) where ------------------------------------------------------------------------------ +-- | @since 4.8.0.0 instance Data a => Data (ForeignPtr a) where toConstr _ = errorWithoutStackTrace "Data.Data.toConstr(ForeignPtr)" gunfold _ _ = errorWithoutStackTrace "Data.Data.gunfold(ForeignPtr)" @@ -1137,6 +1179,7 @@ instance Data a => Data (ForeignPtr a) where ------------------------------------------------------------------------------ -- 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) @@ -1146,35 +1189,93 @@ instance (Data a, Data b, Ix a) => Data (Array a b) dataCast2 x = gcast2 x ---------------------------------------------------------------------------- +-- Data instance for Proxy +-- | @since 4.7.0.0 deriving instance (Data t) => Data (Proxy t) + +-- | @since 4.7.0.0 deriving instance (a ~ b, Data a) => Data (a :~: b) + +-- | @since 4.7.0.0 deriving instance (Coercible a b, Data a, Data b) => Data (Coercion a b) + +-- | @since 4.7.0.0 deriving instance Data Version + +---------------------------------------------------------------------------- +-- Data instances for Data.Monoid wrappers + +-- | @since 4.8.0.0 deriving instance Data a => Data (Dual a) + +-- | @since 4.8.0.0 deriving instance Data All + +-- | @since 4.8.0.0 deriving instance Data Any + +-- | @since 4.8.0.0 deriving instance Data a => Data (Sum a) + +-- | @since 4.8.0.0 deriving instance Data a => Data (Product a) + +-- | @since 4.8.0.0 deriving instance Data a => Data (First a) + +-- | @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) + +---------------------------------------------------------------------------- +-- Data instances for GHC.Generics representations + +-- | @since 4.9.0.0 deriving instance Data p => Data (U1 p) + +-- | @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) + +-- | @since 4.9.0.0 deriving instance (Typeable i, Data p, Data c) => Data (K1 i c p) + +-- | @since 4.9.0.0 deriving instance (Data p, Data (f p), Typeable c, Typeable i, Typeable f) => Data (M1 i c f p) + +-- | @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) + +-- | @since 4.9.0.0 deriving instance Data p => Data (V1 p) + +-- | @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 Data Generics.Fixity + +-- | @since 4.9.0.0 deriving instance Data Associativity + +-- | @since 4.9.0.0 deriving instance Data SourceUnpackedness + +-- | @since 4.9.0.0 deriving instance Data SourceStrictness + +-- | @since 4.9.0.0 deriving instance Data DecidedStrictness diff --git a/libraries/base/Data/Dynamic.hs b/libraries/base/Data/Dynamic.hs index 55082ff3be..4cdde43336 100644 --- a/libraries/base/Data/Dynamic.hs +++ b/libraries/base/Data/Dynamic.hs @@ -69,6 +69,7 @@ import GHC.Exception -} data Dynamic = Dynamic TypeRep Obj +-- | @since 2.01 instance Show Dynamic where -- the instance just prints the type representation. showsPrec _ (Dynamic t _) = @@ -77,6 +78,7 @@ instance Show Dynamic where showString ">>" -- here so that it isn't an orphan: +-- | @since 4.0.0.0 instance Exception Dynamic type Obj = Any diff --git a/libraries/base/Data/Either.hs b/libraries/base/Data/Either.hs index db340923e1..8bef30be9c 100644 --- a/libraries/base/Data/Either.hs +++ b/libraries/base/Data/Either.hs @@ -124,15 +124,18 @@ Left "parse error" 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 diff --git a/libraries/base/Data/Fixed.hs b/libraries/base/Data/Fixed.hs index 150afb83c6..e5e1f2f746 100644 --- a/libraries/base/Data/Fixed.hs +++ b/libraries/base/Data/Fixed.hs @@ -66,6 +66,8 @@ tyFixed :: DataType 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 @@ withType foo = foo undefined 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 @@ instance Enum (Fixed a) where 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 @@ instance (HasResolution a) => Num (Fixed a) where 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 @@ showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZe 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 (Number n) 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 diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index 0defe6c07c..7443117cac 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -268,6 +268,7 @@ class Foldable t where -- instances for Prelude types +-- | @since 2.01 instance Foldable Maybe where foldr _ z Nothing = z foldr f z (Just x) = f x z @@ -275,6 +276,7 @@ instance Foldable Maybe where 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 +292,7 @@ instance Foldable [] where 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 +305,13 @@ instance Foldable (Either a) where 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 +323,7 @@ instance Foldable (Array i) where length = numElements null a = numElements a == 0 +-- | @since 4.7.0.0 instance Foldable Proxy where foldMap _ _ = mempty {-# INLINE foldMap #-} @@ -335,6 +341,7 @@ instance Foldable Proxy where sum _ = 0 product _ = 1 +-- | @since 4.8.0.0 instance Foldable Dual where foldMap = coerce @@ -353,6 +360,7 @@ instance Foldable Dual where sum = getDual toList (Dual x) = [x] +-- | @since 4.8.0.0 instance Foldable Sum where foldMap = coerce @@ -371,6 +379,7 @@ instance Foldable Sum where sum = getSum toList (Sum x) = [x] +-- | @since 4.8.0.0 instance Foldable Product where foldMap = coerce @@ -389,9 +398,11 @@ instance Foldable Product where 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 @@ -404,6 +415,7 @@ instance Foldable Last where 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 @@ -414,6 +426,7 @@ instance Ord a => Monoid (Max a) where | x >= y = Max m | otherwise = Max n +-- | @since 4.8.0.0 instance Ord a => Monoid (Min a) where mempty = Min Nothing @@ -425,6 +438,7 @@ instance Ord a => Monoid (Min a) where | otherwise = Min n -- Instances for GHC.Generics +-- | @since 4.9.0.0 instance Foldable U1 where foldMap _ _ = mempty {-# INLINE foldMap #-} diff --git a/libraries/base/Data/Functor/Classes.hs b/libraries/base/Data/Functor/Classes.hs index ce84af0533..460ecc128a 100644 --- a/libraries/base/Data/Functor/Classes.hs +++ b/libraries/base/Data/Functor/Classes.hs @@ -214,53 +214,64 @@ 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 +-- | @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 +-- | @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, @@ -269,89 +280,114 @@ instance Read2 (,) where (y,v) <- rp2 0 u, (")",w) <- lex v] +-- | @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 +-- | @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 +-- | @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 +-- | @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 +-- | @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 +-- | @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 +-- | @since 4.9.0.0 instance (Show a) => Show1 (Const a) where liftShowsPrec = liftShowsPrec2 showsPrec showList diff --git a/libraries/base/Data/Functor/Compose.hs b/libraries/base/Data/Functor/Compose.hs index d548836820..a09b2acafe 100644 --- a/libraries/base/Data/Functor/Compose.hs +++ b/libraries/base/Data/Functor/Compose.hs @@ -39,13 +39,16 @@ newtype Compose f g a = Compose { getCompose :: f (g a) } -- 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 @@ -53,6 +56,7 @@ instance (Read1 f, Read1 g) => Read1 (Compose f g) where rp' = liftReadsPrec rp rl rl' = liftReadList rp rl +-- | @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 +66,42 @@ instance (Show1 f, Show1 g) => Show1 (Compose f g) where -- 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 +-- | @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) +-- | @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) diff --git a/libraries/base/Data/Functor/Const.hs b/libraries/base/Data/Functor/Const.hs index 9f2db7f1dc..8f54b4204c 100644 --- a/libraries/base/Data/Functor/Const.hs +++ b/libraries/base/Data/Functor/Const.hs @@ -43,22 +43,29 @@ newtype Const a b = Const { getConst :: a } -- | 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 (<*>) = coerce (mappend :: m -> m -> m) diff --git a/libraries/base/Data/Functor/Identity.hs b/libraries/base/Data/Functor/Identity.hs index 4e6646a6ea..1adfaebeff 100644 --- a/libraries/base/Data/Functor/Identity.hs +++ b/libraries/base/Data/Functor/Identity.hs @@ -56,12 +56,16 @@ newtype Identity a = Identity { runIdentity :: a } -- | 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 +73,7 @@ instance (Show a) => Show (Identity a) where -- --------------------------------------------------------------------------- -- Identity instances for Functor and Monad +-- | @since 4.8.0.0 instance Foldable Identity where foldMap = coerce @@ -87,19 +92,24 @@ instance Foldable Identity where 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 +-- | @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)) +-- | @since 4.8.0.0 instance MonadZip Identity where mzipWith = coerce munzip = coerce diff --git a/libraries/base/Data/Functor/Product.hs b/libraries/base/Data/Functor/Product.hs index 9d6d6a62b9..a70f04b661 100644 --- a/libraries/base/Data/Functor/Product.hs +++ b/libraries/base/Data/Functor/Product.hs @@ -36,62 +36,82 @@ import GHC.Generics (Generic, Generic1) 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 +-- | @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 + +-- | @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 +-- | @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) +-- | @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) diff --git a/libraries/base/Data/Functor/Sum.hs b/libraries/base/Data/Functor/Sum.hs index f5bee11bad..9279de45f9 100644 --- a/libraries/base/Data/Functor/Sum.hs +++ b/libraries/base/Data/Functor/Sum.hs @@ -32,46 +32,57 @@ import GHC.Generics (Generic, Generic1) 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 +-- | @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 +-- | @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 diff --git a/libraries/base/Data/List/NonEmpty.hs b/libraries/base/Data/List/NonEmpty.hs index 2218fc8e17..1cba3e5301 100644 --- a/libraries/base/Data/List/NonEmpty.hs +++ b/libraries/base/Data/List/NonEmpty.hs @@ -122,15 +122,18 @@ infixr 5 :|, <| data NonEmpty a = a :| [a] deriving ( Eq, Ord, Show, Read, Data, Generic, Generic1 ) +-- | @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 @@ -175,22 +178,27 @@ unfoldr f a = case f a of 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 +-- | @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 +-- | @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 diff --git a/libraries/base/Data/Monoid.hs b/libraries/base/Data/Monoid.hs index 0a33c27cac..6ccdb34045 100644 --- a/libraries/base/Data/Monoid.hs +++ b/libraries/base/Data/Monoid.hs @@ -70,17 +70,21 @@ infixr 6 <> 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 @@ instance Monad Dual where 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 @@ instance Monoid (Endo a) where 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 @@ instance Monoid All where 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 @@ instance Monoid Any where 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 @@ instance Monad Sum where 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 @@ newtype First a = First { getFirst :: Maybe a } 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 @@ newtype Last a = Last { getLast :: Maybe a } 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 @@ newtype Alt f a = Alt {getAlt :: f a} 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) diff --git a/libraries/base/Data/Ord.hs b/libraries/base/Data/Ord.hs index 809f148070..767d7b379f 100644 --- a/libraries/base/Data/Ord.hs +++ b/libraries/base/Data/Ord.hs @@ -48,5 +48,6 @@ comparing p x y = compare (p x) (p y) -- @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 diff --git a/libraries/base/Data/Proxy.hs b/libraries/base/Data/Proxy.hs index a11155844c..2f619b241f 100644 --- a/libraries/base/Data/Proxy.hs +++ b/libraries/base/Data/Proxy.hs @@ -39,18 +39,23 @@ data KProxy (t :: *) = KProxy -- 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 @@ instance Enum (Proxy s) where enumFromThenTo _ _ _ = [Proxy] enumFromTo _ _ = [Proxy] +-- | @since 4.7.0.0 instance Ix (Proxy s) where range _ = [Proxy] index _ _ = 0 @@ -70,31 +76,37 @@ instance Ix (Proxy s) where unsafeIndex _ _ = 0 unsafeRangeSize _ = 1 +-- | @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'. diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs index ff1e4e21bc..24237a7877 100644 --- a/libraries/base/Data/Semigroup.hs +++ b/libraries/base/Data/Semigroup.hs @@ -142,15 +142,18 @@ class Semigroup a where 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 +163,7 @@ instance Semigroup [a] where 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 +174,69 @@ instance Semigroup a => Semigroup (Maybe a) where 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,28 +279,34 @@ stimesIdempotent n x | n <= 0 = errorWithoutStackTrace "stimesIdempotent: positive multiplier expected" | otherwise = x +-- | @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) @@ -292,6 +314,7 @@ instance Semigroup (NonEmpty a) where newtype Min a = Min { getMin :: a } 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) @@ -303,36 +326,45 @@ instance Enum a => Enum (Min a) where 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) +-- | @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) @@ -345,6 +377,7 @@ instance Num a => Num (Min a) where newtype Max a = Max { getMax :: a } 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) @@ -355,36 +388,45 @@ instance Enum a => Enum (Max a) where 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) +-- | @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) @@ -402,18 +444,23 @@ data Arg a b = Arg a b deriving 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 _) @@ -423,6 +470,7 @@ instance Ord a => Ord (Arg a b) where | 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) @@ -431,6 +479,7 @@ instance Bifunctor Arg where newtype First a = First { getFirst :: a } deriving (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) @@ -441,29 +490,36 @@ instance Enum a => Enum (First a) where 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) +-- | @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) @@ -472,6 +528,7 @@ instance MonadFix First where newtype Last a = Last { getLast :: a } deriving (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) @@ -482,30 +539,37 @@ instance Enum a => Enum (Last a) where 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) +-- | @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) @@ -513,13 +577,16 @@ instance MonadFix Last where newtype WrappedMonoid m = WrapMonoid { unwrapMonoid :: m } 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 = (<>) +-- | @since 4.9.0.0 instance Enum a => Enum (WrappedMonoid a) where succ (WrapMonoid a) = WrapMonoid (succ a) pred (WrapMonoid a) = WrapMonoid (pred a) @@ -552,9 +619,11 @@ mtimesDefault n x newtype Option a = Option { getOption :: Maybe a } 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) @@ -562,25 +631,31 @@ instance Applicative Option where 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 +-- | @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) @@ -589,6 +664,7 @@ instance Traversable Option where 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) @@ -598,6 +674,7 @@ instance Semigroup a => Semigroup (Option a) where 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 = (<>) @@ -606,6 +683,7 @@ instance Semigroup a => Monoid (Option a) where diff :: Semigroup m => m -> Endo m diff = Endo . (<>) +-- | @since 4.9.0.0 instance Semigroup (Proxy s) where _ <> _ = Proxy sconcat _ = Proxy diff --git a/libraries/base/Data/String.hs b/libraries/base/Data/String.hs index f341ff2415..db2f510b6a 100644 --- a/libraries/base/Data/String.hs +++ b/libraries/base/Data/String.hs @@ -75,9 +75,13 @@ A test case (should_run/overloadedstringsrun01.hs) has been added to 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 +-- | @since 4.9.0.0 instance IsString a => IsString (Const a b) where fromString = Const . fromString diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index b903b1d8bd..72e2dfd57f 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -177,25 +177,31 @@ class (Functor t, Foldable t) => Traversable t where -- 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 +-- | @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 +212,36 @@ instance Traversable Proxy where 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 -- Instances for GHC.Generics +-- | @since 4.9.0.0 instance Traversable U1 where traverse _ _ = pure U1 {-# INLINE traverse #-} @@ -270,9 +284,11 @@ forM = flip mapM -- 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 -> @@ -290,9 +306,11 @@ 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) } +-- | @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 -> @@ -324,9 +342,11 @@ foldMapDefault f = getConst . traverse (Const . f) newtype Id a = Id { getId :: a } +-- | @since 2.01 instance Functor Id where fmap f (Id x) = Id (f x) +-- | @since 2.01 instance Applicative Id where pure = Id Id f <*> Id x = Id (f x) diff --git a/libraries/base/Data/Type/Coercion.hs b/libraries/base/Data/Type/Coercion.hs index 00445bc2b9..254bb9aecf 100644 --- a/libraries/base/Data/Type/Coercion.hs +++ b/libraries/base/Data/Type/Coercion.hs @@ -72,15 +72,18 @@ deriving instance Eq (Coercion a b) 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 +-- | @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 @@ -90,8 +93,10 @@ class TestCoercion f where -- | 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.7.0.0 instance TestCoercion (Coercion a) where testCoercion Coercion Coercion = Just Coercion diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index b22b39d921..233020081b 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -67,6 +67,7 @@ class a ~~ b => (a :: k) ~ (b :: k) -- 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 @@ -122,15 +123,18 @@ deriving instance Eq (a :~: b) 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 +-- | @since 4.7.0.0 deriving instance a ~ b => Bounded (a :~: b) -- | This class contains types where you can learn the equality of two types @@ -140,6 +144,7 @@ class TestEquality f where -- | 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 diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index dfc089fb03..e19854ccd7 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -180,9 +180,11 @@ data TypeRep = TypeRep {-# UNPACK #-} !Fingerprint TyCon [KindRep] [TypeRep] type KindRep = TypeRep -- Compare keys for equality +-- | @since 2.01 instance Eq TypeRep where TypeRep x _ _ _ == TypeRep y _ _ _ = x == y +-- | @since 4.4.0.0 instance Ord TypeRep where TypeRep x _ _ _ <= TypeRep y _ _ _ = x <= y @@ -349,6 +351,7 @@ type Typeable7 (a :: * -> * -> * -> * -> * -> * -> * -> *) = Typeable a ----------------- Showing TypeReps -------------------- +-- | @since 2.01 instance Show TypeRep where showsPrec p (TypeRep _ tycon kinds tys) = case tys of diff --git a/libraries/base/Data/Version.hs b/libraries/base/Data/Version.hs index 6738ca881a..310d7387fb 100644 --- a/libraries/base/Data/Version.hs +++ b/libraries/base/Data/Version.hs @@ -98,11 +98,13 @@ data Version = {-# DEPRECATED versionTags "See GHC ticket #2496" #-} -- TODO. Remove all references to versionTags in GHC 8.0 release. +-- | @since 2.01 instance Eq Version where v1 == v2 = versionBranch v1 == versionBranch v2 && sort (versionTags v1) == sort (versionTags v2) -- tags may be in any order +-- | @since 2.01 instance Ord Version where v1 `compare` v2 = versionBranch v1 `compare` versionBranch v2 diff --git a/libraries/base/Data/Void.hs b/libraries/base/Data/Void.hs index 55ebd7e452..fd4c0b5b21 100644 --- a/libraries/base/Data/Void.hs +++ b/libraries/base/Data/Void.hs @@ -36,26 +36,32 @@ data Void deriving (Generic) deriving instance Data Void +-- | @since 4.8.0.0 instance Eq Void where _ == _ = True +-- | @since 4.8.0.0 instance Ord Void where compare _ _ = EQ -- | Reading a 'Void' value is always a parse error, considering -- 'Void' as a data type with no constructors. +-- | @since 4.8.0.0 instance Read Void where readsPrec _ _ = [] +-- | @since 4.8.0.0 instance Show Void where showsPrec _ = absurd +-- | @since 4.8.0.0 instance Ix Void where range _ = [] index _ = absurd inRange _ = absurd rangeSize _ = 0 +-- | @since 4.8.0.0 instance Exception Void -- | Since 'Void' values logically don't exist, this witnesses the diff --git a/libraries/base/Foreign/C/Error.hs b/libraries/base/Foreign/C/Error.hs index 761435183e..90b949b782 100644 --- a/libraries/base/Foreign/C/Error.hs +++ b/libraries/base/Foreign/C/Error.hs @@ -111,6 +111,7 @@ import GHC.Base newtype Errno = Errno CInt +-- | @since 2.01 instance Eq Errno where errno1@(Errno no1) == errno2@(Errno no2) | isValidErrno errno1 && isValidErrno errno2 = no1 == no2 diff --git a/libraries/base/Foreign/C/Types.hs b/libraries/base/Foreign/C/Types.hs index b725a4a11b..a16f838eed 100644 --- a/libraries/base/Foreign/C/Types.hs +++ b/libraries/base/Foreign/C/Types.hs @@ -188,6 +188,7 @@ ARITHMETIC_TYPE(CTime,HTYPE_TIME_T) -- | Haskell type representing the C @useconds_t@ type. -- -- @since 4.4.0.0 + ARITHMETIC_TYPE(CUSeconds,HTYPE_USECONDS_T) -- | Haskell type representing the C @suseconds_t@ type. -- diff --git a/libraries/base/Foreign/Storable.hs b/libraries/base/Foreign/Storable.hs index 5b657a19e3..a58e0db069 100644 --- a/libraries/base/Foreign/Storable.hs +++ b/libraries/base/Foreign/Storable.hs @@ -145,6 +145,7 @@ class Storable a where peek ptr = peekElemOff ptr 0 poke ptr = pokeElemOff ptr 0 +-- | @since 4.9.0.0 instance Storable () where sizeOf _ = 0 alignment _ = 1 @@ -153,6 +154,7 @@ instance Storable () where -- System-dependent, but rather obvious instances +-- | @since 2.01 instance Storable Bool where sizeOf _ = sizeOf (undefined::HTYPE_INT) alignment _ = alignment (undefined::HTYPE_INT) @@ -166,54 +168,71 @@ instance Storable (T) where { \ peekElemOff = read; \ pokeElemOff = write } +-- | @since 2.01 STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32, readWideCharOffPtr,writeWideCharOffPtr) +-- | @since 2.01 STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT, readIntOffPtr,writeIntOffPtr) +-- | @since 2.01 STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD, readWordOffPtr,writeWordOffPtr) +-- | @since 2.01 STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR, readPtrOffPtr,writePtrOffPtr) +-- | @since 2.01 STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR, readFunPtrOffPtr,writeFunPtrOffPtr) +-- | @since 2.01 STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR, readStablePtrOffPtr,writeStablePtrOffPtr) +-- | @since 2.01 STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT, readFloatOffPtr,writeFloatOffPtr) +-- | @since 2.01 STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE, readDoubleOffPtr,writeDoubleOffPtr) +-- | @since 2.01 STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8, readWord8OffPtr,writeWord8OffPtr) +-- | @since 2.01 STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16, readWord16OffPtr,writeWord16OffPtr) +-- | @since 2.01 STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32, readWord32OffPtr,writeWord32OffPtr) +-- | @since 2.01 STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64, readWord64OffPtr,writeWord64OffPtr) +-- | @since 2.01 STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8, readInt8OffPtr,writeInt8OffPtr) +-- | @since 2.01 STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16, readInt16OffPtr,writeInt16OffPtr) +-- | @since 2.01 STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32, readInt32OffPtr,writeInt32OffPtr) +-- | @since 2.01 STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64, readInt64OffPtr,writeInt64OffPtr) +-- | @since 4.8.0.0 instance (Storable a, Integral a) => Storable (Ratio a) where sizeOf _ = 2 * sizeOf (undefined :: a) alignment _ = alignment (undefined :: a ) @@ -228,6 +247,7 @@ instance (Storable a, Integral a) => Storable (Ratio a) where pokeElemOff q 1 i -- XXX: here to avoid orphan instance in GHC.Fingerprint +-- | @since 4.4.0.0 instance Storable Fingerprint where sizeOf _ = 16 alignment _ = 8 diff --git a/libraries/base/GHC/Arr.hs b/libraries/base/GHC/Arr.hs index c736f56c66..adfd602d9d 100644 --- a/libraries/base/GHC/Arr.hs +++ b/libraries/base/GHC/Arr.hs @@ -182,6 +182,7 @@ hopelessIndexError :: Int -- Try to use 'indexError' instead! hopelessIndexError = errorWithoutStackTrace "Error in array index" ---------------------------------------------------------------------- +-- | @since 2.01 instance Ix Char where {-# INLINE range #-} range (m,n) = [m..n] @@ -197,6 +198,7 @@ instance Ix Char where inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- +-- | @since 2.01 instance Ix Int where {-# INLINE range #-} -- The INLINE stops the build in the RHS from getting inlined, @@ -214,12 +216,14 @@ instance Ix Int where {-# INLINE inRange #-} inRange (I# m,I# n) (I# i) = isTrue# (m <=# i) && isTrue# (i <=# n) +-- | @since 4.6.0.0 instance Ix Word where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- +-- | @since 2.01 instance Ix Integer where {-# INLINE range #-} range (m,n) = [m..n] @@ -235,6 +239,7 @@ instance Ix Integer where inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- +-- | @since 2.01 instance Ix Bool where -- as derived {-# INLINE range #-} range (m,n) = [m..n] @@ -250,6 +255,7 @@ instance Ix Bool where -- as derived inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u ---------------------------------------------------------------------- +-- | @since 2.01 instance Ix Ordering where -- as derived {-# INLINE range #-} range (m,n) = [m..n] @@ -265,6 +271,7 @@ instance Ix Ordering where -- as derived inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u ---------------------------------------------------------------------- +-- | @since 2.01 instance Ix () where {-# INLINE range #-} range ((), ()) = [()] @@ -277,6 +284,7 @@ instance Ix () where index b i = unsafeIndex b i ---------------------------------------------------------------------- +-- | @since 2.01 instance (Ix a, Ix b) => Ix (a, b) where -- as derived {-# SPECIALISE instance Ix (Int,Int) #-} @@ -295,6 +303,7 @@ instance (Ix a, Ix b) => Ix (a, b) where -- as derived -- Default method for index ---------------------------------------------------------------------- +-- | @since 2.01 instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where {-# SPECIALISE instance Ix (Int,Int,Int) #-} @@ -315,6 +324,7 @@ instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where -- Default method for index ---------------------------------------------------------------------- +-- | @since 2.01 instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where range ((l1,l2,l3,l4),(u1,u2,u3,u4)) = [(i1,i2,i3,i4) | i1 <- range (l1,u1), @@ -333,7 +343,7 @@ instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where inRange (l3,u3) i3 && inRange (l4,u4) i4 -- Default method for index - +-- | @since 2.01 instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) = [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1), @@ -390,6 +400,7 @@ type role Array nominal representational type role STArray nominal nominal representational -- Just pointer equality on mutable arrays: +-- | @since 2.01 instance Eq (STArray s i e) where STArray _ _ _ arr1# == STArray _ _ _ arr2# = isTrue# (sameMutableArray# arr1# arr2#) @@ -788,15 +799,19 @@ cmpIntArray arr1@(Array l1 u1 n1 _) arr2@(Array l2 u2 n2 _) = ---------------------------------------------------------------------- -- Array instances +-- | @since 2.01 instance Functor (Array i) where fmap = amap +-- | @since 2.01 instance (Ix i, Eq e) => Eq (Array i e) where (==) = eqArray +-- | @since 2.01 instance (Ix i, Ord e) => Ord (Array i e) where compare = cmpArray +-- | @since 2.01 instance (Ix a, Show a, Show b) => Show (Array a b) where showsPrec p a = showParen (p > appPrec) $ diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 618fa05314..9e4467be5e 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -237,6 +237,7 @@ class Monoid a where mconcat = foldr mappend mempty +-- | @since 2.01 instance Monoid [a] where {-# INLINE mempty #-} mempty = [] @@ -265,32 +266,38 @@ needed to make foldr/build forms efficient are turned off, we'll get reasonably efficient translations anyway. -} +-- | @since 2.01 instance Monoid b => Monoid (a -> b) where mempty _ = mempty mappend f g x = f x `mappend` g x +-- | @since 2.01 instance Monoid () where -- Should it be strict? mempty = () _ `mappend` _ = () mconcat _ = () +-- | @since 2.01 instance (Monoid a, Monoid b) => Monoid (a,b) where mempty = (mempty, mempty) (a1,b1) `mappend` (a2,b2) = (a1 `mappend` a2, b1 `mappend` b2) +-- | @since 2.01 instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where mempty = (mempty, mempty, mempty) (a1,b1,c1) `mappend` (a2,b2,c2) = (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2) +-- | @since 2.01 instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where mempty = (mempty, mempty, mempty, mempty) (a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) = (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2, d1 `mappend` d2) +-- | @since 2.01 instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => Monoid (a,b,c,d,e) where mempty = (mempty, mempty, mempty, mempty, mempty) @@ -299,6 +306,7 @@ instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => d1 `mappend` d2, e1 `mappend` e2) -- lexicographical ordering +-- | @since 2.01 instance Monoid Ordering where mempty = EQ LT `mappend` _ = LT @@ -311,19 +319,24 @@ instance Monoid Ordering where -- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S@.\" Since -- there is no \"Semigroup\" typeclass providing just 'mappend', we -- use 'Monoid' instead. +-- +-- @since 2.01 instance Monoid a => Monoid (Maybe a) where mempty = Nothing Nothing `mappend` m = m m `mappend` Nothing = m Just m1 `mappend` Just m2 = Just (m1 `mappend` m2) +-- | @since 2.01 instance Monoid a => Applicative ((,) a) where pure x = (mempty, x) (u, f) <*> (v, x) = (u `mappend` v, f x) +-- | @since 4.9.0.0 instance Monoid a => Monad ((,) a) where (u, a) >>= k = case k a of (v, b) -> (u `mappend` v, b) +-- | @since 4.9.0.0 instance Monoid a => Monoid (IO a) where mempty = pure mempty mappend = liftA2 mappend @@ -635,24 +648,29 @@ ap m1 m2 = do { x1 <- m1; x2 <- m2; return (x1 x2) } -- instances for Prelude types +-- | @since 2.01 instance Functor ((->) r) where fmap = (.) +-- | @since 2.01 instance Applicative ((->) a) where pure = const (<*>) f g x = f x (g x) +-- | @since 2.01 instance Monad ((->) r) where f >>= k = \ r -> k (f r) r +-- | @since 2.01 instance Functor ((,) a) where fmap f (x,y) = (x, f y) - +-- | @since 2.01 instance Functor Maybe where fmap _ Nothing = Nothing fmap f (Just a) = Just (f a) +-- | @since 2.01 instance Applicative Maybe where pure = Just @@ -662,6 +680,7 @@ instance Applicative Maybe where Just _m1 *> m2 = m2 Nothing *> _m2 = Nothing +-- | @since 2.01 instance Monad Maybe where (Just x) >>= k = k x Nothing >>= _ = Nothing @@ -704,6 +723,7 @@ class Applicative f => Alternative f where some_v = (fmap (:) v) <*> many_v +-- | @since 2.01 instance Alternative Maybe where empty = Nothing Nothing <|> r = r @@ -726,16 +746,19 @@ class (Alternative m, Monad m) => MonadPlus m where mplus :: m a -> m a -> m a mplus = (<|>) +-- | @since 2.01 instance MonadPlus Maybe ---------------------------------------------- -- The list type +-- | @since 2.01 instance Functor [] where {-# INLINE fmap #-} fmap = map -- See Note: [List comprehensions and inlining] +-- | @since 2.01 instance Applicative [] where {-# INLINE pure #-} pure x = [x] @@ -745,6 +768,7 @@ instance Applicative [] where xs *> ys = [y | _ <- xs, y <- ys] -- See Note: [List comprehensions and inlining] +-- | @since 2.01 instance Monad [] where {-# INLINE (>>=) #-} xs >>= f = [y | x <- xs, y <- f x] @@ -753,10 +777,12 @@ instance Monad [] where {-# INLINE fail #-} fail _ = [] +-- | @since 2.01 instance Alternative [] where empty = [] (<|>) = (++) +-- | @since 2.01 instance MonadPlus [] {- @@ -1022,7 +1048,6 @@ breakpointCond :: Bool -> a -> a breakpointCond _ r = r data Opaque = forall a. O a - -- | @const x@ is a unary function which evaluates to @x@ for all inputs. -- -- For instance, @@ -1080,9 +1105,11 @@ asTypeOf = const -- Functor/Applicative/Monad instances for IO ---------------------------------------------- +-- | @since 2.01 instance Functor IO where fmap f x = x >>= (pure . f) +-- | @since 2.01 instance Applicative IO where {-# INLINE pure #-} {-# INLINE (*>) #-} @@ -1090,6 +1117,7 @@ instance Applicative IO where (*>) = thenIO (<*>) = ap +-- | @since 2.01 instance Monad IO where {-# INLINE (>>) #-} {-# INLINE (>>=) #-} @@ -1097,10 +1125,12 @@ instance Monad IO where (>>=) = bindIO fail s = failIO s +-- | @since 4.9.0.0 instance Alternative IO where empty = failIO "mzero" (<|>) = mplusIO +-- | @since 4.9.0.0 instance MonadPlus IO returnIO :: a -> IO a diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs index 2a5164b798..5476950ec7 100644 --- a/libraries/base/GHC/Conc/Sync.hs +++ b/libraries/base/GHC/Conc/Sync.hs @@ -145,6 +145,7 @@ This misfeature will hopefully be corrected at a later date. -} +-- | @since 4.2.0.0 instance Show ThreadId where showsPrec d t = showString "ThreadId " . @@ -165,12 +166,14 @@ cmpThread t1 t2 = 0 -> EQ _ -> GT -- must be 1 +-- | @since 4.2.0.0 instance Eq ThreadId where t1 == t2 = case t1 `cmpThread` t2 of EQ -> True _ -> False +-- | @since 4.2.0.0 instance Ord ThreadId where compare = cmpThread @@ -625,9 +628,11 @@ newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #)) unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #)) unSTM (STM a) = a +-- | @since 4.3.0.0 instance Functor STM where fmap f x = x >>= (pure . f) +-- | @since 4.8.0.0 instance Applicative STM where {-# INLINE pure #-} {-# INLINE (*>) #-} @@ -635,6 +640,7 @@ instance Applicative STM where (<*>) = ap m *> k = thenSTM m k +-- | @since 4.3.0.0 instance Monad STM where {-# INLINE (>>=) #-} m >>= k = bindSTM m k @@ -655,10 +661,12 @@ thenSTM (STM m) k = STM ( \s -> returnSTM :: a -> STM a returnSTM x = STM (\s -> (# s, x #)) +-- | @since 4.8.0.0 instance Alternative STM where empty = retry (<|>) = orElse +-- | @since 4.3.0.0 instance MonadPlus STM -- | Unsafely performs IO in the STM monad. Beware: this is a highly @@ -769,6 +777,7 @@ always i = alwaysSucceeds ( do v <- i -- |Shared memory locations that support atomic memory transactions. data TVar a = TVar (TVar# RealWorld a) +-- | @since 4.8.0.0 instance Eq (TVar a) where (TVar tvar1#) == (TVar tvar2#) = isTrue# (sameTVar# tvar1# tvar2#) diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs index c0e2f5a783..e09d2a9bfa 100644 --- a/libraries/base/GHC/Enum.hs +++ b/libraries/base/GHC/Enum.hs @@ -154,7 +154,10 @@ predError inst_ty = -- Tuples ------------------------------------------------------------------------ +-- | @since 2.01 deriving instance Bounded () + +-- | @since 2.01 instance Enum () where succ _ = errorWithoutStackTrace "Prelude.Enum.().succ: bad argument" pred _ = errorWithoutStackTrace "Prelude.Enum.().pred: bad argument" @@ -169,44 +172,58 @@ instance Enum () where enumFromThenTo () () () = let many = ():many in many -- Report requires instances up to 15 +-- | @since 2.01 deriving instance (Bounded a, Bounded b) => Bounded (a,b) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c) => Bounded (a,b,c) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d) => Bounded (a,b,c,d) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e) => Bounded (a,b,c,d,e) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f) => Bounded (a,b,c,d,e,f) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g) => Bounded (a,b,c,d,e,f,g) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h) => Bounded (a,b,c,d,e,f,g,h) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i) => Bounded (a,b,c,d,e,f,g,h,i) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j) => Bounded (a,b,c,d,e,f,g,h,i,j) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k) => Bounded (a,b,c,d,e,f,g,h,i,j,k) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k, Bounded l) => Bounded (a,b,c,d,e,f,g,h,i,j,k,l) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m) => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m, Bounded n) => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m, Bounded n, Bounded o) @@ -216,7 +233,10 @@ deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, -- Bool ------------------------------------------------------------------------ +-- | @since 2.01 deriving instance Bounded Bool + +-- | @since 2.01 instance Enum Bool where succ False = True succ True = errorWithoutStackTrace "Prelude.Enum.Bool.succ: bad argument" @@ -239,7 +259,9 @@ instance Enum Bool where -- Ordering ------------------------------------------------------------------------ +-- | @since 2.01 deriving instance Bounded Ordering +-- | @since 2.01 instance Enum Ordering where succ LT = EQ succ EQ = GT @@ -266,10 +288,12 @@ instance Enum Ordering where -- Char ------------------------------------------------------------------------ +-- | @since 2.01 instance Bounded Char where minBound = '\0' maxBound = '\x10FFFF' +-- | @since 2.01 instance Enum Char where succ (C# c#) | isTrue# (ord# c# /=# 0x10FFFF#) = C# (chr# (ord# c# +# 1#)) @@ -393,10 +417,12 @@ Be careful about these instances. (c) remember that Int is bounded, so [1..] terminates at maxInt -} +-- | @since 2.01 instance Bounded Int where minBound = minInt maxBound = maxInt +-- | @since 2.01 instance Enum Int where succ x | x == maxBound = errorWithoutStackTrace "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound" @@ -559,6 +585,7 @@ efdtIntDnFB c n x1 x2 y -- Be careful about underflow! -- Word ------------------------------------------------------------------------ +-- | @since 2.01 instance Bounded Word where minBound = 0 @@ -572,6 +599,7 @@ instance Bounded Word where #error Unhandled value for WORD_SIZE_IN_BITS #endif +-- | @since 2.01 instance Enum Word where succ x | x /= maxBound = x + 1 @@ -611,6 +639,7 @@ wordToIntegerX (W# x#) = wordToInteger x# -- Integer ------------------------------------------------------------------------ +-- | @since 2.01 instance Enum Integer where succ x = x + 1 pred x = x - 1 diff --git a/libraries/base/GHC/Event/EPoll.hsc b/libraries/base/GHC/Event/EPoll.hsc index 26b6861004..47e69a68e0 100644 --- a/libraries/base/GHC/Event/EPoll.hsc +++ b/libraries/base/GHC/Event/EPoll.hsc @@ -136,6 +136,7 @@ data Event = Event { , eventFd :: Fd } deriving (Show) +-- | @since 4.3.1.0 instance Storable Event where sizeOf _ = #size struct epoll_event alignment _ = alignment (undefined :: CInt) diff --git a/libraries/base/GHC/Event/Internal.hs b/libraries/base/GHC/Event/Internal.hs index a093352ba9..7024714fdf 100644 --- a/libraries/base/GHC/Event/Internal.hs +++ b/libraries/base/GHC/Event/Internal.hs @@ -62,6 +62,7 @@ evtClose = Event 4 eventIs :: Event -> Event -> Bool eventIs (Event a) (Event b) = a .&. b /= 0 +-- | @since 4.3.1.0 instance Show Event where show e = '[' : (intercalate "," . filter (not . null) $ [evtRead `so` "evtRead", @@ -70,6 +71,7 @@ instance Show Event where where ev `so` disp | e `eventIs` ev = disp | otherwise = "" +-- | @since 4.3.1.0 instance Monoid Event where mempty = evtNothing mappend = evtCombine @@ -98,6 +100,8 @@ elSupremum _ _ = MultiShot {-# INLINE elSupremum #-} -- | @mappend@ == @elSupremum@ +-- +-- @since 4.8.0.0 instance Monoid Lifetime where mempty = OneShot mappend = elSupremum @@ -109,6 +113,7 @@ instance Monoid Lifetime where newtype EventLifetime = EL Int deriving (Show, Eq) +-- | @since 4.8.0.0 instance Monoid EventLifetime where mempty = EL 0 EL a `mappend` EL b = EL (a .|. b) diff --git a/libraries/base/GHC/Event/KQueue.hsc b/libraries/base/GHC/Event/KQueue.hsc index 1068ec0136..d6461c2647 100644 --- a/libraries/base/GHC/Event/KQueue.hsc +++ b/libraries/base/GHC/Event/KQueue.hsc @@ -142,6 +142,7 @@ data Event = KEvent { event :: Fd -> Filter -> Flag -> FFlag -> Event event fd filt flag fflag = KEvent (fromIntegral fd) filt flag fflag 0 nullPtr +-- | @since 4.3.1.0 instance Storable Event where sizeOf _ = #size struct kevent alignment _ = alignment (undefined :: CInt) @@ -202,6 +203,7 @@ data TimeSpec = TimeSpec { , tv_nsec :: {-# UNPACK #-} !CLong } +-- | @since 4.3.1.0 instance Storable TimeSpec where sizeOf _ = #size struct timespec alignment _ = alignment (undefined :: CInt) diff --git a/libraries/base/GHC/Event/PSQ.hs b/libraries/base/GHC/Event/PSQ.hs index e61c31b1b4..a4c0ccc23c 100644 --- a/libraries/base/GHC/Event/PSQ.hs +++ b/libraries/base/GHC/Event/PSQ.hs @@ -479,6 +479,7 @@ infixr 5 <> seqToList :: Sequ a -> [a] seqToList (Sequ x) = x [] +-- | @since 4.3.1.0 instance Show a => Show (Sequ a) where showsPrec d a = showsPrec d (seqToList a) diff --git a/libraries/base/GHC/Event/Poll.hsc b/libraries/base/GHC/Event/Poll.hsc index b128572e71..330007c317 100644 --- a/libraries/base/GHC/Event/Poll.hsc +++ b/libraries/base/GHC/Event/Poll.hsc @@ -187,6 +187,7 @@ toEvent e = remap (pollIn .|. pollErr .|. pollHup) E.evtRead `mappend` | e .&. evt /= 0 = to | otherwise = mempty +-- | @since 4.3.1.0 instance Storable PollFd where sizeOf _ = #size struct pollfd alignment _ = alignment (undefined :: CInt) diff --git a/libraries/base/GHC/Event/Unique.hs b/libraries/base/GHC/Event/Unique.hs index d3af627cbd..abdd3fe7f2 100644 --- a/libraries/base/GHC/Event/Unique.hs +++ b/libraries/base/GHC/Event/Unique.hs @@ -27,6 +27,7 @@ newtype UniqueSource = US (TVar Int64) newtype Unique = Unique { asInt64 :: Int64 } deriving (Eq, Ord, Num) +-- | @since 4.3.1.0 instance Show Unique where show = show . asInt64 diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index aeaef20805..d2b5e209cc 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -50,6 +50,7 @@ encapsulated in a @SomeException@. -} data SomeException = forall e . Exception e => SomeException e +-- | @since 3.0 instance Show SomeException where showsPrec p (SomeException e) = showsPrec p e @@ -154,6 +155,7 @@ class (Typeable e, Show e) => Exception e where displayException :: e -> String displayException = show +-- | @since 3.0 instance Exception SomeException where toException se = se fromException = Just @@ -173,8 +175,10 @@ pattern ErrorCall :: String -> ErrorCall pattern ErrorCall err <- ErrorCallWithLocation err _ where ErrorCall err = ErrorCallWithLocation err "" +-- | @since 4.0.0.0 instance Exception ErrorCall +-- | @since 4.0.0.0 instance Show ErrorCall where showsPrec _ (ErrorCallWithLocation err "") = showString err showsPrec _ (ErrorCallWithLocation err loc) = showString (err ++ '\n' : loc) @@ -239,8 +243,10 @@ divZeroException = toException DivideByZero overflowException = toException Overflow ratioZeroDenomException = toException RatioZeroDenominator +-- | @since 4.0.0.0 instance Exception ArithException +-- | @since 4.0.0.0 instance Show ArithException where showsPrec _ Overflow = showString "arithmetic overflow" showsPrec _ Underflow = showString "arithmetic underflow" diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index 35d344cb55..2e047e306b 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -187,6 +187,7 @@ class IsList l where -- It should satisfy fromList . toList = id. toList :: l -> [Item l] +-- | @since 4.7.0.0 instance IsList [a] where type (Item [a]) = a fromList = id diff --git a/libraries/base/GHC/Fingerprint/Type.hs b/libraries/base/GHC/Fingerprint/Type.hs index 73720370dc..1ad34a7791 100644 --- a/libraries/base/GHC/Fingerprint/Type.hs +++ b/libraries/base/GHC/Fingerprint/Type.hs @@ -24,6 +24,7 @@ import Numeric (showHex) data Fingerprint = Fingerprint {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 deriving (Eq, Ord) +-- | @since 4.7.0.0 instance Show Fingerprint where show (Fingerprint w1 w2) = hex16 w1 ++ hex16 w2 where diff --git a/libraries/base/GHC/Float.hs b/libraries/base/GHC/Float.hs index 7c6995a18d..18dd288dd6 100644 --- a/libraries/base/GHC/Float.hs +++ b/libraries/base/GHC/Float.hs @@ -239,6 +239,7 @@ class (RealFrac a, Floating a) => RealFloat a where -- Float ------------------------------------------------------------------------ +-- | @since 2.01 instance Num Float where (+) x y = plusFloat x y (-) x y = minusFloat x y @@ -254,6 +255,7 @@ instance Num Float where {-# INLINE fromInteger #-} fromInteger i = F# (floatFromInteger i) +-- | @since 2.01 instance Real Float where toRational (F# x#) = case decodeFloat_Int# x# of @@ -266,6 +268,7 @@ instance Real Float where | otherwise -> smallInteger m# :% shiftLInteger 1 (negateInt# e#) +-- | @since 2.01 instance Fractional Float where (/) x y = divideFloat x y {-# INLINE fromRational #-} @@ -299,6 +302,7 @@ rationalToFloat n d "ceiling/Float->Int" ceiling = ceilingFloatInt "round/Float->Int" round = roundFloatInt #-} +-- | @since 2.01 instance RealFrac Float where -- ceiling, floor, and truncate are all small @@ -342,6 +346,7 @@ instance RealFrac Float where floor x = case properFraction x of (n,r) -> if r < 0.0 then n - 1 else n +-- | @since 2.01 instance Floating Float where pi = 3.141592653589793238 exp x = expFloat x @@ -376,6 +381,7 @@ instance Floating Float where | otherwise = a {-# INLINE log1pexp #-} +-- | @since 2.01 instance RealFloat Float where floatRadix _ = FLT_RADIX -- from float.h floatDigits _ = FLT_MANT_DIG -- ditto @@ -406,6 +412,7 @@ instance RealFloat Float where isNegativeZero x = 0 /= isFloatNegativeZero x isIEEE _ = True +-- | @since 2.01 instance Show Float where showsPrec x = showSignedFloat showFloat x showList = showList__ (showsPrec 0) @@ -414,6 +421,7 @@ instance Show Float where -- Double ------------------------------------------------------------------------ +-- | @since 2.01 instance Num Double where (+) x y = plusDouble x y (-) x y = minusDouble x y @@ -431,6 +439,7 @@ instance Num Double where fromInteger i = D# (doubleFromInteger i) +-- | @since 2.01 instance Real Double where toRational (D# x#) = case decodeDoubleInteger x# of @@ -443,6 +452,7 @@ instance Real Double where | otherwise -> m :% shiftLInteger 1 (negateInt# e#) +-- | @since 2.01 instance Fractional Double where (/) x y = divideDouble x y {-# INLINE fromRational #-} @@ -463,6 +473,7 @@ rationalToDouble n d minEx = DBL_MIN_EXP mantDigs = DBL_MANT_DIG +-- | @since 2.01 instance Floating Double where pi = 3.141592653589793238 exp x = expDouble x @@ -510,6 +521,7 @@ instance Floating Double where "ceiling/Double->Int" ceiling = ceilingDoubleInt "round/Double->Int" round = roundDoubleInt #-} +-- | @since 2.01 instance RealFrac Double where -- ceiling, floor, and truncate are all small @@ -546,6 +558,7 @@ instance RealFrac Double where floor x = case properFraction x of (n,r) -> if r < 0.0 then n - 1 else n +-- | @since 2.01 instance RealFloat Double where floatRadix _ = FLT_RADIX -- from float.h floatDigits _ = DBL_MANT_DIG -- ditto @@ -577,6 +590,7 @@ instance RealFloat Double where isNegativeZero x = 0 /= isDoubleNegativeZero x isIEEE _ = True +-- | @since 2.01 instance Show Double where showsPrec x = showSignedFloat showFloat x showList = showList__ (showsPrec 0) @@ -601,6 +615,7 @@ a `non-lossy' conversion to and from Ints. Instead we make use of the for these (@numericEnumFromTo@ and @numericEnumFromThenTo@ below.) -} +-- | @since 2.01 instance Enum Float where succ x = x + 1 pred x = x - 1 @@ -611,6 +626,7 @@ instance Enum Float where enumFromThen = numericEnumFromThen enumFromThenTo = numericEnumFromThenTo +-- | @since 2.01 instance Enum Double where succ x = x + 1 pred x = x - 1 diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index 6d03967d3b..aaad3c61e0 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -90,12 +90,15 @@ data ForeignPtrContents | MallocPtr (MutableByteArray# RealWorld) !(IORef Finalizers) | PlainPtr (MutableByteArray# RealWorld) +-- | @since 2.01 instance Eq (ForeignPtr a) where p == q = unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q +-- | @since 2.01 instance Ord (ForeignPtr a) where compare p q = compare (unsafeForeignPtrToPtr p) (unsafeForeignPtrToPtr q) +-- | @since 2.01 instance Show (ForeignPtr a) where showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f) diff --git a/libraries/base/GHC/GHCi.hs b/libraries/base/GHC/GHCi.hs index 514a33cc13..84093afbf1 100644 --- a/libraries/base/GHC/GHCi.hs +++ b/libraries/base/GHC/GHCi.hs @@ -28,22 +28,27 @@ import GHC.Base (IO(), Monad, Functor(fmap), Applicative(..), (>>=), id, (.), ap class (Monad m) => GHCiSandboxIO m where ghciStepIO :: m a -> IO a +-- | @since 4.4.0.0 instance GHCiSandboxIO IO where ghciStepIO = id -- | A monad that doesn't allow any IO. newtype NoIO a = NoIO { noio :: IO a } +-- | @since 4.8.0.0 instance Functor NoIO where fmap f (NoIO a) = NoIO (fmap f a) +-- | @since 4.8.0.0 instance Applicative NoIO where pure a = NoIO (pure a) (<*>) = ap +-- | @since 4.4.0.0 instance Monad NoIO where (>>=) k f = NoIO (noio k >>= noio . f) +-- | @since 4.4.0.0 instance GHCiSandboxIO NoIO where ghciStepIO = noio diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index e45b761026..907d56b0bd 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -756,42 +756,53 @@ deriving instance Show (V1 p) data U1 (p :: k) = U1 deriving (Generic, Generic1) +-- | @since 4.9.0.0 instance Eq (U1 p) where _ == _ = True +-- | @since 4.9.0.0 instance Ord (U1 p) where compare _ _ = EQ +-- | @since 4.9.0.0 instance Read (U1 p) where readsPrec d = readParen (d > 10) (\r -> [(U1, s) | ("U1",s) <- lex r ]) +-- | @since 4.9.0.0 instance Show (U1 p) where showsPrec _ _ = showString "U1" +-- | @since 4.9.0.0 instance Functor U1 where fmap _ _ = U1 +-- | @since 4.9.0.0 instance Applicative U1 where pure _ = U1 _ <*> _ = U1 +-- | @since 4.9.0.0 instance Alternative U1 where empty = U1 _ <|> _ = U1 +-- | @since 4.9.0.0 instance Monad U1 where _ >>= _ = U1 +-- | @since 4.9.0.0 instance MonadPlus U1 -- | Used for marking occurrences of the parameter newtype Par1 p = Par1 { unPar1 :: p } deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1) +-- | @since 4.9.0.0 instance Applicative Par1 where pure a = Par1 a Par1 f <*> Par1 x = Par1 (f x) +-- | @since 4.9.0.0 instance Monad Par1 where Par1 x >>= f = f x @@ -800,34 +811,42 @@ instance Monad Par1 where newtype Rec1 (f :: k -> *) (p :: k) = Rec1 { unRec1 :: f p } deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1) +-- | @since 4.9.0.0 instance Applicative f => Applicative (Rec1 f) where pure a = Rec1 (pure a) Rec1 f <*> Rec1 x = Rec1 (f <*> x) +-- | @since 4.9.0.0 instance Alternative f => Alternative (Rec1 f) where empty = Rec1 empty Rec1 l <|> Rec1 r = Rec1 (l <|> r) +-- | @since 4.9.0.0 instance Monad f => Monad (Rec1 f) where Rec1 x >>= f = Rec1 (x >>= \a -> unRec1 (f a)) +-- | @since 4.9.0.0 instance MonadPlus f => MonadPlus (Rec1 f) -- | Constants, additional parameters and recursion of kind @*@ newtype K1 (i :: *) c (p :: k) = K1 { unK1 :: c } deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1) +-- | @since 4.9.0.0 instance Applicative f => Applicative (M1 i c f) where pure a = M1 (pure a) M1 f <*> M1 x = M1 (f <*> x) +-- | @since 4.9.0.0 instance Alternative f => Alternative (M1 i c f) where empty = M1 empty M1 l <|> M1 r = M1 (l <|> r) +-- | @since 4.9.0.0 instance Monad f => Monad (M1 i c f) where M1 x >>= f = M1 (x >>= \a -> unM1 (f a)) +-- | @since 4.9.0.0 instance MonadPlus f => MonadPlus (M1 i c f) -- | Meta-information (constructor names, etc.) @@ -844,20 +863,24 @@ infixr 6 :*: data (:*:) (f :: k -> *) (g :: k -> *) (p :: k) = f p :*: g p deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1) +-- | @since 4.9.0.0 instance (Applicative f, Applicative g) => Applicative (f :*: g) where pure a = pure a :*: pure a (f :*: g) <*> (x :*: y) = (f <*> x) :*: (g <*> y) +-- | @since 4.9.0.0 instance (Alternative f, Alternative g) => Alternative (f :*: g) where empty = empty :*: empty (x1 :*: y1) <|> (x2 :*: y2) = (x1 <|> x2) :*: (y1 <|> y2) +-- | @since 4.9.0.0 instance (Monad f, Monad g) => Monad (f :*: g) where (m :*: n) >>= f = (m >>= \a -> fstP (f a)) :*: (n >>= \a -> sndP (f a)) where fstP (a :*: _) = a sndP (_ :*: b) = b +-- | @since 4.9.0.0 instance (MonadPlus f, MonadPlus g) => MonadPlus (f :*: g) -- | Composition of functors @@ -866,10 +889,12 @@ newtype (:.:) (f :: k2 -> *) (g :: k1 -> k2) (p :: k1) = Comp1 { unComp1 :: f (g p) } deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1) +-- | @since 4.9.0.0 instance (Applicative f, Applicative g) => Applicative (f :.: g) where pure x = Comp1 (pure (pure x)) Comp1 f <*> Comp1 x = Comp1 (fmap (<*>) f <*> x) +-- | @since 4.9.0.0 instance (Alternative f, Applicative g) => Alternative (f :.: g) where empty = Comp1 empty Comp1 x <|> Comp1 y = Comp1 (x <|> y) @@ -923,18 +948,22 @@ type UAddr = URec (Ptr ()) -- -- @since 4.9.0.0 type UChar = URec Char + -- | Type synonym for @'URec' 'Double#'@ -- -- @since 4.9.0.0 type UDouble = URec Double + -- | Type synonym for @'URec' 'Float#'@ -- -- @since 4.9.0.0 type UFloat = URec Float + -- | Type synonym for @'URec' 'Int#'@ -- -- @since 4.9.0.0 type UInt = URec Int + -- | Type synonym for @'URec' 'Word#'@ -- -- @since 4.9.0.0 @@ -978,6 +1007,7 @@ class Datatype d where isNewtype :: t d (f :: k -> *) (a :: k) -> Bool isNewtype _ = False +-- | @since 4.9.0.0 instance (KnownSymbol n, KnownSymbol m, KnownSymbol p, SingI nt) => Datatype ('MetaData n m p nt) where datatypeName _ = symbolVal (Proxy :: Proxy n) @@ -998,6 +1028,7 @@ class Constructor c where conIsRecord :: t c (f :: k -> *) (a :: k) -> Bool conIsRecord _ = False +-- | @since 4.9.0.0 instance (KnownSymbol n, SingI f, SingI r) => Constructor ('MetaCons n f r) where conName _ = symbolVal (Proxy :: Proxy n) @@ -1103,6 +1134,7 @@ class Selector s where -- @since 4.9.0.0 selDecidedStrictness :: t s (f :: k -> *) (a :: k) -> DecidedStrictness +-- | @since 4.9.0.0 instance (SingI mn, SingI su, SingI ss, SingI ds) => Selector ('MetaSel mn su ss ds) where selName _ = fromMaybe "" (fromSing (sing :: Sing mn)) @@ -1216,8 +1248,10 @@ class (kparam ~ 'KProxy) => SingKind (kparam :: KProxy k) where data instance Sing (s :: Symbol) where SSym :: KnownSymbol s => Sing s +-- | @since 4.9.0.0 instance KnownSymbol a => SingI a where sing = SSym +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy Symbol) where type DemoteRep ('KProxy :: KProxy Symbol) = String fromSing (SSym :: Sing s) = symbolVal (Proxy :: Proxy s) @@ -1227,9 +1261,13 @@ data instance Sing (a :: Bool) where STrue :: Sing 'True SFalse :: Sing 'False +-- | @since 4.9.0.0 instance SingI 'True where sing = STrue + +-- | @since 4.9.0.0 instance SingI 'False where sing = SFalse +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy Bool) where type DemoteRep ('KProxy :: KProxy Bool) = Bool fromSing STrue = True @@ -1240,9 +1278,13 @@ data instance Sing (b :: Maybe a) where SNothing :: Sing 'Nothing SJust :: Sing a -> Sing ('Just a) +-- | @since 4.9.0.0 instance SingI 'Nothing where sing = SNothing + +-- | @since 4.9.0.0 instance SingI a => SingI ('Just a) where sing = SJust sing +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy a) => SingKind ('KProxy :: KProxy (Maybe a)) where type DemoteRep ('KProxy :: KProxy (Maybe a)) = @@ -1255,10 +1297,14 @@ data instance Sing (a :: FixityI) where SPrefix :: Sing 'PrefixI SInfix :: Sing a -> Integer -> Sing ('InfixI a n) +-- | @since 4.9.0.0 instance SingI 'PrefixI where sing = SPrefix + +-- | @since 4.9.0.0 instance (SingI a, KnownNat n) => SingI ('InfixI a n) where sing = SInfix (sing :: Sing a) (natVal (Proxy :: Proxy n)) +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy FixityI) where type DemoteRep ('KProxy :: KProxy FixityI) = Fixity fromSing SPrefix = Prefix @@ -1270,10 +1316,16 @@ data instance Sing (a :: Associativity) where SRightAssociative :: Sing 'RightAssociative SNotAssociative :: Sing 'NotAssociative +-- | @since 4.9.0.0 instance SingI 'LeftAssociative where sing = SLeftAssociative + +-- | @since 4.9.0.0 instance SingI 'RightAssociative where sing = SRightAssociative + +-- | @since 4.9.0.0 instance SingI 'NotAssociative where sing = SNotAssociative +-- | @since 4.0.0.0 instance SingKind ('KProxy :: KProxy Associativity) where type DemoteRep ('KProxy :: KProxy Associativity) = Associativity fromSing SLeftAssociative = LeftAssociative @@ -1286,10 +1338,16 @@ data instance Sing (a :: SourceUnpackedness) where SSourceNoUnpack :: Sing 'SourceNoUnpack SSourceUnpack :: Sing 'SourceUnpack +-- | @since 4.9.0.0 instance SingI 'NoSourceUnpackedness where sing = SNoSourceUnpackedness + +-- | @since 4.9.0.0 instance SingI 'SourceNoUnpack where sing = SSourceNoUnpack + +-- | @since 4.9.0.0 instance SingI 'SourceUnpack where sing = SSourceUnpack +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy SourceUnpackedness) where type DemoteRep ('KProxy :: KProxy SourceUnpackedness) = SourceUnpackedness fromSing SNoSourceUnpackedness = NoSourceUnpackedness @@ -1302,10 +1360,16 @@ data instance Sing (a :: SourceStrictness) where SSourceLazy :: Sing 'SourceLazy SSourceStrict :: Sing 'SourceStrict +-- | @since 4.9.0.0 instance SingI 'NoSourceStrictness where sing = SNoSourceStrictness + +-- | @since 4.9.0.0 instance SingI 'SourceLazy where sing = SSourceLazy + +-- | @since 4.9.0.0 instance SingI 'SourceStrict where sing = SSourceStrict +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy SourceStrictness) where type DemoteRep ('KProxy :: KProxy SourceStrictness) = SourceStrictness fromSing SNoSourceStrictness = NoSourceStrictness @@ -1318,10 +1382,16 @@ data instance Sing (a :: DecidedStrictness) where SDecidedStrict :: Sing 'DecidedStrict SDecidedUnpack :: Sing 'DecidedUnpack +-- | @since 4.9.0.0 instance SingI 'DecidedLazy where sing = SDecidedLazy + +-- | @since 4.9.0.0 instance SingI 'DecidedStrict where sing = SDecidedStrict + +-- | @since 4.9.0.0 instance SingI 'DecidedUnpack where sing = SDecidedUnpack +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy DecidedStrictness) where type DemoteRep ('KProxy :: KProxy DecidedStrictness) = DecidedStrictness fromSing SDecidedLazy = DecidedLazy diff --git a/libraries/base/GHC/IO/Encoding/CodePage/API.hs b/libraries/base/GHC/IO/Encoding/CodePage/API.hs index 5a48a9ee3d..8cf77b0a96 100644 --- a/libraries/base/GHC/IO/Encoding/CodePage/API.hs +++ b/libraries/base/GHC/IO/Encoding/CodePage/API.hs @@ -64,6 +64,7 @@ data CPINFO = CPINFO { leadByte :: [BYTE] -- ^ Always of length mAX_LEADBYTES } +-- | @since 4.7.0.0 instance Storable CPINFO where sizeOf _ = sizeOf (undefined :: UINT) + (mAX_DEFAULTCHAR + mAX_LEADBYTES) * sizeOf (undefined :: BYTE) alignment _ = alignment (undefined :: CInt) diff --git a/libraries/base/GHC/IO/Encoding/Types.hs b/libraries/base/GHC/IO/Encoding/Types.hs index cf32d7f86f..daab9d5157 100644 --- a/libraries/base/GHC/IO/Encoding/Types.hs +++ b/libraries/base/GHC/IO/Encoding/Types.hs @@ -117,6 +117,7 @@ data TextEncoding -- be shared between several character sequences or simultaneously across threads } +-- | @since 4.3.0.0 instance Show TextEncoding where -- | Returns the value of 'textEncodingName' show te = textEncodingName te diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs index c7bccb0077..69d2c330c9 100644 --- a/libraries/base/GHC/IO/Exception.hs +++ b/libraries/base/GHC/IO/Exception.hs @@ -64,8 +64,10 @@ import Data.Typeable ( cast ) -- to the @MVar@ so it can't ever continue. data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar +-- | @since 4.1.0.0 instance Exception BlockedIndefinitelyOnMVar +-- | @since 4.1.0.0 instance Show BlockedIndefinitelyOnMVar where showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation" @@ -78,8 +80,10 @@ blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar -- other references to any @TVar@s involved, so it can't ever continue. data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM +-- | @since 4.1.0.0 instance Exception BlockedIndefinitelyOnSTM +-- | @since 4.1.0.0 instance Show BlockedIndefinitelyOnSTM where showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction" @@ -92,8 +96,10 @@ blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM -- The @Deadlock@ exception is raised in the main thread only. data Deadlock = Deadlock +-- | @since 4.1.0.0 instance Exception Deadlock +-- | @since 4.1.0.0 instance Show Deadlock where showsPrec _ Deadlock = showString "<<deadlock>>" @@ -106,10 +112,12 @@ instance Show Deadlock where -- @since 4.8.0.0 data AllocationLimitExceeded = AllocationLimitExceeded +-- | @since 4.8.0.0 instance Exception AllocationLimitExceeded where toException = asyncExceptionToException fromException = asyncExceptionFromException +-- | @since 4.7.1.0 instance Show AllocationLimitExceeded where showsPrec _ AllocationLimitExceeded = showString "allocation limit exceeded" @@ -122,8 +130,10 @@ allocationLimitExceeded = toException AllocationLimitExceeded -- |'assert' was applied to 'False'. newtype AssertionFailed = AssertionFailed String +-- | @since 4.1.0.0 instance Exception AssertionFailed +-- | @since 4.1.0.0 instance Show AssertionFailed where showsPrec _ (AssertionFailed err) = showString err @@ -134,9 +144,11 @@ instance Show AssertionFailed where -- @since 4.7.0.0 data SomeAsyncException = forall e . Exception e => SomeAsyncException e +-- | @since 4.7.0.0 instance Show SomeAsyncException where show (SomeAsyncException e) = show e +-- | @since 4.7.0.0 instance Exception SomeAsyncException -- |@since 4.7.0.0 @@ -177,6 +189,7 @@ data AsyncException -- via the usual mechanism(s) (e.g. Control-C in the console). deriving (Eq, Ord) +-- | @since 4.7.0.0 instance Exception AsyncException where toException = asyncExceptionToException fromException = asyncExceptionFromException @@ -191,6 +204,7 @@ data ArrayException -- array that had not been initialized. deriving (Eq, Ord) +-- | @since 4.1.0.0 instance Exception ArrayException -- for the RTS @@ -198,12 +212,14 @@ stackOverflow, heapOverflow :: SomeException stackOverflow = toException StackOverflow heapOverflow = toException HeapOverflow +-- | @since 4.1.0.0 instance Show AsyncException where showsPrec _ StackOverflow = showString "stack overflow" showsPrec _ HeapOverflow = showString "heap overflow" showsPrec _ ThreadKilled = showString "thread killed" showsPrec _ UserInterrupt = showString "user interrupt" +-- | @since 4.1.0.0 instance Show ArrayException where showsPrec _ (IndexOutOfBounds s) = showString "array index out of range" @@ -230,6 +246,7 @@ data ExitCode -- may be prohibited (e.g. 0 on a POSIX-compliant system). deriving (Eq, Ord, Read, Show, Generic) +-- | @since 4.1.0.0 instance Exception ExitCode ioException :: IOException -> IO a @@ -265,8 +282,10 @@ data IOException ioe_filename :: Maybe FilePath -- filename the error is related to. } +-- | @since 4.1.0.0 instance Exception IOException +-- | @since 4.1.0.0 instance Eq IOException where (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) = e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2 @@ -295,9 +314,11 @@ data IOErrorType | ResourceVanished | Interrupted +-- | @since 4.1.0.0 instance Eq IOErrorType where x == y = isTrue# (getTag x ==# getTag y) +-- | @since 4.1.0.0 instance Show IOErrorType where showsPrec _ e = showString $ @@ -336,6 +357,7 @@ userError str = IOError Nothing UserError "" str Nothing Nothing -- --------------------------------------------------------------------------- -- Showing IOErrors +-- | @since 4.1.0.0 instance Show IOException where showsPrec p (IOError hdl iot loc s _ fn) = (case fn of diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs index 18148ecee1..381f39aabe 100644 --- a/libraries/base/GHC/IO/FD.hs +++ b/libraries/base/GHC/IO/FD.hs @@ -88,15 +88,18 @@ fdIsSocket :: FD -> Bool fdIsSocket fd = fdIsSocket_ fd /= 0 #endif +-- | @since 4.1.0.0 instance Show FD where show fd = show (fdFD fd) +-- | @since 4.1.0.0 instance GHC.IO.Device.RawIO FD where read = fdRead readNonBlocking = fdReadNonBlocking write = fdWrite writeNonBlocking = fdWriteNonBlocking +-- | @since 4.1.0.0 instance GHC.IO.Device.IODevice FD where ready = ready close = close @@ -120,6 +123,7 @@ instance GHC.IO.Device.IODevice FD where dEFAULT_FD_BUFFER_SIZE :: Int dEFAULT_FD_BUFFER_SIZE = 8096 +-- | @since 4.1.0.0 instance BufferedIO FD where newBuffer _dev state = newByteBuffer dEFAULT_FD_BUFFER_SIZE state fillReadBuffer fd buf = readBuf' fd buf diff --git a/libraries/base/GHC/IO/Handle.hs b/libraries/base/GHC/IO/Handle.hs index ca5336955c..ec376cb8d4 100644 --- a/libraries/base/GHC/IO/Handle.hs +++ b/libraries/base/GHC/IO/Handle.hs @@ -316,9 +316,11 @@ hFlushAll handle = withHandle_ "hFlushAll" handle flushBuffer data HandlePosn = HandlePosn Handle HandlePosition +-- | @since 4.1.0.0 instance Eq HandlePosn where (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2 +-- | @since 4.1.0.0 instance Show HandlePosn where showsPrec p (HandlePosn h pos) = showsPrec p h . showString " at position " . shows pos diff --git a/libraries/base/GHC/IO/Handle/Types.hs b/libraries/base/GHC/IO/Handle/Types.hs index b7de4ab95b..8f739810c4 100644 --- a/libraries/base/GHC/IO/Handle/Types.hs +++ b/libraries/base/GHC/IO/Handle/Types.hs @@ -112,6 +112,7 @@ data Handle -- * A 'FileHandle' is seekable. A 'DuplexHandle' may or may not be -- seekable. +-- | @since 4.1.0.0 instance Eq Handle where (FileHandle _ h1) == (FileHandle _ h2) = h1 == h2 (DuplexHandle _ h1 _) == (DuplexHandle _ h2 _) = h1 == h2 @@ -407,6 +408,7 @@ noNewlineTranslation = NewlineMode { inputNL = LF, outputNL = LF } -- we provide a more user-friendly Show instance for it -- than the derived one. +-- | @since 4.1.0.0 instance Show HandleType where showsPrec _ t = case t of @@ -417,6 +419,7 @@ instance Show HandleType where AppendHandle -> showString "writable (append)" ReadWriteHandle -> showString "read-writable" +-- | @since 4.1.0.0 instance Show Handle where showsPrec _ (FileHandle file _) = showHandle file showsPrec _ (DuplexHandle file _ _) = showHandle file diff --git a/libraries/base/GHC/IOArray.hs b/libraries/base/GHC/IOArray.hs index f089cad933..733e58d976 100644 --- a/libraries/base/GHC/IOArray.hs +++ b/libraries/base/GHC/IOArray.hs @@ -44,6 +44,7 @@ newtype IOArray i e = IOArray (STArray RealWorld i e) type role IOArray nominal representational -- explicit instance because Haddock can't figure out a derived one +-- | @since 4.1.0.0 instance Eq (IOArray i e) where IOArray x == IOArray y = x == y diff --git a/libraries/base/GHC/IORef.hs b/libraries/base/GHC/IORef.hs index a0ed0823ed..0736567975 100644 --- a/libraries/base/GHC/IORef.hs +++ b/libraries/base/GHC/IORef.hs @@ -33,6 +33,7 @@ import GHC.IO newtype IORef a = IORef (STRef RealWorld a) -- explicit instance because Haddock can't figure out a derived one +-- | @since 4.1.0.0 instance Eq (IORef a) where IORef x == IORef y = x == y diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs index cad6607a99..ad2a872c39 100644 --- a/libraries/base/GHC/Int.hs +++ b/libraries/base/GHC/Int.hs @@ -58,6 +58,7 @@ data {-# CTYPE "HsInt8" #-} Int8 = I8# Int# -- ^ 8-bit signed integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Int8 where (==) = eqInt8 (/=) = neInt8 @@ -68,6 +69,7 @@ neInt8 (I8# x) (I8# y) = isTrue# (x /=# y) {-# INLINE [1] eqInt8 #-} {-# INLINE [1] neInt8 #-} +-- | @since 2.01 instance Ord Int8 where (<) = ltInt8 (<=) = leInt8 @@ -84,9 +86,11 @@ gtInt8, geInt8, ltInt8, leInt8 :: Int8 -> Int8 -> Bool (I8# x) `ltInt8` (I8# y) = isTrue# (x <# y) (I8# x) `leInt8` (I8# y) = isTrue# (x <=# y) +-- | @since 2.01 instance Show Int8 where showsPrec p x = showsPrec p (fromIntegral x :: Int) +-- | @since 2.01 instance Num Int8 where (I8# x#) + (I8# y#) = I8# (narrow8Int# (x# +# y#)) (I8# x#) - (I8# y#) = I8# (narrow8Int# (x# -# y#)) @@ -99,9 +103,11 @@ instance Num Int8 where signum _ = -1 fromInteger i = I8# (narrow8Int# (integerToInt i)) +-- | @since 2.01 instance Real Int8 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Enum Int8 where succ x | x /= maxBound = x + 1 @@ -117,6 +123,7 @@ instance Enum Int8 where enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen +-- | @since 2.01 instance Integral Int8 where quot x@(I8# x#) y@(I8# y#) | y == 0 = divZeroError @@ -150,18 +157,22 @@ instance Integral Int8 where I8# (narrow8Int# m)) toInteger (I8# x#) = smallInteger x# +-- | @since 2.01 instance Bounded Int8 where minBound = -0x80 maxBound = 0x7F +-- | @since 2.01 instance Ix Int8 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral i - fromIntegral m inRange (m,n) i = m <= i && i <= n +-- | @since 2.01 instance Read Int8 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Int8 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -194,6 +205,7 @@ instance Bits Int8 where bit = bitDefault testBit = testBitDefault +-- | @since 4.6.0.0 instance FiniteBits Int8 where finiteBitSize _ = 8 countLeadingZeros (I8# x#) = I# (word2Int# (clz8# (int2Word# x#))) @@ -246,6 +258,7 @@ data {-# CTYPE "HsInt16" #-} Int16 = I16# Int# -- ^ 16-bit signed integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Int16 where (==) = eqInt16 (/=) = neInt16 @@ -256,6 +269,7 @@ neInt16 (I16# x) (I16# y) = isTrue# (x /=# y) {-# INLINE [1] eqInt16 #-} {-# INLINE [1] neInt16 #-} +-- | @since 2.01 instance Ord Int16 where (<) = ltInt16 (<=) = leInt16 @@ -272,9 +286,11 @@ gtInt16, geInt16, ltInt16, leInt16 :: Int16 -> Int16 -> Bool (I16# x) `ltInt16` (I16# y) = isTrue# (x <# y) (I16# x) `leInt16` (I16# y) = isTrue# (x <=# y) +-- | @since 2.01 instance Show Int16 where showsPrec p x = showsPrec p (fromIntegral x :: Int) +-- | @since 2.01 instance Num Int16 where (I16# x#) + (I16# y#) = I16# (narrow16Int# (x# +# y#)) (I16# x#) - (I16# y#) = I16# (narrow16Int# (x# -# y#)) @@ -287,9 +303,11 @@ instance Num Int16 where signum _ = -1 fromInteger i = I16# (narrow16Int# (integerToInt i)) +-- | @since 2.01 instance Real Int16 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Enum Int16 where succ x | x /= maxBound = x + 1 @@ -305,6 +323,7 @@ instance Enum Int16 where enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen +-- | @since 2.01 instance Integral Int16 where quot x@(I16# x#) y@(I16# y#) | y == 0 = divZeroError @@ -338,18 +357,22 @@ instance Integral Int16 where I16# (narrow16Int# m)) toInteger (I16# x#) = smallInteger x# +-- | @since 2.01 instance Bounded Int16 where minBound = -0x8000 maxBound = 0x7FFF +-- | @since 2.01 instance Ix Int16 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral i - fromIntegral m inRange (m,n) i = m <= i && i <= n +-- | @since 2.01 instance Read Int16 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Int16 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -382,6 +405,7 @@ instance Bits Int16 where bit = bitDefault testBit = testBitDefault +-- | @since 4.6.0.0 instance FiniteBits Int16 where finiteBitSize _ = 16 countLeadingZeros (I16# x#) = I# (word2Int# (clz16# (int2Word# x#))) @@ -439,6 +463,7 @@ data {-# CTYPE "HsInt32" #-} Int32 = I32# Int# -- ^ 32-bit signed integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Int32 where (==) = eqInt32 (/=) = neInt32 @@ -449,6 +474,7 @@ neInt32 (I32# x) (I32# y) = isTrue# (x /=# y) {-# INLINE [1] eqInt32 #-} {-# INLINE [1] neInt32 #-} +-- | @since 2.01 instance Ord Int32 where (<) = ltInt32 (<=) = leInt32 @@ -465,9 +491,11 @@ gtInt32, geInt32, ltInt32, leInt32 :: Int32 -> Int32 -> Bool (I32# x) `ltInt32` (I32# y) = isTrue# (x <# y) (I32# x) `leInt32` (I32# y) = isTrue# (x <=# y) +-- | @since 2.01 instance Show Int32 where showsPrec p x = showsPrec p (fromIntegral x :: Int) +-- | @since 2.01 instance Num Int32 where (I32# x#) + (I32# y#) = I32# (narrow32Int# (x# +# y#)) (I32# x#) - (I32# y#) = I32# (narrow32Int# (x# -# y#)) @@ -480,6 +508,7 @@ instance Num Int32 where signum _ = -1 fromInteger i = I32# (narrow32Int# (integerToInt i)) +-- | @since 2.01 instance Enum Int32 where succ x | x /= maxBound = x + 1 @@ -499,6 +528,7 @@ instance Enum Int32 where enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen +-- | @since 2.01 instance Integral Int32 where quot x@(I32# x#) y@(I32# y#) | y == 0 = divZeroError @@ -540,9 +570,11 @@ instance Integral Int32 where I32# (narrow32Int# m)) toInteger (I32# x#) = smallInteger x# +-- | @since 2.01 instance Read Int32 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Int32 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -576,6 +608,7 @@ instance Bits Int32 where bit = bitDefault testBit = testBitDefault +-- | @since 4.6.0.0 instance FiniteBits Int32 where finiteBitSize _ = 32 countLeadingZeros (I32# x#) = I# (word2Int# (clz32# (int2Word# x#))) @@ -621,13 +654,16 @@ instance FiniteBits Int32 where round = (fromIntegral :: Int -> Int32) . (round :: Double -> Int) #-} +-- | @since 2.01 instance Real Int32 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Bounded Int32 where minBound = -0x80000000 maxBound = 0x7FFFFFFF +-- | @since 2.01 instance Ix Int32 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral i - fromIntegral m @@ -643,6 +679,7 @@ data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64# -- ^ 64-bit signed integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Int64 where (==) = eqInt64 (/=) = neInt64 @@ -653,6 +690,7 @@ neInt64 (I64# x) (I64# y) = isTrue# (x `neInt64#` y) {-# INLINE [1] eqInt64 #-} {-# INLINE [1] neInt64 #-} +-- | @since 2.01 instance Ord Int64 where (<) = ltInt64 (<=) = leInt64 @@ -669,9 +707,11 @@ gtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool (I64# x) `ltInt64` (I64# y) = isTrue# (x `ltInt64#` y) (I64# x) `leInt64` (I64# y) = isTrue# (x `leInt64#` y) +-- | @since 2.01 instance Show Int64 where showsPrec p x = showsPrec p (toInteger x) +-- | @since 2.01 instance Num Int64 where (I64# x#) + (I64# y#) = I64# (x# `plusInt64#` y#) (I64# x#) - (I64# y#) = I64# (x# `minusInt64#` y#) @@ -684,6 +724,7 @@ instance Num Int64 where signum _ = -1 fromInteger i = I64# (integerToInt64 i) +-- | @since 2.01 instance Enum Int64 where succ x | x /= maxBound = x + 1 @@ -701,6 +742,7 @@ instance Enum Int64 where enumFromTo = integralEnumFromTo enumFromThenTo = integralEnumFromThenTo +-- | @since 2.01 instance Integral Int64 where quot x@(I64# x#) y@(I64# y#) | y == 0 = divZeroError @@ -762,9 +804,11 @@ x# `modInt64#` y# !zero = intToInt64# 0# !r# = x# `remInt64#` y# +-- | @since 2.01 instance Read Int64 where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Int64 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -835,6 +879,7 @@ data {-# CTYPE "HsInt64" #-} Int64 = I64# Int# -- ^ 64-bit signed integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Int64 where (==) = eqInt64 (/=) = neInt64 @@ -845,6 +890,7 @@ neInt64 (I64# x) (I64# y) = isTrue# (x /=# y) {-# INLINE [1] eqInt64 #-} {-# INLINE [1] neInt64 #-} +-- | @since 2.01 instance Ord Int64 where (<) = ltInt64 (<=) = leInt64 @@ -861,9 +907,11 @@ gtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool (I64# x) `ltInt64` (I64# y) = isTrue# (x <# y) (I64# x) `leInt64` (I64# y) = isTrue# (x <=# y) +-- | @since 2.01 instance Show Int64 where showsPrec p x = showsPrec p (fromIntegral x :: Int) +-- | @since 2.01 instance Num Int64 where (I64# x#) + (I64# y#) = I64# (x# +# y#) (I64# x#) - (I64# y#) = I64# (x# -# y#) @@ -876,6 +924,7 @@ instance Num Int64 where signum _ = -1 fromInteger i = I64# (integerToInt i) +-- | @since 2.01 instance Enum Int64 where succ x | x /= maxBound = x + 1 @@ -888,6 +937,7 @@ instance Enum Int64 where enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen +-- | @since 2.01 instance Integral Int64 where quot x@(I64# x#) y@(I64# y#) | y == 0 = divZeroError @@ -927,9 +977,11 @@ instance Integral Int64 where (I64# d, I64# m) toInteger (I64# x#) = smallInteger x# +-- | @since 2.01 instance Read Int64 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Int64 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -1004,6 +1056,7 @@ uncheckedIShiftRA64# :: Int# -> Int# -> Int# uncheckedIShiftRA64# = uncheckedIShiftRA# #endif +-- | @since 4.6.0.0 instance FiniteBits Int64 where finiteBitSize _ = 64 #if WORD_SIZE_IN_BITS < 64 @@ -1014,13 +1067,16 @@ instance FiniteBits Int64 where countTrailingZeros (I64# x#) = I# (word2Int# (ctz64# (int2Word# x#))) #endif +-- | @since 2.01 instance Real Int64 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Bounded Int64 where minBound = -0x8000000000000000 maxBound = 0x7FFFFFFFFFFFFFFF +-- | @since 2.01 instance Ix Int64 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral i - fromIntegral m diff --git a/libraries/base/GHC/MVar.hs b/libraries/base/GHC/MVar.hs index 6cbbe7bfb6..d367f2ba06 100644 --- a/libraries/base/GHC/MVar.hs +++ b/libraries/base/GHC/MVar.hs @@ -42,6 +42,7 @@ as a a box, which may be empty or full. -} -- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module +-- | @since 4.1.0.0 instance Eq (MVar a) where (MVar mvar1#) == (MVar mvar2#) = isTrue# (sameMVar# mvar1# mvar2#) diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs index e756f0d07f..953b2a4c26 100644 --- a/libraries/base/GHC/Natural.hs +++ b/libraries/base/GHC/Natural.hs @@ -150,14 +150,17 @@ isValidNatural (NatJ# bn) = isTrue# (isValidBigNat# bn) #-} #endif +-- | @since 4.8.0.0 instance Show Natural where showsPrec p (NatS# w#) = showsPrec p (W# w#) showsPrec p (NatJ# bn) = showsPrec p (Jp# bn) +-- | @since 4.8.0.0 instance Read Natural where readsPrec d = map (\(n, s) -> (fromInteger n, s)) . filter ((>= 0) . (\(x,_)->x)) . readsPrec d +-- | @since 4.8.0.0 instance Num Natural where fromInteger (S# i#) | I# i# >= 0 = NatS# (int2Word# i#) fromInteger (Jp# bn) = bigNatToNatural bn @@ -175,6 +178,7 @@ instance Num Natural where negate (NatS# 0##) = NatS# 0## negate _ = throw Underflow +-- | @since 4.8.0.0 instance Real Natural where toRational (NatS# w) = toRational (W# w) toRational (NatJ# bn) = toRational (Jp# bn) @@ -206,6 +210,7 @@ lcmNatural x y = (x `quot` (gcdNatural x y)) * y #endif +-- | @since 4.8.0.0 instance Enum Natural where succ n = n `plusNatural` NatS# 1## pred n = n `minusNatural` NatS# 1## @@ -248,6 +253,7 @@ enumNegDeltaToNatural x0 ndelta lim = go x0 ---------------------------------------------------------------------------- +-- | @since 4.8.0.0 instance Integral Natural where toInteger (NatS# w) = wordToInteger w toInteger (NatJ# bn) = Jp# bn @@ -280,6 +286,7 @@ instance Integral Natural where rem (NatJ# n) (NatS# d) = NatS# (remBigNatWord n d) rem (NatJ# n) (NatJ# d) = bigNatToNatural (remBigNat n d) +-- | @since 4.8.0.0 instance Ix Natural where range (m,n) = [m..n] inRange (m,n) i = m <= i && i <= n @@ -288,6 +295,7 @@ instance Ix Natural where | otherwise = indexError b i "Natural" +-- | @since 4.8.0.0 instance Bits Natural where NatS# n .&. NatS# m = wordToNatural (W# n .&. W# m) NatS# n .&. NatJ# m = wordToNatural (W# n .&. W# (bigNatToWord m)) @@ -444,13 +452,16 @@ newtype Natural = Natural Integer -- ^ __Invariant__: non-negative 'Integer' isValidNatural :: Natural -> Bool isValidNatural (Natural i) = i >= 0 +-- | @since 4.8.0.0 instance Read Natural where readsPrec d = map (\(n, s) -> (Natural n, s)) . filter ((>= 0) . (\(x,_)->x)) . readsPrec d +-- | @since 4.8.0.0 instance Show Natural where showsPrec d (Natural i) = showsPrec d i +-- | @since 4.8.0.0 instance Num Natural where Natural n + Natural m = Natural (n + m) {-# INLINE (+) #-} @@ -477,6 +488,7 @@ minusNaturalMaybe x y | x >= y = Just (x - y) | otherwise = Nothing +-- | @since 4.8.0.0 instance Bits Natural where Natural n .&. Natural m = Natural (n .&. m) {-# INLINE (.&.) #-} @@ -518,10 +530,12 @@ instance Bits Natural where {-# INLINE popCount #-} zeroBits = Natural 0 +-- | @since 4.8.0.0 instance Real Natural where toRational (Natural a) = toRational a {-# INLINE toRational #-} +-- | @since 4.8.0.0 instance Enum Natural where pred (Natural 0) = errorWithoutStackTrace "Natural.pred: 0" pred (Natural n) = Natural (pred n) @@ -543,6 +557,7 @@ instance Enum Natural where enumFromThenTo = coerce (enumFromThenTo :: Integer -> Integer -> Integer -> [Integer]) +-- | @since 4.8.0.0 instance Integral Natural where quot (Natural a) (Natural b) = Natural (quot a b) {-# INLINE quot #-} @@ -593,6 +608,7 @@ naturalToWordMaybe (Natural i) 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 diff --git a/libraries/base/GHC/Num.hs b/libraries/base/GHC/Num.hs index 5d46dacedd..fd98c19f20 100644 --- a/libraries/base/GHC/Num.hs +++ b/libraries/base/GHC/Num.hs @@ -64,6 +64,7 @@ class Num a where subtract :: (Num a) => a -> a -> a subtract x y = y - x +-- | @since 2.01 instance Num Int where I# x + I# y = I# (x +# y) I# x - I# y = I# (x -# y) @@ -78,6 +79,7 @@ instance Num Int where {-# INLINE fromInteger #-} -- Just to be sure! fromInteger i = I# (integerToInt i) +-- | @since 2.01 instance Num Word where (W# x#) + (W# y#) = W# (x# `plusWord#` y#) (W# x#) - (W# y#) = W# (x# `minusWord#` y#) @@ -88,6 +90,7 @@ instance Num Word where signum _ = 1 fromInteger i = W# (integerToWord i) +-- | @since 2.01 instance Num Integer where (+) = plusInteger (-) = minusInteger diff --git a/libraries/base/GHC/Ptr.hs b/libraries/base/GHC/Ptr.hs index def63b7613..93f6d64ae5 100644 --- a/libraries/base/GHC/Ptr.hs +++ b/libraries/base/GHC/Ptr.hs @@ -163,6 +163,7 @@ castPtrToFunPtr (Ptr addr) = FunPtr addr ------------------------------------------------------------------------ -- Show instances for Ptr and FunPtr +-- | @since 2.01 instance Show (Ptr a) where showsPrec _ (Ptr a) rs = pad_out (showHex (wordToInteger(int2Word#(addr2Int# a))) "") where @@ -170,5 +171,6 @@ instance Show (Ptr a) where pad_out ls = '0':'x':(replicate (2*SIZEOF_HSPTR - length ls) '0') ++ ls ++ rs +-- | @since 2.01 instance Show (FunPtr a) where showsPrec p = showsPrec p . castFunPtrToPtr diff --git a/libraries/base/GHC/RTS/Flags.hsc b/libraries/base/GHC/RTS/Flags.hsc index 12cead7821..b83963ec4f 100644 --- a/libraries/base/GHC/RTS/Flags.hsc +++ b/libraries/base/GHC/RTS/Flags.hsc @@ -75,6 +75,7 @@ data GiveGCStats | VerboseGCStats deriving (Show) +-- | @since 4.8.0.0 instance Enum GiveGCStats where fromEnum NoGCStats = #{const NO_GC_STATS} fromEnum CollectGCStats = #{const COLLECT_GC_STATS} @@ -173,6 +174,7 @@ data DoCostCentres | CostCentresXML deriving (Show) +-- | @since 4.8.0.0 instance Enum DoCostCentres where fromEnum CostCentresNone = #{const COST_CENTRES_NONE} fromEnum CostCentresSummary = #{const COST_CENTRES_SUMMARY} @@ -210,6 +212,7 @@ data DoHeapProfile | HeapByClosureType deriving (Show) +-- | @since 4.8.0.0 instance Enum DoHeapProfile where fromEnum NoHeapProfiling = #{const NO_HEAP_PROFILING} fromEnum HeapByCCS = #{const HEAP_BY_CCS} @@ -259,6 +262,7 @@ data DoTrace | TraceStderr -- ^ send tracing events to @stderr@ deriving (Show) +-- | @since 4.8.0.0 instance Enum DoTrace where fromEnum TraceNone = #{const TRACE_NONE} fromEnum TraceEventLog = #{const TRACE_EVENTLOG} diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs index b4b88c0e9d..54fbc287a8 100644 --- a/libraries/base/GHC/Read.hs +++ b/libraries/base/GHC/Read.hs @@ -314,6 +314,7 @@ choose sps = foldr ((+++) . try_one) pfail sps deriving instance Read GeneralCategory +-- | @since 2.01 instance Read Char where readPrec = parens @@ -331,6 +332,7 @@ instance Read Char where readList = readListDefault +-- | @since 2.01 instance Read Bool where readPrec = parens @@ -344,6 +346,7 @@ instance Read Bool where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance Read Ordering where readPrec = parens @@ -385,6 +388,7 @@ parenthesis-like objects such as (...) and [...] can be an argument to 'Just'. -} +-- | @since 2.01 instance Read a => Read (Maybe a) where readPrec = parens @@ -400,6 +404,7 @@ instance Read a => Read (Maybe a) where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance Read a => Read [a] where {-# SPECIALISE instance Read [String] #-} {-# SPECIALISE instance Read [Char] #-} @@ -408,6 +413,7 @@ instance Read a => Read [a] where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Ix a, Read a, Read b) => Read (Array a b) where readPrec = parens $ prec appPrec $ do expectP (L.Ident "array") @@ -418,6 +424,7 @@ instance (Ix a, Read a, Read b) => Read (Array a b) where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance Read L.Lexeme where readPrec = lexP readListPrec = readListPrecDefault @@ -455,29 +462,35 @@ convertFrac (L.Number n) = let resRange = floatRange (undefined :: a) Just rat -> return $ fromRational rat convertFrac _ = pfail +-- | @since 2.01 instance Read Int where readPrec = readNumber convertInt readListPrec = readListPrecDefault readList = readListDefault +-- | @since 4.5.0.0 instance Read Word where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Read Integer where readPrec = readNumber convertInt readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance Read Float where readPrec = readNumber convertFrac readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance Read Double where readPrec = readNumber convertFrac readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Integral a, Read a) => Read (Ratio a) where readPrec = parens @@ -497,6 +510,7 @@ instance (Integral a, Read a) => Read (Ratio a) where -- Tuple instances of Read, up to size 15 ------------------------------------------------------------------------ +-- | @since 2.01 instance Read () where readPrec = parens @@ -508,6 +522,7 @@ instance Read () where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b) => Read (a,b) where readPrec = wrap_tup read_tup2 readListPrec = readListPrecDefault @@ -541,6 +556,7 @@ read_tup8 = do (a,b,c,d) <- read_tup4 return (a,b,c,d,e,f,g,h) +-- | @since 2.01 instance (Read a, Read b, Read c) => Read (a, b, c) where readPrec = wrap_tup (do { (a,b) <- read_tup2; read_comma ; c <- readPrec @@ -548,11 +564,13 @@ instance (Read a, Read b, Read c) => Read (a, b, c) where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where readPrec = wrap_tup read_tup4 readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma ; e <- readPrec @@ -560,6 +578,7 @@ instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f) => Read (a, b, c, d, e, f) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma @@ -568,6 +587,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f) readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g) => Read (a, b, c, d, e, f, g) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma @@ -577,12 +597,14 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g) readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h) => Read (a, b, c, d, e, f, g, h) where readPrec = wrap_tup read_tup8 readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i) => Read (a, b, c, d, e, f, g, h, i) where @@ -592,6 +614,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j) => Read (a, b, c, d, e, f, g, h, i, j) where @@ -601,6 +624,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k) => Read (a, b, c, d, e, f, g, h, i, j, k) where @@ -611,6 +635,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l) => Read (a, b, c, d, e, f, g, h, i, j, k, l) where @@ -620,6 +645,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l, Read m) => Read (a, b, c, d, e, f, g, h, i, j, k, l, m) where @@ -630,6 +656,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l, Read m, Read n) => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where @@ -640,6 +667,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l, Read m, Read n, Read o) => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs index 3a97f1f18c..fbd9f16483 100644 --- a/libraries/base/GHC/Real.hs +++ b/libraries/base/GHC/Real.hs @@ -236,9 +236,11 @@ numericEnumFromThenTo e1 e2 e3 -- Instances for Int -------------------------------------------------------------- +-- | @since 2.0.1 instance Real Int where toRational x = toInteger x :% 1 +-- | @since 2.0.1 instance Integral Int where toInteger (I# i) = smallInteger i @@ -286,9 +288,11 @@ instance Integral Int where -- Instances for @Word@ -------------------------------------------------------------- +-- | @since 2.01 instance Real Word where toRational x = toInteger x % 1 +-- | @since 2.01 instance Integral Word where quot (W# x#) y@(W# y#) | y /= 0 = W# (x# `quotWord#` y#) @@ -316,6 +320,7 @@ instance Integral Word where -- Instances for Integer -------------------------------------------------------------- +-- | @since 2.0.1 instance Real Integer where toRational x = x :% 1 @@ -331,6 +336,7 @@ instance Real Integer where -- happen because they are all marked with NOINLINE pragma - see documentation -- of integer-gmp or integer-simple. +-- | @since 2.0.1 instance Integral Integer where toInteger n = n @@ -364,11 +370,13 @@ instance Integral Integer where -- Instances for @Ratio@ -------------------------------------------------------------- +-- | @since 2.0.1 instance (Integral a) => Ord (Ratio a) where {-# SPECIALIZE instance Ord Rational #-} (x:%y) <= (x':%y') = x * y' <= x' * y (x:%y) < (x':%y') = x * y' < x' * y +-- | @since 2.0.1 instance (Integral a) => Num (Ratio a) where {-# SPECIALIZE instance Num Rational #-} (x:%y) + (x':%y') = reduce (x*y' + x'*y) (y*y') @@ -379,6 +387,7 @@ instance (Integral a) => Num (Ratio a) where signum (x:%_) = signum x :% 1 fromInteger x = fromInteger x :% 1 +-- | @since 2.0.1 {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} instance (Integral a) => Fractional (Ratio a) where {-# SPECIALIZE instance Fractional Rational #-} @@ -389,15 +398,18 @@ instance (Integral a) => Fractional (Ratio a) where | otherwise = y :% x fromRational (x:%y) = fromInteger x % fromInteger y +-- | @since 2.0.1 instance (Integral a) => Real (Ratio a) where {-# SPECIALIZE instance Real Rational #-} toRational (x:%y) = toInteger x :% toInteger y +-- | @since 2.0.1 instance (Integral a) => RealFrac (Ratio a) where {-# SPECIALIZE instance RealFrac Rational #-} properFraction (x:%y) = (fromInteger (toInteger q), r:%y) where (q,r) = quotRem x y +-- | @since 2.0.1 instance (Show a) => Show (Ratio a) where {-# SPECIALIZE instance Show Rational #-} showsPrec p (x:%y) = showParen (p > ratioPrec) $ @@ -409,6 +421,7 @@ instance (Show a) => Show (Ratio a) where -- Haskell 98 [Sep 08, #1920] showsPrec ratioPrec1 y +-- | @since 2.0.1 instance (Integral a) => Enum (Ratio a) where {-# SPECIALIZE instance Enum Rational #-} succ x = x + 1 diff --git a/libraries/base/GHC/ST.hs b/libraries/base/GHC/ST.hs index d84dd4d9d1..dc5c71fe68 100644 --- a/libraries/base/GHC/ST.hs +++ b/libraries/base/GHC/ST.hs @@ -52,11 +52,13 @@ default () newtype ST s a = ST (STRep s a) type STRep s a = State# s -> (# State# s, a #) +-- | @since 2.01 instance Functor (ST s) where fmap f (ST m) = ST $ \ s -> case (m s) of { (# new_s, r #) -> (# new_s, f r #) } +-- | @since 4.4.0.0 instance Applicative (ST s) where {-# INLINE pure #-} {-# INLINE (*>) #-} @@ -64,6 +66,7 @@ instance Applicative (ST s) where m *> k = m >>= \ _ -> k (<*>) = ap +-- | @since 2.01 instance Monad (ST s) where {-# INLINE (>>=) #-} (>>) = (*>) @@ -99,6 +102,7 @@ fixST k = ST $ \ s -> in case ans of STret s' x -> (# s', x #) +-- | @since 2.01 instance Show (ST s a) where showsPrec _ _ = showString "<<ST action>>" showList = showList__ (showsPrec 0) diff --git a/libraries/base/GHC/STRef.hs b/libraries/base/GHC/STRef.hs index 9997f72681..22db7f32db 100644 --- a/libraries/base/GHC/STRef.hs +++ b/libraries/base/GHC/STRef.hs @@ -45,5 +45,6 @@ writeSTRef (STRef var#) val = ST $ \s1# -> (# s2#, () #) } -- Just pointer equality on mutable references: +-- | @since 2.01 instance Eq (STRef s a) where STRef v1# == STRef v2# = isTrue# (sameMutVar# v1# v2#) diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index 72a73200b5..46fc8fe307 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -165,6 +165,7 @@ appPrec1 = I# 11# -- appPrec + 1 deriving instance Show () +-- | @since 2.01 instance Show a => Show [a] where {-# SPECIALISE instance Show [String] #-} {-# SPECIALISE instance Show [Char] #-} @@ -174,15 +175,18 @@ instance Show a => Show [a] where deriving instance Show Bool deriving instance Show Ordering +-- | @since 2.01 instance Show Char where showsPrec _ '\'' = showString "'\\''" showsPrec _ c = showChar '\'' . showLitChar c . showChar '\'' showList cs = showChar '"' . showLitString cs . showChar '"' +-- | @since 2.01 instance Show Int where showsPrec = showSignedInt +-- | @since 2.01 instance Show Word where showsPrec _ (W# w) = showWord w @@ -195,16 +199,20 @@ showWord w# cs deriving instance Show a => Show (Maybe a) +-- | @since 2.01 instance Show TyCon where showsPrec p (TyCon _ _ _ tc_name) = showsPrec p tc_name +-- | @since 4.9.0.0 instance Show TrName where showsPrec _ (TrNameS s) = showString (unpackCString# s) showsPrec _ (TrNameD s) = showString s +-- | @since 4.9.0.0 instance Show Module where showsPrec _ (Module p m) = shows p . (':' :) . shows m +-- | @since 4.9.0.0 instance Show CallStack where showsPrec _ = shows . getCallStack @@ -220,49 +228,60 @@ deriving instance Show SrcLoc -- showsPrec _ (x,y) = let sx = shows x; sy = shows y in -- \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s)))) +-- | @since 2.01 instance (Show a, Show b) => Show (a,b) where showsPrec _ (a,b) s = show_tuple [shows a, shows b] s +-- | @since 2.01 instance (Show a, Show b, Show c) => Show (a, b, c) where showsPrec _ (a,b,c) s = show_tuple [shows a, shows b, shows c] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where showsPrec _ (a,b,c,d) s = show_tuple [shows a, shows b, shows c, shows d] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where showsPrec _ (a,b,c,d,e) s = show_tuple [shows a, shows b, shows c, shows d, shows e] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a,b,c,d,e,f) where showsPrec _ (a,b,c,d,e,f) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g) => Show (a,b,c,d,e,f,g) where showsPrec _ (a,b,c,d,e,f,g) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) => Show (a,b,c,d,e,f,g,h) where showsPrec _ (a,b,c,d,e,f,g,h) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i) => Show (a,b,c,d,e,f,g,h,i) where showsPrec _ (a,b,c,d,e,f,g,h,i) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j) => Show (a,b,c,d,e,f,g,h,i,j) where showsPrec _ (a,b,c,d,e,f,g,h,i,j) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k) => Show (a,b,c,d,e,f,g,h,i,j,k) where showsPrec _ (a,b,c,d,e,f,g,h,i,j,k) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j, shows k] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l) => Show (a,b,c,d,e,f,g,h,i,j,k,l) where @@ -270,6 +289,7 @@ instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j, shows k, shows l] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m) => Show (a,b,c,d,e,f,g,h,i,j,k,l,m) where @@ -277,6 +297,7 @@ instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j, shows k, shows l, shows m] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m, Show n) => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where @@ -284,6 +305,7 @@ instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j, shows k, shows l, shows m, shows n] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m, Show n, Show o) => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where @@ -434,6 +456,7 @@ itos n# cs -- The Integer instances for Show -------------------------------------------------------------- +-- | @since 2.01 instance Show Integer where showsPrec p n r | p > 6 && n < 0 = '(' : integerToString n (')' : r) diff --git a/libraries/base/GHC/Stable.hs b/libraries/base/GHC/Stable.hs index 4ccfd04877..73095bd44a 100644 --- a/libraries/base/GHC/Stable.hs +++ b/libraries/base/GHC/Stable.hs @@ -101,6 +101,7 @@ castStablePtrToPtr (StablePtr s) = Ptr (unsafeCoerce# s) castPtrToStablePtr :: Ptr () -> StablePtr a castPtrToStablePtr (Ptr a) = StablePtr (unsafeCoerce# a) +-- | @since 2.1 instance Eq (StablePtr a) where (StablePtr sp1) == (StablePtr sp2) = case eqStablePtr# sp1 sp2 of diff --git a/libraries/base/GHC/StaticPtr.hs b/libraries/base/GHC/StaticPtr.hs index 1f145201ee..65ec483577 100644 --- a/libraries/base/GHC/StaticPtr.hs +++ b/libraries/base/GHC/StaticPtr.hs @@ -96,6 +96,7 @@ foreign import ccall unsafe hs_spt_lookup :: Ptr () -> IO (Ptr a) class IsStatic p where fromStaticPtr :: StaticPtr a -> p a +-- | @since 4.9.0.0 instance IsStatic StaticPtr where fromStaticPtr = id diff --git a/libraries/base/GHC/TypeLits.hs b/libraries/base/GHC/TypeLits.hs index c32eebb4dc..6d66c1109f 100644 --- a/libraries/base/GHC/TypeLits.hs +++ b/libraries/base/GHC/TypeLits.hs @@ -117,15 +117,19 @@ someSymbolVal n = withSSymbol SomeSymbol (SSymbol n) Proxy +-- | @since 4.7.0.0 instance Eq SomeNat where SomeNat x == SomeNat y = natVal x == natVal y +-- | @since 4.7.0.0 instance Ord SomeNat where compare (SomeNat x) (SomeNat y) = compare (natVal x) (natVal y) +-- | @since 4.7.0.0 instance Show SomeNat where showsPrec p (SomeNat x) = showsPrec p (natVal x) +-- | @since 4.7.0.0 instance Read SomeNat where readsPrec p xs = do (a,ys) <- readsPrec p xs case someNatVal a of @@ -133,15 +137,19 @@ instance Read SomeNat where Just n -> [(n,ys)] +-- | @since 4.7.0.0 instance Eq SomeSymbol where SomeSymbol x == SomeSymbol y = symbolVal x == symbolVal y +-- | @since 4.7.0.0 instance Ord SomeSymbol where compare (SomeSymbol x) (SomeSymbol y) = compare (symbolVal x) (symbolVal y) +-- | @since 4.7.0.0 instance Show SomeSymbol where showsPrec p (SomeSymbol x) = showsPrec p (symbolVal x) +-- | @since 4.7.0.0 instance Read SomeSymbol where readsPrec p xs = [ (someSymbolVal a, ys) | (a,ys) <- readsPrec p xs ] diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs index 3424f83f71..d4a5536275 100644 --- a/libraries/base/GHC/Word.hs +++ b/libraries/base/GHC/Word.hs @@ -66,6 +66,7 @@ data {-# CTYPE "HsWord8" #-} Word8 = W8# Word# -- ^ 8-bit unsigned integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Word8 where (==) = eqWord8 (/=) = neWord8 @@ -76,6 +77,7 @@ neWord8 (W8# x) (W8# y) = isTrue# (x `neWord#` y) {-# INLINE [1] eqWord8 #-} {-# INLINE [1] neWord8 #-} +-- | @since 2.01 instance Ord Word8 where (<) = ltWord8 (<=) = leWord8 @@ -92,9 +94,11 @@ gtWord8, geWord8, ltWord8, leWord8 :: Word8 -> Word8 -> Bool (W8# x) `ltWord8` (W8# y) = isTrue# (x `ltWord#` y) (W8# x) `leWord8` (W8# y) = isTrue# (x `leWord#` y) +-- | @since 2.01 instance Show Word8 where showsPrec p x = showsPrec p (fromIntegral x :: Int) +-- | @since 2.01 instance Num Word8 where (W8# x#) + (W8# y#) = W8# (narrow8Word# (x# `plusWord#` y#)) (W8# x#) - (W8# y#) = W8# (narrow8Word# (x# `minusWord#` y#)) @@ -105,9 +109,11 @@ instance Num Word8 where signum _ = 1 fromInteger i = W8# (narrow8Word# (integerToWord i)) +-- | @since 2.01 instance Real Word8 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Enum Word8 where succ x | x /= maxBound = x + 1 @@ -123,6 +129,7 @@ instance Enum Word8 where enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen +-- | @since 2.01 instance Integral Word8 where quot (W8# x#) y@(W8# y#) | y /= 0 = W8# (x# `quotWord#` y#) @@ -146,18 +153,22 @@ instance Integral Word8 where | otherwise = divZeroError toInteger (W8# x#) = smallInteger (word2Int# x#) +-- | @since 2.01 instance Bounded Word8 where minBound = 0 maxBound = 0xFF +-- | @since 2.01 instance Ix Word8 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n +-- | @since 2.01 instance Read Word8 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Word8 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -189,6 +200,7 @@ instance Bits Word8 where bit = bitDefault testBit = testBitDefault +-- | @since 4.6.0.0 instance FiniteBits Word8 where finiteBitSize _ = 8 countLeadingZeros (W8# x#) = I# (word2Int# (clz8# x#)) @@ -242,6 +254,7 @@ data {-# CTYPE "HsWord16" #-} Word16 = W16# Word# -- ^ 16-bit unsigned integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Word16 where (==) = eqWord16 (/=) = neWord16 @@ -252,6 +265,7 @@ neWord16 (W16# x) (W16# y) = isTrue# (x `neWord#` y) {-# INLINE [1] eqWord16 #-} {-# INLINE [1] neWord16 #-} +-- | @since 2.01 instance Ord Word16 where (<) = ltWord16 (<=) = leWord16 @@ -268,9 +282,11 @@ gtWord16, geWord16, ltWord16, leWord16 :: Word16 -> Word16 -> Bool (W16# x) `ltWord16` (W16# y) = isTrue# (x `ltWord#` y) (W16# x) `leWord16` (W16# y) = isTrue# (x `leWord#` y) +-- | @since 2.01 instance Show Word16 where showsPrec p x = showsPrec p (fromIntegral x :: Int) +-- | @since 2.01 instance Num Word16 where (W16# x#) + (W16# y#) = W16# (narrow16Word# (x# `plusWord#` y#)) (W16# x#) - (W16# y#) = W16# (narrow16Word# (x# `minusWord#` y#)) @@ -281,9 +297,11 @@ instance Num Word16 where signum _ = 1 fromInteger i = W16# (narrow16Word# (integerToWord i)) +-- | @since 2.01 instance Real Word16 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Enum Word16 where succ x | x /= maxBound = x + 1 @@ -299,6 +317,7 @@ instance Enum Word16 where enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen +-- | @since 2.01 instance Integral Word16 where quot (W16# x#) y@(W16# y#) | y /= 0 = W16# (x# `quotWord#` y#) @@ -322,18 +341,22 @@ instance Integral Word16 where | otherwise = divZeroError toInteger (W16# x#) = smallInteger (word2Int# x#) +-- | @since 2.01 instance Bounded Word16 where minBound = 0 maxBound = 0xFFFF +-- | @since 2.01 instance Ix Word16 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n +-- | @since 2.01 instance Read Word16 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Word16 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -365,6 +388,7 @@ instance Bits Word16 where bit = bitDefault testBit = testBitDefault +-- | @since 4.6.0.0 instance FiniteBits Word16 where finiteBitSize _ = 16 countLeadingZeros (W16# x#) = I# (word2Int# (clz16# x#)) @@ -461,6 +485,7 @@ data {-# CTYPE "HsWord32" #-} Word32 = W32# Word# -- ^ 32-bit unsigned integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Word32 where (==) = eqWord32 (/=) = neWord32 @@ -471,6 +496,7 @@ neWord32 (W32# x) (W32# y) = isTrue# (x `neWord#` y) {-# INLINE [1] eqWord32 #-} {-# INLINE [1] neWord32 #-} +-- | @since 2.01 instance Ord Word32 where (<) = ltWord32 (<=) = leWord32 @@ -487,6 +513,7 @@ gtWord32, geWord32, ltWord32, leWord32 :: Word32 -> Word32 -> Bool (W32# x) `ltWord32` (W32# y) = isTrue# (x `ltWord#` y) (W32# x) `leWord32` (W32# y) = isTrue# (x `leWord#` y) +-- | @since 2.01 instance Num Word32 where (W32# x#) + (W32# y#) = W32# (narrow32Word# (x# `plusWord#` y#)) (W32# x#) - (W32# y#) = W32# (narrow32Word# (x# `minusWord#` y#)) @@ -497,6 +524,7 @@ instance Num Word32 where signum _ = 1 fromInteger i = W32# (narrow32Word# (integerToWord i)) +-- | @since 2.01 instance Enum Word32 where succ x | x /= maxBound = x + 1 @@ -526,6 +554,7 @@ instance Enum Word32 where enumFromThen = boundedEnumFromThen #endif +-- | @since 2.01 instance Integral Word32 where quot (W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `quotWord#` y#) @@ -557,6 +586,7 @@ instance Integral Word32 where = smallInteger (word2Int# x#) #endif +-- | @since 2.01 instance Bits Word32 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -588,6 +618,7 @@ instance Bits Word32 where bit = bitDefault testBit = testBitDefault +-- | @since 4.6.0.0 instance FiniteBits Word32 where finiteBitSize _ = 32 countLeadingZeros (W32# x#) = I# (word2Int# (clz32# x#)) @@ -602,6 +633,7 @@ instance FiniteBits Word32 where "fromIntegral/Word32->a" fromIntegral = \(W32# x#) -> fromIntegral (W# x#) #-} +-- | @since 2.01 instance Show Word32 where #if WORD_SIZE_IN_BITS < 33 showsPrec p x = showsPrec p (toInteger x) @@ -610,18 +642,22 @@ instance Show Word32 where #endif +-- | @since 2.01 instance Real Word32 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Bounded Word32 where minBound = 0 maxBound = 0xFFFFFFFF +-- | @since 2.01 instance Ix Word32 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n +-- | @since 2.01 instance Read Word32 where #if WORD_SIZE_IN_BITS < 33 readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] @@ -645,6 +681,7 @@ data {-# CTYPE "HsWord64" #-} Word64 = W64# Word64# -- ^ 64-bit unsigned integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Word64 where (==) = eqWord64 (/=) = neWord64 @@ -655,6 +692,7 @@ neWord64 (W64# x) (W64# y) = isTrue# (x `neWord64#` y) {-# INLINE [1] eqWord64 #-} {-# INLINE [1] neWord64 #-} +-- | @since 2.01 instance Ord Word64 where (<) = ltWord64 (<=) = leWord64 @@ -671,6 +709,7 @@ gtWord64, geWord64, ltWord64, leWord64 :: Word64 -> Word64 -> Bool (W64# x) `ltWord64` (W64# y) = isTrue# (x `ltWord64#` y) (W64# x) `leWord64` (W64# y) = isTrue# (x `leWord64#` y) +-- | @since 2.01 instance Num Word64 where (W64# x#) + (W64# y#) = W64# (int64ToWord64# (word64ToInt64# x# `plusInt64#` word64ToInt64# y#)) (W64# x#) - (W64# y#) = W64# (int64ToWord64# (word64ToInt64# x# `minusInt64#` word64ToInt64# y#)) @@ -681,6 +720,7 @@ instance Num Word64 where signum _ = 1 fromInteger i = W64# (integerToWord64 i) +-- | @since 2.01 instance Enum Word64 where succ x | x /= maxBound = x + 1 @@ -700,6 +740,7 @@ instance Enum Word64 where enumFromTo = integralEnumFromTo enumFromThenTo = integralEnumFromThenTo +-- | @since 2.01 instance Integral Word64 where quot (W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `quotWord64#` y#) @@ -721,6 +762,7 @@ instance Integral Word64 where | otherwise = divZeroError toInteger (W64# x#) = word64ToInteger x# +-- | @since 2.01 instance Bits Word64 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -781,6 +823,7 @@ data {-# CTYPE "HsWord64" #-} Word64 = W64# Word# -- ^ 64-bit unsigned integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Word64 where (==) = eqWord64 (/=) = neWord64 @@ -791,6 +834,7 @@ neWord64 (W64# x) (W64# y) = isTrue# (x `neWord#` y) {-# INLINE [1] eqWord64 #-} {-# INLINE [1] neWord64 #-} +-- | @since 2.01 instance Ord Word64 where (<) = ltWord64 (<=) = leWord64 @@ -807,6 +851,7 @@ gtWord64, geWord64, ltWord64, leWord64 :: Word64 -> Word64 -> Bool (W64# x) `ltWord64` (W64# y) = isTrue# (x `ltWord#` y) (W64# x) `leWord64` (W64# y) = isTrue# (x `leWord#` y) +-- | @since 2.01 instance Num Word64 where (W64# x#) + (W64# y#) = W64# (x# `plusWord#` y#) (W64# x#) - (W64# y#) = W64# (x# `minusWord#` y#) @@ -817,6 +862,7 @@ instance Num Word64 where signum _ = 1 fromInteger i = W64# (integerToWord i) +-- | @since 2.01 instance Enum Word64 where succ x | x /= maxBound = x + 1 @@ -836,6 +882,7 @@ instance Enum Word64 where enumFromTo = integralEnumFromTo enumFromThenTo = integralEnumFromThenTo +-- | @since 2.01 instance Integral Word64 where quot (W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `quotWord#` y#) @@ -863,6 +910,7 @@ instance Integral Word64 where where !i# = word2Int# x# +-- | @since 2.01 instance Bits Word64 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -906,26 +954,32 @@ uncheckedShiftRL64# = uncheckedShiftRL# #endif +-- | @since 4.6.0.0 instance FiniteBits Word64 where finiteBitSize _ = 64 countLeadingZeros (W64# x#) = I# (word2Int# (clz64# x#)) countTrailingZeros (W64# x#) = I# (word2Int# (ctz64# x#)) +-- | @since 2.01 instance Show Word64 where showsPrec p x = showsPrec p (toInteger x) +-- | @since 2.01 instance Real Word64 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Bounded Word64 where minBound = 0 maxBound = 0xFFFFFFFFFFFFFFFF +-- | @since 2.01 instance Ix Word64 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n +-- | @since 2.01 instance Read Word64 where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] diff --git a/libraries/base/System/Console/GetOpt.hs b/libraries/base/System/Console/GetOpt.hs index fa9f776ad5..3f36f1f7b3 100644 --- a/libraries/base/System/Console/GetOpt.hs +++ b/libraries/base/System/Console/GetOpt.hs @@ -96,14 +96,17 @@ data ArgDescr a | ReqArg (String -> a) String -- ^ option requires argument | OptArg (Maybe String -> a) String -- ^ optional argument +-- | @since 4.6.0.0 instance Functor ArgOrder where fmap _ RequireOrder = RequireOrder fmap _ Permute = Permute fmap f (ReturnInOrder g) = ReturnInOrder (f . g) +-- | @since 4.6.0.0 instance Functor OptDescr where fmap f (Option a b argDescr c) = Option a b (fmap f argDescr) c +-- | @since 4.6.0.0 instance Functor ArgDescr where fmap f (NoArg a) = NoArg (f a) fmap f (ReqArg g s) = ReqArg (f . g) s diff --git a/libraries/base/System/Mem/StableName.hs b/libraries/base/System/Mem/StableName.hs index cb4b71b11b..f2f2c2b911 100644 --- a/libraries/base/System/Mem/StableName.hs +++ b/libraries/base/System/Mem/StableName.hs @@ -85,6 +85,7 @@ makeStableName a = IO $ \ s -> hashStableName :: StableName a -> Int hashStableName (StableName sn) = I# (stableNameToInt# sn) +-- | @since 2.01 instance Eq (StableName a) where (StableName sn1) == (StableName sn2) = case eqStableName# sn1 sn2 of diff --git a/libraries/base/System/Timeout.hs b/libraries/base/System/Timeout.hs index c20950f357..d4ef0932b5 100644 --- a/libraries/base/System/Timeout.hs +++ b/libraries/base/System/Timeout.hs @@ -37,10 +37,12 @@ import Data.Unique (Unique, newUnique) newtype Timeout = Timeout Unique deriving (Eq) +-- | @since 3.0 instance Show Timeout where show _ = "<<timeout>>" -- Timeout is a child of SomeAsyncException +-- | @since 4.7.0.0 instance Exception Timeout where toException = asyncExceptionToException fromException = asyncExceptionFromException diff --git a/libraries/base/Text/ParserCombinators/ReadP.hs b/libraries/base/Text/ParserCombinators/ReadP.hs index 8b84acf24e..ed30b3bda6 100644 --- a/libraries/base/Text/ParserCombinators/ReadP.hs +++ b/libraries/base/Text/ParserCombinators/ReadP.hs @@ -104,12 +104,15 @@ data P a -- Monad, MonadPlus +-- | @since 4.5.0.0 instance Applicative P where pure x = Result x Fail (<*>) = ap +-- | @since 2.01 instance MonadPlus P +-- | @since 2.01 instance Monad P where (Get f) >>= k = Get (\c -> f c >>= k) (Look f) >>= k = Look (\s -> f s >>= k) @@ -119,9 +122,11 @@ instance Monad P where fail _ = Fail +-- | @since 4.9.0.0 instance MonadFail P where fail _ = Fail +-- | @since 4.5.0.0 instance Alternative P where empty = Fail @@ -158,24 +163,30 @@ newtype ReadP a = R (forall b . (a -> P b) -> P b) -- Functor, Monad, MonadPlus +-- | @since 2.01 instance Functor ReadP where fmap h (R f) = R (\k -> f (k . h)) +-- | @since 4.6.0.0 instance Applicative ReadP where pure x = R (\k -> k x) (<*>) = ap +-- | @since 2.01 instance Monad ReadP where fail _ = R (\_ -> Fail) R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k)) +-- | @since 4.9.0.0 instance MonadFail ReadP where fail _ = R (\_ -> Fail) +-- | @since 4.6.0.0 instance Alternative ReadP where empty = pfail (<|>) = (+++) +-- | @since 2.01 instance MonadPlus ReadP -- --------------------------------------------------------------------------- diff --git a/libraries/base/Text/ParserCombinators/ReadPrec.hs b/libraries/base/Text/ParserCombinators/ReadPrec.hs index 4306c6eca4..8e763ce1c2 100644 --- a/libraries/base/Text/ParserCombinators/ReadPrec.hs +++ b/libraries/base/Text/ParserCombinators/ReadPrec.hs @@ -73,22 +73,28 @@ newtype ReadPrec a = P (Prec -> ReadP a) -- Functor, Monad, MonadPlus +-- | @since 2.01 instance Functor ReadPrec where fmap h (P f) = P (\n -> fmap h (f n)) +-- | @since 4.6.0.0 instance Applicative ReadPrec where pure x = P (\_ -> pure x) (<*>) = ap +-- | @since 2.01 instance Monad ReadPrec where fail s = P (\_ -> fail s) P f >>= k = P (\n -> do a <- f n; let P f' = k a in f' n) +-- | @since 4.9.0.0 instance MonadFail.MonadFail ReadPrec where fail s = P (\_ -> MonadFail.fail s) +-- | @since 2.01 instance MonadPlus ReadPrec +-- | @since 4.6.0.0 instance Alternative ReadPrec where empty = pfail (<|>) = (+++) diff --git a/libraries/base/Text/Printf.hs b/libraries/base/Text/Printf.hs index 4d12e561c7..7902d5eedc 100644 --- a/libraries/base/Text/Printf.hs +++ b/libraries/base/Text/Printf.hs @@ -282,6 +282,7 @@ class HPrintfType t where instance PrintfType String where spr fmt args = uprintf fmt (reverse args) -} +-- | @since 2.01 instance (IsChar c) => PrintfType [c] where spr fmts args = map fromChar (uprintf fmts (reverse args)) @@ -289,18 +290,22 @@ instance (IsChar c) => PrintfType [c] where -- type system won't readily let us say that without -- bringing the GADTs. So we go conditional for these defs. +-- | @since 4.7.0.0 instance (a ~ ()) => PrintfType (IO a) where spr fmts args = putStr $ map fromChar $ uprintf fmts $ reverse args +-- | @since 4.7.0.0 instance (a ~ ()) => HPrintfType (IO a) where hspr hdl fmts args = do hPutStr hdl (uprintf fmts (reverse args)) +-- | @since 2.01 instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where spr fmts args = \ a -> spr fmts ((parseFormat a, formatArg a) : args) +-- | @since 2.01 instance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where hspr hdl fmts args = \ a -> hspr hdl fmts ((parseFormat a, formatArg a) : args) @@ -318,64 +323,80 @@ class PrintfArg a where parseFormat _ (c : cs) = FormatParse "" c cs parseFormat _ "" = errorShortFormat +-- | @since 2.01 instance PrintfArg Char where formatArg = formatChar parseFormat _ cf = parseIntFormat (undefined :: Int) cf +-- | @since 2.01 instance (IsChar c) => PrintfArg [c] where formatArg = formatString +-- | @since 2.01 instance PrintfArg Int where formatArg = formatInt parseFormat = parseIntFormat +-- | @since 2.01 instance PrintfArg Int8 where formatArg = formatInt parseFormat = parseIntFormat +-- | @since 2.01 instance PrintfArg Int16 where formatArg = formatInt parseFormat = parseIntFormat +-- | @since 2.01 instance PrintfArg Int32 where formatArg = formatInt parseFormat = parseIntFormat +-- | @since 2.01 instance PrintfArg Int64 where formatArg = formatInt parseFormat = parseIntFormat +-- | @since 2.01 instance PrintfArg Word where formatArg = formatInt parseFormat = parseIntFormat +-- | @since 2.01 instance PrintfArg Word8 where formatArg = formatInt parseFormat = parseIntFormat +-- | @since 2.01 instance PrintfArg Word16 where formatArg = formatInt parseFormat = parseIntFormat +-- | @since 2.01 instance PrintfArg Word32 where formatArg = formatInt parseFormat = parseIntFormat +-- | @since 2.01 instance PrintfArg Word64 where formatArg = formatInt parseFormat = parseIntFormat +-- | @since 2.01 instance PrintfArg Integer where formatArg = formatInteger parseFormat = parseIntFormat +-- | @since 4.8.0.0 instance PrintfArg Natural where formatArg = formatInteger . toInteger parseFormat = parseIntFormat +-- | @since 2.01 instance PrintfArg Float where formatArg = formatRealFloat +-- | @since 2.01 instance PrintfArg Double where formatArg = formatRealFloat @@ -389,6 +410,7 @@ class IsChar c where -- | @since 4.7.0.0 fromChar :: Char -> c +-- | @since 2.01 instance IsChar Char where toChar c = c fromChar c = c diff --git a/libraries/base/Text/Show/Functions.hs b/libraries/base/Text/Show/Functions.hs index 5230a4b4ca..fa2c1e0e37 100644 --- a/libraries/base/Text/Show/Functions.hs +++ b/libraries/base/Text/Show/Functions.hs @@ -21,6 +21,7 @@ module Text.Show.Functions () where +-- | @since 2.01 instance Show (a -> b) where showsPrec _ _ = showString "<function>" diff --git a/libraries/base/codepages/MakeTable.hs b/libraries/base/codepages/MakeTable.hs index 394d447a6d..b276e4b1a0 100644 --- a/libraries/base/codepages/MakeTable.hs +++ b/libraries/base/codepages/MakeTable.hs @@ -237,16 +237,20 @@ theTypes = [ "data ConvArray a = ConvArray Addr#" class (Ord a, Enum a, Bounded a, Show a) => Embed a where mkHex :: a -> String +-- | @since 4.2.0.0 instance Embed Word8 where mkHex = showHex' +-- | @since 4.2.0.0 instance Embed Word16 where mkHex = repDualByte +-- | @since 4.2.0.0 instance Embed Char where mkHex = repDualByte -- this is used for the indices of the compressed array. +-- | @since 4.2.0.0 instance Embed Int where mkHex = repDualByte |