diff options
| -rw-r--r-- | src/Haddock/Parse.y | 11 | ||||
| -rw-r--r-- | src/Haddock/Types.hs | 2 | ||||
| -rw-r--r-- | tests/unit-tests/parsetests.hs | 14 |
3 files changed, 25 insertions, 2 deletions
diff --git a/src/Haddock/Parse.y b/src/Haddock/Parse.y index 0cc783ee..b34b14b9 100644 --- a/src/Haddock/Parse.y +++ b/src/Haddock/Parse.y @@ -107,7 +107,7 @@ seq1 :: { Doc RdrName } elem1 :: { Doc RdrName } : STRING { DocString $1 } | '/../' { DocEmphasis (DocString $1) } - | URL { DocHyperlink (Hyperlink $1 Nothing) } + | URL { DocHyperlink (makeHyperlink $1) } | PIC { DocPic $1 } | ANAME { DocAName $1 } | IDENT { DocIdentifier $1 } @@ -121,6 +121,15 @@ strings :: { String } happyError :: [LToken] -> Maybe a happyError toks = Nothing +-- | Create a `Hyperlink` from given string. +-- +-- A hyperlink consists of a URL and an optional label. The label is separated +-- from the url by one or more whitespace characters. +makeHyperlink :: String -> Hyperlink +makeHyperlink input = case break isSpace $ strip input of + (url, "") -> Hyperlink url Nothing + (url, label) -> Hyperlink url (Just . dropWhile isSpace $ label) + -- | Create an 'Example', stripping superfluous characters as appropriate makeExample :: String -> String -> [String] -> Example makeExample prompt expression result = diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs index f8890ebf..0d486ae8 100644 --- a/src/Haddock/Types.hs +++ b/src/Haddock/Types.hs @@ -318,7 +318,7 @@ instance Monoid (Doc id) where data Hyperlink = Hyperlink { hyperlinkUrl :: String , hyperlinkLabel :: Maybe String - } + } deriving (Eq, Show) data Example = Example diff --git a/tests/unit-tests/parsetests.hs b/tests/unit-tests/parsetests.hs index 7180a79e..0192ebfc 100644 --- a/tests/unit-tests/parsetests.hs +++ b/tests/unit-tests/parsetests.hs @@ -9,6 +9,7 @@ import Haddock.Lex (tokenise) import Haddock.Parse (parseParas) import Haddock.Types import Outputable +import Data.Monoid instance Outputable a => Show a where show = showSDoc . ppr @@ -53,8 +54,21 @@ tests = [ input = ">>> putFooBar\nfoo\n<BLANKLINE>\nbar" , result = Just $ DocExamples $ [Example "putFooBar" ["foo","","bar"]] } + + -- tests for links + , ParseTest { + input = "<http://example.com/>" + , result = Just . DocParagraph $ hyperlink "http://example.com/" Nothing `mappend` DocString "\n" + } + + , ParseTest { + input = "<http://example.com/ some link>" + , result = Just . DocParagraph $ hyperlink "http://example.com/" (Just "some link") `mappend` DocString "\n" + } ] +hyperlink :: String -> Maybe String -> Doc RdrName +hyperlink url = DocHyperlink . Hyperlink url main :: IO () main = do |