[commit: packages/base] master: Improve Haddock markup (d62edab)
git at git.haskell.org
git at git.haskell.org
Thu Jan 30 09:42:22 UTC 2014
Repository : ssh://git@git.haskell.org/base
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/d62edabedcba287b9fa3cebf0cee63caaedb585f/base
>---------------------------------------------------------------
commit d62edabedcba287b9fa3cebf0cee63caaedb585f
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date: Thu Jan 30 10:30:04 2014 +0100
Improve Haddock markup
This fixes the markup at the top of `Control.Arrow`, and improves the
markup inside DEPRECATED strings.
(Haddock supports markup inside DEPRECATED messages, which allows to
turn references to Haskell entities into hyperlinks by using the usual
Haddock markup.)
Signed-off-by: Herbert Valerio Riedel <hvr at gnu.org>
>---------------------------------------------------------------
d62edabedcba287b9fa3cebf0cee63caaedb585f
Control/Arrow.hs | 5 +++++
Control/Concurrent/Chan.hs | 4 ++--
Control/Concurrent/MVar.hs | 2 +-
Data/Bits.hs | 2 +-
Data/Typeable/Internal.hs | 2 +-
Debug/Trace.hs | 4 ++--
Foreign/Marshal/Error.hs | 2 +-
GHC/Exts.hs | 2 +-
GHC/Generics.hs | 4 ++--
9 files changed, 16 insertions(+), 11 deletions(-)
diff --git a/Control/Arrow.hs b/Control/Arrow.hs
index c971be5..b723dd4 100644
--- a/Control/Arrow.hs
+++ b/Control/Arrow.hs
@@ -10,11 +10,15 @@
-- Portability : portable
--
-- Basic arrow definitions, based on
+--
-- * /Generalising Monads to Arrows/, by John Hughes,
-- /Science of Computer Programming/ 37, pp67-111, May 2000.
+--
-- plus a couple of definitions ('returnA' and 'loop') from
+--
-- * /A New Notation for Arrows/, by Ross Paterson, in /ICFP 2001/,
-- Firenze, Italy, pp229-240.
+--
-- These papers and more information on arrows can be found at
-- <http://www.haskell.org/arrows/>.
@@ -186,6 +190,7 @@ instance MonadPlus m => ArrowPlus (Kleisli m) where
-- | Choice, for arrows that support it. This class underlies the
-- @if@ and @case@ constructs in arrow notation.
+--
-- Minimal complete definition: 'left', satisfying the laws
--
-- * @'left' ('arr' f) = 'arr' ('left' f)@
diff --git a/Control/Concurrent/Chan.hs b/Control/Concurrent/Chan.hs
index 98c2efd..32387da 100644
--- a/Control/Concurrent/Chan.hs
+++ b/Control/Concurrent/Chan.hs
@@ -136,7 +136,7 @@ unGetChan (Chan readVar _) val = do
modifyMVar_ readVar $ \read_end -> do
putMVar new_read_end (ChItem val read_end)
return new_read_end
-{-# DEPRECATED unGetChan "if you need this operation, use Control.Concurrent.STM.TChan instead. See http://hackage.haskell.org/trac/ghc/ticket/4154 for details" #-} -- deprecated in 7.0
+{-# DEPRECATED unGetChan "if you need this operation, use Control.Concurrent.STM.TChan instead. See <http://ghc.haskell.org/trac/ghc/ticket/4154> for details" #-} -- deprecated in 7.0
-- |Returns 'True' if the supplied 'Chan' is empty.
isEmptyChan :: Chan a -> IO Bool
@@ -145,7 +145,7 @@ isEmptyChan (Chan readVar writeVar) = do
w <- readMVar writeVar
let eq = r == w
eq `seq` return eq
-{-# DEPRECATED isEmptyChan "if you need this operation, use Control.Concurrent.STM.TChan instead. See http://hackage.haskell.org/trac/ghc/ticket/4154 for details" #-} -- deprecated in 7.0
+{-# DEPRECATED isEmptyChan "if you need this operation, use Control.Concurrent.STM.TChan instead. See <http://ghc.haskell.org/trac/ghc/ticket/4154> for details" #-} -- deprecated in 7.0
-- Operators for interfacing with functional streams.
diff --git a/Control/Concurrent/MVar.hs b/Control/Concurrent/MVar.hs
index c988c62..aaf1939 100644
--- a/Control/Concurrent/MVar.hs
+++ b/Control/Concurrent/MVar.hs
@@ -245,7 +245,7 @@ modifyMVarMasked m io =
putMVar m a'
return b
-{-# DEPRECATED addMVarFinalizer "use mkWeakMVar instead" #-} -- deprecated in 7.6
+{-# DEPRECATED addMVarFinalizer "use 'mkWeakMVar' instead" #-} -- deprecated in 7.6
addMVarFinalizer :: MVar a -> IO () -> IO ()
addMVarFinalizer = GHC.MVar.addMVarFinalizer
diff --git a/Data/Bits.hs b/Data/Bits.hs
index f43c8a5..16a5b58 100644
--- a/Data/Bits.hs
+++ b/Data/Bits.hs
@@ -61,7 +61,7 @@ infixl 7 .&.
infixl 6 `xor`
infixl 5 .|.
-{-# DEPRECATED bitSize "Use bitSizeMaybe or finiteBitSize instead" #-} -- deprecated in 7.8
+{-# DEPRECATED bitSize "Use 'bitSizeMaybe' or 'finiteBitSize' instead" #-} -- deprecated in 7.8
{-|
The 'Bits' class defines bitwise operations over integral types.
diff --git a/Data/Typeable/Internal.hs b/Data/Typeable/Internal.hs
index 473b6f4..a058dc8 100644
--- a/Data/Typeable/Internal.hs
+++ b/Data/Typeable/Internal.hs
@@ -179,7 +179,7 @@ typeRepArgs :: TypeRep -> [TypeRep]
typeRepArgs (TypeRep _ _ args) = args
-- | Observe string encoding of a type representation
-{-# DEPRECATED tyConString "renamed to tyConName; tyConModule and tyConPackage are also available." #-} -- deprecated in 7.4
+{-# DEPRECATED tyConString "renamed to 'tyConName'; 'tyConModule' and 'tyConPackage' are also available." #-} -- deprecated in 7.4
tyConString :: TyCon -> String
tyConString = tyConName
diff --git a/Debug/Trace.hs b/Debug/Trace.hs
index 67e67b1..eedacfa 100644
--- a/Debug/Trace.hs
+++ b/Debug/Trace.hs
@@ -79,10 +79,10 @@ traceIO msg = do
foreign import ccall unsafe "HsBase.h debugBelch2"
debugBelch :: CString -> CString -> IO ()
--- | Deprecated. Use 'traceIO'.
+-- |
putTraceMsg :: String -> IO ()
putTraceMsg = traceIO
-{-# DEPRECATED putTraceMsg "Use Debug.Trace.traceIO" #-} -- deprecated in 7.4
+{-# DEPRECATED putTraceMsg "Use 'Debug.Trace.traceIO'" #-} -- deprecated in 7.4
{-# NOINLINE trace #-}
diff --git a/Foreign/Marshal/Error.hs b/Foreign/Marshal/Error.hs
index ab90e6d..758812b 100644
--- a/Foreign/Marshal/Error.hs
+++ b/Foreign/Marshal/Error.hs
@@ -79,4 +79,4 @@ throwIfNull = throwIf (== nullPtr) . const
--
void :: IO a -> IO ()
void act = act >> return ()
-{-# DEPRECATED void "use Control.Monad.void instead" #-} -- deprecated in 7.6
+{-# DEPRECATED void "use 'Control.Monad.void' instead" #-} -- deprecated in 7.6
diff --git a/GHC/Exts.hs b/GHC/Exts.hs
index 1cea3fb..a7a04b4 100755
--- a/GHC/Exts.hs
+++ b/GHC/Exts.hs
@@ -114,7 +114,7 @@ groupByFB c n eq xs0 = groupByFBCore xs0
traceEvent :: String -> IO ()
traceEvent = Debug.Trace.traceEventIO
-{-# DEPRECATED traceEvent "Use Debug.Trace.traceEvent or Debug.Trace.traceEventIO" #-} -- deprecated in 7.4
+{-# DEPRECATED traceEvent "Use 'Debug.Trace.traceEvent' or 'Debug.Trace.traceEventIO'" #-} -- deprecated in 7.4
{- **********************************************************************
diff --git a/GHC/Generics.hs b/GHC/Generics.hs
index 6480eb1..1c81858 100644
--- a/GHC/Generics.hs
+++ b/GHC/Generics.hs
@@ -622,8 +622,8 @@ data P
type Rec0 = K1 R
-- | Type synonym for encoding parameters (other than the last)
type Par0 = K1 P
-{-# DEPRECATED Par0 "Par0 is no longer used; use Rec0 instead" #-} -- deprecated in 7.6
-{-# DEPRECATED P "P is no longer used; use R instead" #-} -- deprecated in 7.6
+{-# DEPRECATED Par0 "'Par0' is no longer used; use 'Rec0' instead" #-} -- deprecated in 7.6
+{-# DEPRECATED P "'P' is no longer used; use 'R' instead" #-} -- deprecated in 7.6
-- | Tag for M1: datatype
data D
More information about the ghc-commits
mailing list