diff options
25 files changed, 109 insertions, 0 deletions
diff --git a/libraries/base/Control/Concurrent.hs b/libraries/base/Control/Concurrent.hs index 25671bf1d8..ce081661aa 100644 --- a/libraries/base/Control/Concurrent.hs +++ b/libraries/base/Control/Concurrent.hs @@ -434,6 +434,8 @@ threadWaitWrite fd -- to read from a file descriptor. The second returned value -- is an IO action that can be used to deregister interest -- in the file descriptor. +-- +-- /Since: 4.7.0.0/ threadWaitReadSTM :: Fd -> IO (STM (), IO ()) threadWaitReadSTM fd #ifdef mingw32_HOST_OS @@ -456,6 +458,8 @@ threadWaitReadSTM fd -- can be written to a file descriptor. The second returned value -- is an IO action that can be used to deregister interest -- in the file descriptor. +-- +-- /Since: 4.7.0.0/ threadWaitWriteSTM :: Fd -> IO (STM (), IO ()) threadWaitWriteSTM fd #ifdef mingw32_HOST_OS diff --git a/libraries/base/Data/Bits.hs b/libraries/base/Data/Bits.hs index d32d45ddf8..08ff6f9451 100644 --- a/libraries/base/Data/Bits.hs +++ b/libraries/base/Data/Bits.hs @@ -149,6 +149,8 @@ class Eq a => Bits a where {-| Return the number of bits in the type of the argument. The actual value of the argument is ignored. Returns Nothing for types that do not have a fixed bitsize, like 'Integer'. + + /Since: 4.7.0.0/ -} bitSizeMaybe :: a -> Maybe Int diff --git a/libraries/base/Data/Bool.hs b/libraries/base/Data/Bool.hs index 0dd8198dc2..deeac800f9 100644 --- a/libraries/base/Data/Bool.hs +++ b/libraries/base/Data/Bool.hs @@ -31,6 +31,8 @@ import GHC.Base -- | Case analysis for the 'Bool' type. -- @bool a b p@ evaluates to @a@ when @p@ is @False@, and evaluates to @b@ -- when @p@ is @True@. +-- +-- /Since: 4.7.0.0/ bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t diff --git a/libraries/base/Data/Either.hs b/libraries/base/Data/Either.hs index 5ed041dd31..b494e265fb 100644 --- a/libraries/base/Data/Either.hs +++ b/libraries/base/Data/Either.hs @@ -90,11 +90,15 @@ partitionEithers = foldr (either left right) ([],[]) right a ~(l, r) = (l, a:r) -- | Return `True` if the given value is a `Left`-value, `False` otherwise. +-- +-- /Since: 4.7.0.0/ isLeft :: Either a b -> Bool isLeft (Left _) = True isLeft (Right _) = False -- | Return `True` if the given value is a `Right`-value, `False` otherwise. +-- +-- /Since: 4.7.0.0/ isRight :: Either a b -> Bool isRight (Left _) = False isRight (Right _) = True diff --git a/libraries/base/Data/Functor.hs b/libraries/base/Data/Functor.hs index a578bdd231..fdf7c4b060 100644 --- a/libraries/base/Data/Functor.hs +++ b/libraries/base/Data/Functor.hs @@ -33,6 +33,9 @@ infixl 4 <$> infixl 4 $> +-- | Flipped version of '$>'. +-- +-- /Since: 4.7.0.0/ ($>) :: Functor f => f a -> b -> f b ($>) = flip (<$) diff --git a/libraries/base/Data/OldTypeable.hs b/libraries/base/Data/OldTypeable.hs index ab936c4216..b0f4afcc1f 100644 --- a/libraries/base/Data/OldTypeable.hs +++ b/libraries/base/Data/OldTypeable.hs @@ -28,6 +28,7 @@ -- deprecated; users are recommended to use the kind-polymorphic -- "Data.Typeable" module instead. -- +-- /Since: 4.7.0.0/ ----------------------------------------------------------------------------- module Data.OldTypeable {-# DEPRECATED "Use Data.Typeable instead" #-} -- deprecated in 7.8 diff --git a/libraries/base/Data/OldTypeable/Internal.hs b/libraries/base/Data/OldTypeable/Internal.hs index 9718237fd1..2b02930466 100644 --- a/libraries/base/Data/OldTypeable/Internal.hs +++ b/libraries/base/Data/OldTypeable/Internal.hs @@ -10,6 +10,7 @@ -- function mkTyCon which is used by derived instances of Typeable to -- construct a TyCon. -- +-- /Since: 4.7.0.0/ ----------------------------------------------------------------------------- {-# LANGUAGE CPP diff --git a/libraries/base/Data/Proxy.hs b/libraries/base/Data/Proxy.hs index 083db91291..4c2c5df8f8 100644 --- a/libraries/base/Data/Proxy.hs +++ b/libraries/base/Data/Proxy.hs @@ -12,6 +12,7 @@ -- -- Definition of a Proxy type (poly-kinded in GHC) -- +-- /Since: 4.7.0.0/ ----------------------------------------------------------------------------- module Data.Proxy diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index 62b0241d13..5293ce67d2 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -19,6 +19,7 @@ -- Definition of propositional equality @(:=:)@. Pattern-matching on a variable -- of type @(a :=: b)@ produces a proof that @a ~ b@. -- +-- /Since: 4.7.0.0/ ----------------------------------------------------------------------------- @@ -37,6 +38,8 @@ infix 4 :=: -- value, then the type @a@ is the same as the type @b@. To use this equality -- in practice, pattern-match on the @a :=: b@ to get out the @Refl@ constructor; -- in the body of the pattern-match, the compiler knows that @a ~ b@. +-- +-- /Since: 4.7.0.0/ data a :=: b where Refl :: a :=: a diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 5dd1417228..8917da9269 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -193,6 +193,8 @@ class Typeable a where typeRep :: proxy a -> TypeRep -- ^ Takes a value of type @a@ and returns a concrete representation -- of that type. + -- + -- /Version: 4.7.0.0/ -- Keeping backwards-compatibility typeOf :: forall a. Typeable a => a -> TypeRep diff --git a/libraries/base/Debug/Trace.hs b/libraries/base/Debug/Trace.hs index 7f78a85c0c..a857760dee 100644 --- a/libraries/base/Debug/Trace.hs +++ b/libraries/base/Debug/Trace.hs @@ -105,6 +105,8 @@ trace string expr = unsafePerformIO $ do {-| Like 'trace' but returns the message instead of a third value. + +/Since: 4.7.0.0/ -} traceId :: String -> String traceId a = trace a a @@ -127,6 +129,8 @@ traceShow = trace . show {-| Like 'traceShow' but returns the shown value instead of a third value. + +/Since: 4.7.0.0/ -} traceShowId :: (Show a) => a -> a traceShowId a = trace (show a) a @@ -141,6 +145,8 @@ monad, as 'traceIO' is in the 'IO' monad. > traceM $ "x: " ++ show x > y <- ... > traceM $ "y: " ++ show y + +/Since: 4.7.0.0/ -} traceM :: (Monad m) => String -> m () traceM string = trace string $ return () @@ -153,6 +159,8 @@ Like 'traceM', but uses 'show' on the argument to convert it to a 'String'. > traceMShow $ x > y <- ... > traceMShow $ x + y + +/Since: 4.7.0.0/ -} traceShowM :: (Show a, Monad m) => a -> m () traceShowM = traceM . show @@ -246,6 +254,7 @@ traceEventIO msg = -- duplicate events emitted if two CPUs simultaneously evaluate the same thunk -- that uses 'traceMarker'. -- +-- /Since: 4.7.0.0/ traceMarker :: String -> a -> a traceMarker msg expr = unsafeDupablePerformIO $ do traceMarkerIO msg @@ -257,6 +266,7 @@ traceMarker msg expr = unsafeDupablePerformIO $ do -- Compared to 'traceMarker', 'traceMarkerIO' sequences the event with respect to -- other IO actions. -- +-- /Since: 4.7.0.0/ traceMarkerIO :: String -> IO () traceMarkerIO msg = GHC.Foreign.withCString utf8 msg $ \(Ptr p) -> IO $ \s -> diff --git a/libraries/base/Foreign/C/Error.hs b/libraries/base/Foreign/C/Error.hs index ad15edbb52..86a2df5b7b 100644 --- a/libraries/base/Foreign/C/Error.hs +++ b/libraries/base/Foreign/C/Error.hs @@ -204,6 +204,7 @@ eNOTDIR = Errno (CONST_ENOTDIR) eNOTEMPTY = Errno (CONST_ENOTEMPTY) eNOTSOCK = Errno (CONST_ENOTSOCK) eNOTSUP = Errno (CONST_ENOTSUP) +-- ^ /Since: 4.7.0.0/ eNOTTY = Errno (CONST_ENOTTY) eNXIO = Errno (CONST_ENXIO) eOPNOTSUPP = Errno (CONST_EOPNOTSUPP) diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index eee2509515..1cea3fb4a3 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -142,6 +142,8 @@ data SpecConstrAnnotation = NoSpecConstr | ForceSpecConstr -- | The 'IsList' class and its methods are intended to be used in -- conjunction with the OverloadedLists extension. +-- +-- /Since: 4.7.0.0/ class IsList l where -- | The 'Item' type function returns the type of items of the structure -- @l@. diff --git a/libraries/base/GHC/Fingerprint.hs b/libraries/base/GHC/Fingerprint.hs index e8ab088b2f..1f712f5360 100644 --- a/libraries/base/GHC/Fingerprint.hs +++ b/libraries/base/GHC/Fingerprint.hs @@ -73,6 +73,8 @@ fingerprintString str = unsafeDupablePerformIO $ -- | Computes the hash of a given file. -- This function loops over the handle, running in constant memory. +-- +-- /Since: 4.7.0.0/ getFileHash :: FilePath -> IO Fingerprint getFileHash path = withBinaryFile path ReadMode $ \h -> do allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs index 6f374590df..8691477c2a 100644 --- a/libraries/base/GHC/IO/Exception.hs +++ b/libraries/base/GHC/IO/Exception.hs @@ -110,6 +110,9 @@ instance Show AssertionFailed where ----- +-- |Superclass for asynchronous exceptions. +-- +-- /Since: 4.7.0.0/ data SomeAsyncException = forall e . Exception e => SomeAsyncException e deriving Typeable @@ -118,9 +121,11 @@ instance Show SomeAsyncException where instance Exception SomeAsyncException +-- |/Since: 4.7.0.0/ asyncExceptionToException :: Exception e => e -> SomeException asyncExceptionToException = toException . SomeAsyncException +-- |/Since: 4.7.0.0/ asyncExceptionFromException :: Exception e => SomeException -> Maybe e asyncExceptionFromException x = do SomeAsyncException a <- fromException x diff --git a/libraries/base/GHC/MVar.hs b/libraries/base/GHC/MVar.hs index 314a440b55..03facad608 100644 --- a/libraries/base/GHC/MVar.hs +++ b/libraries/base/GHC/MVar.hs @@ -156,6 +156,8 @@ tryPutMVar (MVar mvar#) x = IO $ \ s# -> -- |A non-blocking version of 'readMVar'. The 'tryReadMVar' function -- returns immediately, with 'Nothing' if the 'MVar' was empty, or -- @'Just' a@ if the 'MVar' was full with contents @a@. +-- +-- /Since: 4.7.0.0/ tryReadMVar :: MVar a -> IO (Maybe a) tryReadMVar (MVar m) = IO $ \ s -> case tryReadMVar# m s of diff --git a/libraries/base/GHC/Profiling.hs b/libraries/base/GHC/Profiling.hs index 10a3d5b1f8..2654ef7d4b 100644 --- a/libraries/base/GHC/Profiling.hs +++ b/libraries/base/GHC/Profiling.hs @@ -1,5 +1,6 @@ {-# LANGUAGE ForeignFunctionInterface #-} +-- | /Since: 4.7.0.0/ module GHC.Profiling where foreign import ccall startProfTimer :: IO () diff --git a/libraries/base/GHC/Stack.hsc b/libraries/base/GHC/Stack.hsc index 849a48ce41..56b317a58a 100644 --- a/libraries/base/GHC/Stack.hsc +++ b/libraries/base/GHC/Stack.hsc @@ -111,6 +111,8 @@ renderStack strs = "Stack trace:" ++ concatMap ("\n "++) (reverse strs) -- | Like the function 'error', but appends a stack trace to the error -- message if one is available. +-- +-- /Since: 4.7.0.0/ errorWithStackTrace :: String -> a errorWithStackTrace x = unsafeDupablePerformIO $ do stack <- ccsToStrings =<< getCurrentCCS x diff --git a/libraries/base/GHC/TypeLits.hs b/libraries/base/GHC/TypeLits.hs index f71f654851..0f32ae63d2 100644 --- a/libraries/base/GHC/TypeLits.hs +++ b/libraries/base/GHC/TypeLits.hs @@ -316,6 +316,8 @@ type instance FromNat1 (Succ n) = 1 + FromNat1 n -------------------------------------------------------------------------------- -- | A type that provides evidence for equality between two types. +-- +-- /Since: 4.7.0.0/ data (:~:) :: k -> k -> * where Refl :: a :~: a diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs index 1581c4a868..d2568eadbd 100644 --- a/libraries/base/GHC/Word.hs +++ b/libraries/base/GHC/Word.hs @@ -303,6 +303,9 @@ instance Bits Word16 where instance FiniteBits Word16 where finiteBitSize _ = 16 +-- | Swap bytes in 'Word16'. +-- +-- /Since: 4.7.0.0/ byteSwap16 :: Word16 -> Word16 byteSwap16 (W16# w#) = W16# (narrow16Word# (byteSwap16# w#)) @@ -530,6 +533,9 @@ instance Read Word32 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] #endif +-- | Reverse order of bytes in 'Word32'. +-- +-- /Since: 4.7.0.0/ byteSwap32 :: Word32 -> Word32 byteSwap32 (W32# w#) = W32# (narrow32Word# (byteSwap32# w#)) @@ -781,6 +787,9 @@ instance Ix Word64 where instance Read Word64 where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] +-- | Reverse order of bytes in 'Word64'. +-- +-- /Since: 4.7.0.0/ #if WORD_SIZE_IN_BITS < 64 byteSwap64 :: Word64 -> Word64 byteSwap64 (W64# w#) = W64# (byteSwap64# w#) diff --git a/libraries/base/Numeric.hs b/libraries/base/Numeric.hs index 88b2e1a063..4a1a5b121a 100644 --- a/libraries/base/Numeric.hs +++ b/libraries/base/Numeric.hs @@ -187,6 +187,8 @@ showGFloat d x = showString (formatRealFloat FFGeneric d x) -- -- This behaves as 'showFFloat', except that a decimal point -- is always guaranteed, even if not needed. +-- +-- /Since: 4.7.0.0/ showFFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS -- | Show a signed 'RealFloat' value @@ -195,6 +197,8 @@ showFFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS -- -- This behaves as 'showFFloat', except that a decimal point -- is always guaranteed, even if not needed. +-- +-- /Since: 4.7.0.0/ showGFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS showFFloatAlt d x = showString (formatRealFloatAlt FFFixed d True x) diff --git a/libraries/base/System/Environment.hs b/libraries/base/System/Environment.hs index 8397fc30b5..4288a603c8 100644 --- a/libraries/base/System/Environment.hs +++ b/libraries/base/System/Environment.hs @@ -266,6 +266,8 @@ ioe_missingEnvVar name = ioException (IOError Nothing NoSuchThing "getEnv" -- -- Throws `Control.Exception.IOException` if @name@ is the empty string or -- contains an equals sign. +-- +-- /Since: 4.7.0.0/ setEnv :: String -> String -> IO () setEnv key_ value_ | null key = throwIO (mkIOError InvalidArgument "setEnv" Nothing Nothing) @@ -308,6 +310,8 @@ foreign import ccall unsafe "putenv" c_putenv :: CString -> IO CInt -- -- Throws `Control.Exception.IOException` if @name@ is the empty string or -- contains an equals sign. +-- +-- /Since: 4.7.0.0/ unsetEnv :: String -> IO () #ifdef mingw32_HOST_OS unsetEnv key = withCWString key $ \k -> do diff --git a/libraries/base/System/Mem/StableName.hs b/libraries/base/System/Mem/StableName.hs index 1633efed83..7d080d9247 100644 --- a/libraries/base/System/Mem/StableName.hs +++ b/libraries/base/System/Mem/StableName.hs @@ -116,6 +116,8 @@ instance Eq (StableName a) where -- | Equality on 'StableName' that does not require that the types of -- the arguments match. +-- +-- /Since: 4.7.0.0/ eqStableName :: StableName a -> StableName b -> Bool eqStableName (StableName sn1) (StableName sn2) = case eqStableName# sn1 sn2 of diff --git a/libraries/base/Text/Printf.hs b/libraries/base/Text/Printf.hs index 84ecd89c9c..ec68edb64b 100644 --- a/libraries/base/Text/Printf.hs +++ b/libraries/base/Text/Printf.hs @@ -331,7 +331,9 @@ instance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where -- default 'parseFormat' expects no modifiers: this is the normal -- case. Minimal instance: 'formatArg'. class PrintfArg a where + -- | /Since: 4.7.0.0/ formatArg :: a -> FieldFormatter + -- | /Since: 4.7.0.0/ parseFormat :: a -> ModifierParser parseFormat _ (c : cs) = FormatParse "" c cs parseFormat _ "" = errorShortFormat @@ -398,7 +400,9 @@ instance PrintfArg Double where -- type, is not allowable as a typeclass instance. 'IsChar' -- is exported for backward-compatibility. class IsChar c where + -- | /Since: 4.7.0.0/ toChar :: c -> Char + -- | /Since: 4.7.0.0/ fromChar :: Char -> c instance IsChar Char where @@ -409,14 +413,20 @@ instance IsChar Char where -- | Whether to left-adjust or zero-pad a field. These are -- mutually exclusive, with 'LeftAdjust' taking precedence. +-- +-- /Since: 4.7.0.0/ data FormatAdjustment = LeftAdjust | ZeroPad -- | How to handle the sign of a numeric field. These are -- mutually exclusive, with 'SignPlus' taking precedence. +-- +-- /Since: 4.7.0.0/ data FormatSign = SignPlus | SignSpace -- | Description of field formatting for 'formatArg'. See UNIX `printf`(3) -- for a description of how field formatting works. +-- +-- /Since: 4.7.0.0/ data FieldFormat = FieldFormat { fmtWidth :: Maybe Int, -- ^ Total width of the field. fmtPrecision :: Maybe Int, -- ^ Secondary field width specifier. @@ -449,6 +459,8 @@ data FieldFormat = FieldFormat { -- | The \"format parser\" walks over argument-type-specific -- modifier characters to find the primary format character. -- This is the type of its result. +-- +-- /Since: 4.7.0.0/ data FormatParse = FormatParse { fpModifiers :: String, -- ^ Any modifiers found. fpChar :: Char, -- ^ Primary format character. @@ -489,26 +501,36 @@ parseIntFormat _ s = -- | This is the type of a field formatter reified over its -- argument. +-- +-- /Since: 4.7.0.0/ type FieldFormatter = FieldFormat -> ShowS -- | Type of a function that will parse modifier characters -- from the format string. +-- +-- /Since: 4.7.0.0/ type ModifierParser = String -> FormatParse -- | Substitute a \'v\' format character with the given -- default format character in the 'FieldFormat'. A -- convenience for user-implemented types, which should -- support \"%v\". +-- +-- /Since: 4.7.0.0/ vFmt :: Char -> FieldFormat -> FieldFormat vFmt c ufmt@(FieldFormat {fmtChar = 'v'}) = ufmt {fmtChar = c} vFmt _ ufmt = ufmt -- | Formatter for 'Char' values. +-- +-- /Since: 4.7.0.0/ formatChar :: Char -> FieldFormatter formatChar x ufmt = formatIntegral (Just 0) (toInteger $ ord x) $ vFmt 'c' ufmt -- | Formatter for 'String' values. +-- +-- /Since: 4.7.0.0/ formatString :: IsChar a => [a] -> FieldFormatter formatString x ufmt = case fmtChar $ vFmt 's' ufmt of @@ -532,6 +554,8 @@ fixupMods ufmt m = Nothing -> perror "unknown format modifier" -- | Formatter for 'Int' values. +-- +-- /Since: 4.7.0.0/ formatInt :: (Integral a, Bounded a) => a -> FieldFormatter formatInt x ufmt = let lb = toInteger $ minBound `asTypeOf` x @@ -543,6 +567,8 @@ formatInt x ufmt = formatIntegral m (toInteger x) ufmt' -- | Formatter for 'Integer' values. +-- +-- /Since: 4.7.0.0/ formatInteger :: Integer -> FieldFormatter formatInteger x ufmt = let m = fixupMods ufmt Nothing in @@ -582,6 +608,8 @@ formatIntegral m x ufmt0 = upcase (s1, s2) = (s1, map toUpper s2) -- | Formatter for 'RealFloat' values. +-- +-- /Since: 4.7.0.0/ formatRealFloat :: RealFloat a => a -> FieldFormatter formatRealFloat x ufmt = let c = fmtChar $ vFmt 'g' ufmt @@ -856,21 +884,31 @@ dfmt c p a d = -- | Raises an 'error' with a printf-specific prefix on the -- message string. +-- +-- /Since: 4.7.0.0/ perror :: String -> a perror s = error $ "printf: " ++ s -- | Calls 'perror' to indicate an unknown format letter for -- a given type. +-- +-- /Since: 4.7.0.0/ errorBadFormat :: Char -> a errorBadFormat c = perror $ "bad formatting char " ++ show c errorShortFormat, errorMissingArgument, errorBadArgument :: a -- | Calls 'perror' to indicate that the format string ended -- early. +-- +-- /Since: 4.7.0.0/ errorShortFormat = perror "formatting string ended prematurely" -- | Calls 'perror' to indicate that there is a missing -- argument in the argument list. +-- +-- /Since: 4.7.0.0/ errorMissingArgument = perror "argument list ended prematurely" -- | Calls 'perror' to indicate that there is a type -- error or similar in the given argument. +-- +-- /Since: 4.7.0.0/ errorBadArgument = perror "bad argument" diff --git a/libraries/base/Text/Read/Lex.hs b/libraries/base/Text/Read/Lex.hs index 637299ac98..28bad33852 100644 --- a/libraries/base/Text/Read/Lex.hs +++ b/libraries/base/Text/Read/Lex.hs @@ -73,6 +73,7 @@ numberToInteger (MkNumber base iPart) = Just (val (fromIntegral base) 0 iPart) numberToInteger (MkDecimal iPart Nothing Nothing) = Just (val 10 0 iPart) numberToInteger _ = Nothing +-- | /Since: 4.7.0.0/ numberToFixed :: Integer -> Number -> Maybe (Integer, Integer) numberToFixed _ (MkNumber base iPart) = Just (val (fromIntegral base) 0 iPart, 0) numberToFixed _ (MkDecimal iPart Nothing Nothing) = Just (val 10 0 iPart, 0) @@ -151,6 +152,7 @@ numberToRational (MkDecimal iPart mFPart mExp) lex :: ReadP Lexeme lex = skipSpaces >> lexToken +-- | /Since: 4.7.0.0/ expect :: Lexeme -> ReadP () expect lexeme = do { skipSpaces ; thing <- lexToken |