Repository : ssh://darcs.haskell.org//srv/darcs/haddock On branch : ghc-7.6
http://hackage.haskell.org/trac/ghc/changeset/72675c1bf281b81041a19014b1b7df03a0de9488 >--------------------------------------------------------------- commit 72675c1bf281b81041a19014b1b7df03a0de9488 Author: Kazu Yamamoto <k...@iij.ad.jp> Date: Mon Apr 9 15:45:57 2012 +0900 Add markup support for properties >--------------------------------------------------------------- src/Haddock/Backends/Hoogle.hs | 1 + src/Haddock/Backends/LaTeX.hs | 1 + src/Haddock/Backends/Xhtml/DocMarkup.hs | 1 + src/Haddock/Interface/LexParseRn.hs | 1 + src/Haddock/Interface/Rename.hs | 1 + src/Haddock/InterfaceFile.hs | 6 ++++++ src/Haddock/Lex.x | 8 ++++++++ src/Haddock/Parse.y | 6 ++++++ src/Haddock/Types.hs | 2 ++ src/Haddock/Utils.hs | 2 ++ 10 files changed, 29 insertions(+), 0 deletions(-) diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs index 4949daa..28d35ac 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 68cf715..bf1e6ac 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 e75cfab..aa4ba37 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 3ad9719..ced12d8 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 0f70268..55c9a5d 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 8fa8ce9..59b83c7 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 b9ebe68..35e6dd8 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 b34b14b..c8a1a55 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 fbd05fa..05fc974 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 b8f3258..4424ad7 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 } _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
