diff options
| author | Simon Hengel <sol@typeful.net> | 2012-04-11 07:54:33 +0200 |
|---|---|---|
| committer | Simon Hengel <sol@typeful.net> | 2012-05-27 08:48:24 +0200 |
| commit | b8dcf173c272ebf85bbf2b427f84522e1474d092 (patch) | |
| tree | 2e23551bf977b7a871c02c977eb9fecffc6233a2 /src/Haddock | |
| parent | b19a4bea999c684e092e0ea0feaf02ff8747d2a5 (diff) | |
Add support for hyperlink labels to parser
Diffstat (limited to 'src/Haddock')
| -rw-r--r-- | src/Haddock/Parse.y | 11 | ||||
| -rw-r--r-- | src/Haddock/Types.hs | 2 |
2 files changed, 11 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 |