aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/Backends/Hoogle.hs2
-rw-r--r--src/Haddock/Backends/LaTeX.hs6
-rw-r--r--src/Haddock/Backends/Xhtml/DocMarkup.hs3
-rw-r--r--src/Haddock/Interface/LexParseRn.hs2
-rw-r--r--src/Haddock/Interface/Rename.hs2
-rw-r--r--src/Haddock/InterfaceFile.hs21
-rw-r--r--src/Haddock/Parse.y4
-rw-r--r--src/Haddock/Types.hs10
-rw-r--r--src/Haddock/Utils.hs4
9 files changed, 37 insertions, 17 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index d27ca80f..25ca65e9 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -247,7 +247,7 @@ markupTag = Markup {
markupOrderedList = box (TagL 'o'),
markupDefList = box (TagL 'u') . map (\(a,b) -> TagInline "i" a : Str " " : b),
markupCodeBlock = box TagPre,
- markupURL = box (TagInline "a") . str,
+ markupHyperlink = \(Hyperlink url mLabel) -> (box (TagInline "a") . str) (fromMaybe url mLabel),
markupAName = const $ str "",
markupExample = box TagPre . str . unlines . map exampleToString
}
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 31ba3b0b..ef72505c 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -1011,7 +1011,7 @@ parLatexMarkup ppId = Markup {
markupOrderedList = \p v -> enumeratedList (map ($v) p) $$ text "",
markupDefList = \l v -> descriptionList (map (\(a,b) -> (a v, b v)) l),
markupCodeBlock = \p _ -> quote (verb (p Verb)) $$ text "",
- markupURL = \u _ -> text "\\url" <> braces (text u),
+ markupHyperlink = \l _ -> markupLink l,
markupAName = \_ _ -> empty,
markupExample = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e
}
@@ -1020,6 +1020,10 @@ parLatexMarkup ppId = Markup {
fixString Verb s = s
fixString Mono s = latexMonoFilter s
+ markupLink (Hyperlink url mLabel) = case mLabel of
+ Just label -> text "\\href" <> braces (text url) <> braces (text label)
+ Nothing -> text "\\url" <> braces (text url)
+
markupId ppId_ id v =
case v of
Verb -> theid
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 052116ee..e75cfaba 100644
--- a/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -25,6 +25,7 @@ import Haddock.Types
import Haddock.Utils
import Text.XHtml hiding ( name, title, p, quote )
+import Data.Maybe (fromMaybe)
import GHC
@@ -46,7 +47,7 @@ parHtmlMarkup qual ppId = Markup {
markupOrderedList = ordList,
markupDefList = defList,
markupCodeBlock = pre,
- markupURL = \url -> anchor ! [href url] << url,
+ markupHyperlink = \(Hyperlink url mLabel) -> anchor ! [href url] << fromMaybe url mLabel,
markupAName = \aname -> namedAnchor aname << "",
markupPic = \path -> image ! [src path],
markupExample = examplesToHtml
diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs
index 56ed1b42..de006386 100644
--- a/src/Haddock/Interface/LexParseRn.hs
+++ b/src/Haddock/Interface/LexParseRn.hs
@@ -113,7 +113,7 @@ rename gre = rn
DocCodeBlock doc -> DocCodeBlock (rn doc)
DocIdentifierUnchecked x -> DocIdentifierUnchecked x
DocModule str -> DocModule str
- DocURL str -> DocURL str
+ DocHyperlink l -> DocHyperlink l
DocPic str -> DocPic str
DocAName str -> DocAName str
DocExamples e -> DocExamples e
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index b703da0f..18e5f1d2 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -200,7 +200,7 @@ renameDoc d = case d of
DocCodeBlock doc -> do
doc' <- renameDoc doc
return (DocCodeBlock doc')
- DocURL str -> return (DocURL str)
+ DocHyperlink l -> return (DocHyperlink l)
DocPic str -> return (DocPic str)
DocAName str -> return (DocAName str)
DocExamples e -> return (DocExamples e)
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index 970093df..ebe15325 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -66,13 +66,13 @@ binaryInterfaceMagic = 0xD0Cface
-- we version our interface files accordingly.
binaryInterfaceVersion :: Word16
#if __GLASGOW_HASKELL__ == 702
-binaryInterfaceVersion = 20
+binaryInterfaceVersion = 21
#elif __GLASGOW_HASKELL__ == 703
-binaryInterfaceVersion = 20
+binaryInterfaceVersion = 21
#elif __GLASGOW_HASKELL__ == 704
-binaryInterfaceVersion = 20
+binaryInterfaceVersion = 21
#elif __GLASGOW_HASKELL__ == 705
-binaryInterfaceVersion = 20
+binaryInterfaceVersion = 21
#else
#error Unknown GHC version
#endif
@@ -413,6 +413,15 @@ instance Binary Example where
result <- get bh
return (Example expression result)
+instance Binary Hyperlink where
+ put_ bh (Hyperlink url label) = do
+ put_ bh url
+ put_ bh label
+ get bh = do
+ url <- get bh
+ label <- get bh
+ return (Hyperlink url label)
+
{-* Generated by DrIFT : Look, but Don't Touch. *-}
instance (Binary id) => Binary (Doc id) where
@@ -452,7 +461,7 @@ instance (Binary id) => Binary (Doc id) where
put_ bh (DocCodeBlock al) = do
putByte bh 11
put_ bh al
- put_ bh (DocURL am) = do
+ put_ bh (DocHyperlink am) = do
putByte bh 12
put_ bh am
put_ bh (DocPic x) = do
@@ -511,7 +520,7 @@ instance (Binary id) => Binary (Doc id) where
return (DocCodeBlock al)
12 -> do
am <- get bh
- return (DocURL am)
+ return (DocHyperlink am)
13 -> do
x <- get bh
return (DocPic x)
diff --git a/src/Haddock/Parse.y b/src/Haddock/Parse.y
index e36e8416..0cc783ee 100644
--- a/src/Haddock/Parse.y
+++ b/src/Haddock/Parse.y
@@ -10,7 +10,7 @@
module Haddock.Parse where
import Haddock.Lex
-import Haddock.Types (Doc(..), Example(Example))
+import Haddock.Types (Doc(..), Example(Example), Hyperlink(..))
import Haddock.Doc
import HsSyn
import RdrName
@@ -107,7 +107,7 @@ seq1 :: { Doc RdrName }
elem1 :: { Doc RdrName }
: STRING { DocString $1 }
| '/../' { DocEmphasis (DocString $1) }
- | URL { DocURL $1 }
+ | URL { DocHyperlink (Hyperlink $1 Nothing) }
| PIC { DocPic $1 }
| ANAME { DocAName $1 }
| IDENT { DocIdentifier $1 }
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 048a7ff7..f8890ebf 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -303,7 +303,7 @@ data Doc id
| DocOrderedList [Doc id]
| DocDefList [(Doc id, Doc id)]
| DocCodeBlock (Doc id)
- | DocURL String
+ | DocHyperlink Hyperlink
| DocPic String
| DocAName String
| DocExamples [Example]
@@ -315,6 +315,12 @@ instance Monoid (Doc id) where
mappend = DocAppend
+data Hyperlink = Hyperlink
+ { hyperlinkUrl :: String
+ , hyperlinkLabel :: Maybe String
+ }
+
+
data Example = Example
{ exampleExpression :: String
, exampleResult :: [String]
@@ -341,7 +347,7 @@ data DocMarkup id a = Markup
, markupOrderedList :: [a] -> a
, markupDefList :: [(a,a)] -> a
, markupCodeBlock :: a -> a
- , markupURL :: String -> a
+ , markupHyperlink :: Hyperlink -> a
, markupAName :: String -> a
, markupPic :: String -> a
, markupExample :: [Example] -> a
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index 3a2f1d28..ad61e88a 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -416,7 +416,7 @@ markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds)
markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds)
markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds)
markup m (DocCodeBlock d) = markupCodeBlock m (markup m d)
-markup m (DocURL url) = markupURL m url
+markup m (DocHyperlink l) = markupHyperlink m l
markup m (DocAName ref) = markupAName m ref
markup m (DocPic img) = markupPic m img
markup m (DocExamples e) = markupExample m e
@@ -443,7 +443,7 @@ idMarkup = Markup {
markupOrderedList = DocOrderedList,
markupDefList = DocDefList,
markupCodeBlock = DocCodeBlock,
- markupURL = DocURL,
+ markupHyperlink = DocHyperlink,
markupAName = DocAName,
markupPic = DocPic,
markupExample = DocExamples
generated by cgit v1.2.3 (git 2.39.1) at 2025-11-04 02:49:45 +0000