aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Haddock/Backends/Hoogle.hs1
-rw-r--r--src/Haddock/Backends/LaTeX.hs1
-rw-r--r--src/Haddock/Backends/Xhtml/DocMarkup.hs1
-rw-r--r--src/Haddock/Interface/LexParseRn.hs1
-rw-r--r--src/Haddock/Interface/Rename.hs1
-rw-r--r--src/Haddock/InterfaceFile.hs6
-rw-r--r--src/Haddock/Lex.x8
-rw-r--r--src/Haddock/Parse.y6
-rw-r--r--src/Haddock/Types.hs2
-rw-r--r--src/Haddock/Utils.hs2
10 files changed, 29 insertions, 0 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 4949daa1..28d35aca 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -256,6 +256,7 @@ markupTag dflags = Markup {
markupCodeBlock = box TagPre,
markupHyperlink = \(Hyperlink url mLabel) -> (box (TagInline "a") . str) (fromMaybe url mLabel),
markupAName = const $ str "",
+ markupProperty = box TagPre . str,
markupExample = box TagPre . str . unlines . map exampleToString
}
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 68cf715a..bf1e6ac3 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -1003,6 +1003,7 @@ parLatexMarkup ppId = Markup {
markupCodeBlock = \p _ -> quote (verb (p Verb)) $$ text "",
markupHyperlink = \l _ -> markupLink l,
markupAName = \_ _ -> empty,
+ markupProperty = \p _ -> quote $ verb $ text p,
markupExample = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e
}
where
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs
index e75cfaba..aa4ba377 100644
--- a/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -50,6 +50,7 @@ parHtmlMarkup qual ppId = Markup {
markupHyperlink = \(Hyperlink url mLabel) -> anchor ! [href url] << fromMaybe url mLabel,
markupAName = \aname -> namedAnchor aname << "",
markupPic = \path -> image ! [src path],
+ markupProperty = pre . toHtml,
markupExample = examplesToHtml
}
where
diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs
index 3ad9719e..ced12d8d 100644
--- a/src/Haddock/Interface/LexParseRn.hs
+++ b/src/Haddock/Interface/LexParseRn.hs
@@ -121,6 +121,7 @@ rename dflags gre = rn
DocHyperlink l -> DocHyperlink l
DocPic str -> DocPic str
DocAName str -> DocAName str
+ DocProperty p -> DocProperty p
DocExamples e -> DocExamples e
DocEmpty -> DocEmpty
DocString str -> DocString str
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 0f702683..55c9a5da 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -202,6 +202,7 @@ renameDoc d = case d of
DocHyperlink l -> return (DocHyperlink l)
DocPic str -> return (DocPic str)
DocAName str -> return (DocAName str)
+ DocProperty p -> return (DocProperty p)
DocExamples e -> return (DocExamples e)
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index 8fa8ce95..59b83c70 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -481,6 +481,9 @@ instance (Binary id) => Binary (Doc id) where
put_ bh (DocWarning ag) = do
putByte bh 17
put_ bh ag
+ put_ bh (DocProperty x) = do
+ putByte bh 18
+ put_ bh x
get bh = do
h <- getByte bh
case h of
@@ -538,6 +541,9 @@ instance (Binary id) => Binary (Doc id) where
17 -> do
ag <- get bh
return (DocWarning ag)
+ 18 -> do
+ x <- get bh
+ return (DocProperty x)
_ -> fail "invalid binary data found"
diff --git a/src/Haddock/Lex.x b/src/Haddock/Lex.x
index b9ebe688..35e6dd8a 100644
--- a/src/Haddock/Lex.x
+++ b/src/Haddock/Lex.x
@@ -50,6 +50,7 @@ $ident = [$alphanum \'\_\.\!\#\$\%\&\*\+\/\<\=\>\?\@\\\\\^\|\-\~\:]
<0,para> {
$ws* \n ;
$ws* \> { begin birdtrack }
+ $ws* prop\> { strtoken TokPropertyPrompt `andBegin` propertyexpr }
$ws* \>\>\> { strtoken TokExamplePrompt `andBegin` exampleexpr }
$ws* [\*\-] { token TokBullet `andBegin` string }
$ws* \[ { token TokDefStart `andBegin` def }
@@ -61,6 +62,7 @@ $ident = [$alphanum \'\_\.\!\#\$\%\&\*\+\/\<\=\>\?\@\\\\\^\|\-\~\:]
-- beginning of a line
<line> {
$ws* \> { begin birdtrack }
+ $ws* prop\> { strtoken TokPropertyPrompt `andBegin` propertyexpr }
$ws* \>\>\> { strtoken TokExamplePrompt `andBegin` exampleexpr }
$ws* \n { token TokPara `andBegin` para }
-- Here, we really want to be able to say
@@ -84,6 +86,10 @@ $ident = [$alphanum \'\_\.\!\#\$\%\&\*\+\/\<\=\>\?\@\\\\\^\|\-\~\:]
<exampleresult> .* \n { strtokenNL TokExampleResult `andBegin` example }
+<propertyexpr> .* \n { strtokenNL TokPropertyExpression `andBegin` property }
+
+<property> () { token TokPara `andBegin` para }
+
<string,def> {
$special { strtoken $ \s -> TokSpecial (head s) }
\<\< [^\>]* \>\> { strtoken $ \s -> TokPic (init $ init $ tail $ tail s) }
@@ -129,6 +135,8 @@ data Token
| TokEmphasis String
| TokAName String
| TokBirdTrack String
+ | TokPropertyPrompt String
+ | TokPropertyExpression String
| TokExamplePrompt String
| TokExampleExpression String
| TokExampleResult String
diff --git a/src/Haddock/Parse.y b/src/Haddock/Parse.y
index b34b14b9..c8a1a558 100644
--- a/src/Haddock/Parse.y
+++ b/src/Haddock/Parse.y
@@ -35,6 +35,8 @@ import Data.List (stripPrefix)
'-' { (TokBullet,_) }
'(n)' { (TokNumber,_) }
'>..' { (TokBirdTrack $$,_) }
+ PPROMPT { (TokPropertyPrompt $$,_) }
+ PEXP { (TokPropertyExpression $$,_) }
PROMPT { (TokExamplePrompt $$,_) }
RESULT { (TokExampleResult $$,_) }
EXP { (TokExampleExpression $$,_) }
@@ -73,12 +75,16 @@ defpara :: { (Doc RdrName, Doc RdrName) }
para :: { Doc RdrName }
: seq { docParagraph $1 }
| codepara { DocCodeBlock $1 }
+ | property { DocProperty $1 }
| examples { DocExamples $1 }
codepara :: { Doc RdrName }
: '>..' codepara { docAppend (DocString $1) $2 }
| '>..' { DocString $1 }
+property :: { String }
+ : PPROMPT PEXP { strip $2 }
+
examples :: { [Example] }
: example examples { $1 : $2 }
| example { [$1] }
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index fbd05fae..05fc9747 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -306,6 +306,7 @@ data Doc id
| DocHyperlink Hyperlink
| DocPic String
| DocAName String
+ | DocProperty String
| DocExamples [Example]
deriving (Functor)
@@ -350,6 +351,7 @@ data DocMarkup id a = Markup
, markupHyperlink :: Hyperlink -> a
, markupAName :: String -> a
, markupPic :: String -> a
+ , markupProperty :: String -> a
, markupExample :: [Example] -> a
}
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index b8f32589..4424ad73 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -432,6 +432,7 @@ markup m (DocCodeBlock d) = markupCodeBlock m (markup m d)
markup m (DocHyperlink l) = markupHyperlink m l
markup m (DocAName ref) = markupAName m ref
markup m (DocPic img) = markupPic m img
+markup m (DocProperty p) = markupProperty m p
markup m (DocExamples e) = markupExample m e
@@ -459,6 +460,7 @@ idMarkup = Markup {
markupHyperlink = DocHyperlink,
markupAName = DocAName,
markupPic = DocPic,
+ markupProperty = DocProperty,
markupExample = DocExamples
}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-15 22:43:49 +0000