aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorsimonmar <unknown>2002-05-29 13:19:06 +0000
committersimonmar <unknown>2002-05-29 13:19:06 +0000
commit9234389c497a80edd0cdb5cc050f1d95eaa4552c (patch)
tree1e02fbcacadbc077f4eeb56da827f44580e0a1b9
parent093f7e538e89d8f9a1f8362ba76a233b7c286a4f (diff)
[haddock @ 2002-05-29 13:19:06 by simonmar]
Make the markup syntax a little more friendly: - single quotes are now interpreted literally unless they surround a valid Haskell identifier. So for example now there's no need to escape a single quote used as an apostrophe. - text to the right of a bird track is now literal (if you want marked-up text in a code block, use @...@).
-rw-r--r--src/HaddockLex.hs98
-rw-r--r--src/HaddockParse.y41
2 files changed, 73 insertions, 66 deletions
diff --git a/src/HaddockLex.hs b/src/HaddockLex.hs
index f766222d..000d62f0 100644
--- a/src/HaddockLex.hs
+++ b/src/HaddockLex.hs
@@ -10,19 +10,25 @@ module HaddockLex (
) where
import Char
-
-special = '`' : '\'' : '\"' : '@' : '/' : []
+import HsSyn
+import HsLexer hiding (Token)
+import HsParseMonad
data Token
= TokPara
| TokNumber
| TokBullet
| TokSpecial Char
+ | TokIdent [HsQName]
| TokString String
| TokURL String
| TokBirdTrack
deriving Show
+isSpecial c = c `elem` ['\"', '@', '/']
+isSingleQuote c = c `elem` ['\'', '`']
+isIdent c = isAlphaNum c || c == '_'
+
-- simple finite-state machine for tokenising the doc string
-- ----------------------------------------------------------------------------
@@ -32,14 +38,15 @@ tokenise :: String -> [Token]
tokenise "" = []
tokenise str = case str of
'<':cs -> tokenise_url cs
- '\n':cs -> tokenise_newline tokenise cs
- c:cs | c `elem` special -> TokSpecial c : tokenise cs
+ '\n':cs -> tokenise_newline cs
+ c:cs | isSingleQuote c -> tokenise_identifier c cs
+ | isSpecial c -> TokSpecial c : tokenise1 cs
_other -> tokenise_string "" str
-tokenise_newline next cs =
+tokenise_newline cs =
case dropWhile nonNewlineSpace cs of
'\n':cs -> TokPara : tokenise_para cs -- paragraph break
- '>':cs -> TokBirdTrack : next cs -- bird track
+ '>':cs -> TokBirdTrack : tokenise_birdtrack cs -- bird track
_other -> tokenise_string "" cs
tokenise_para cs =
@@ -49,7 +56,7 @@ tokenise_para cs =
-- bullet: '-'
'-':cs -> TokBullet : tokenise cs
-- enumerated item: '1.'
- '>':cs -> TokBirdTrack : tokenise cs
+ '>':cs -> TokBirdTrack : tokenise_birdtrack cs
-- bird track
str | (ds,'.':cs) <- span isDigit str, not (null ds)
-> TokNumber : tokenise cs
@@ -65,18 +72,14 @@ nonNewlineSpace c = isSpace c && c /= '\n'
-- birdtrack, and before a paragraph break).
tokenise1 :: String -> [Token]
-tokenise1 "" = []
-tokenise1 str = case str of
- '<':cs -> tokenise_url cs
- '\n':cs -> tokenise_newline1 cs
- c:cs | c `elem` special -> TokSpecial c : tokenise1 cs
- _other -> tokenise_string "" str
+tokenise1 str = tokenise_string "" str
-tokenise_newline1 cs =
- case dropWhile nonNewlineSpace cs of
- '\n':cs -> TokPara : tokenise_para cs -- paragraph break
- '>':cs -> TokString "\n" : TokBirdTrack : tokenise1 cs -- bird track
- _other -> tokenise_string "\n" cs
+-- found a single quote, check whether we have an identifier...
+tokenise_identifier q cs =
+ let (ident,rest) = break (not.isIdent) cs in
+ case (rest, strToHsQNames ident) of
+ (c:cs, Just names) | isSingleQuote c -> TokIdent names : tokenise1 cs
+ _other -> tokenise_string [q] cs
tokenise_url cs =
let (url,rest) = break (=='>') cs in
@@ -84,21 +87,58 @@ tokenise_url cs =
'>':rest -> tokenise1 rest
_ -> tokenise1 rest
--- ----------------------------------------------------------------------------
--- Within a string, we don't throw away any whitespace
-
tokenise_string str cs =
case cs of
- [] -> [TokString (reverse str)]
+ [] -> tokString str []
'\\':c:cs -> tokenise_string (c:str) cs
'\n':cs -> tokenise_string_newline str cs
- '<':cs -> TokString (reverse str) : tokenise_url cs
- c:cs | c `elem` special -> TokString (reverse str) : tokenise1 (c:cs)
- | otherwise -> tokenise_string (c:str) cs
+ '<':cs -> tokString str (tokenise_url cs)
+ c:cs | isSpecial c -> tokString str (TokSpecial c : tokenise1 cs)
+ | isSingleQuote c -> tokString str (tokenise_identifier c cs)
+ | otherwise -> tokenise_string (c:str) cs
tokenise_string_newline str cs =
case dropWhile nonNewlineSpace cs of
- '\n':cs -> TokString (reverse str) : TokPara : tokenise_para cs
- '>':cs -> TokString (reverse ('\n':str)) : TokBirdTrack : tokenise1 cs
- -- bird track
- _other -> tokenise_string ('\n':str) cs -- don't throw away whitespace
+ '\n':cs -> tokString str (TokPara : tokenise_para cs)
+ -- paragraph break: throw away all whitespace
+ '>':cs -> tokString ('\n':str) (TokBirdTrack : tokenise_birdtrack cs)
+ -- keep the \n, but throw away any space before the '>'
+ _other -> tokenise_string ('\n':str) cs
+ -- don't throw away whitespace at all
+
+tokString [] rest = rest
+tokString cs rest = TokString (reverse cs) : rest
+
+-- A bird-tracked line is verbatim, no markup characters are interpreted
+tokenise_birdtrack cs =
+ let (line, rest) = break (=='\n') cs in
+ TokString line : tokenise1 rest
+
+-- -----------------------------------------------------------------------------
+-- Lex a string as a Haskell identifier
+
+strToHsQNames :: String -> Maybe [HsQName]
+strToHsQNames str
+ = case lexer (\t -> returnP t) str (SrcLoc 1 1) 1 1 [] of
+ Ok _ (VarId str)
+ -> Just [ UnQual (HsVarName (HsIdent str)) ]
+ Ok _ (QVarId (mod,str))
+ -> Just [ Qual (Module mod) (HsVarName (HsIdent str)) ]
+ Ok _ (ConId str)
+ -> Just [ UnQual (HsTyClsName (HsIdent str)),
+ UnQual (HsVarName (HsIdent str)) ]
+ Ok _ (QConId (mod,str))
+ -> Just [ Qual (Module mod) (HsTyClsName (HsIdent str)),
+ Qual (Module mod) (HsVarName (HsIdent str)) ]
+ Ok _ (VarSym str)
+ -> Just [ UnQual (HsVarName (HsSymbol str)) ]
+ Ok _ (ConSym str)
+ -> Just [ UnQual (HsTyClsName (HsSymbol str)),
+ UnQual (HsVarName (HsSymbol str)) ]
+ Ok _ (QVarSym (mod,str))
+ -> Just [ Qual (Module mod) (HsVarName (HsSymbol str)) ]
+ Ok _ (QConSym (mod,str))
+ -> Just [ Qual (Module mod) (HsTyClsName (HsSymbol str)),
+ Qual (Module mod) (HsVarName (HsSymbol str)) ]
+ other
+ -> Nothing
diff --git a/src/HaddockParse.y b/src/HaddockParse.y
index f74d2b69..d9de9110 100644
--- a/src/HaddockParse.y
+++ b/src/HaddockParse.y
@@ -3,21 +3,18 @@ module HaddockParse (parseParas, parseString) where
import HaddockLex
import HsSyn
-import HsLexer hiding (Token)
-import HsParseMonad
}
%tokentype { Token }
-%token SQUO { TokSpecial '\'' }
- BQUO { TokSpecial '`' }
- DQUO { TokSpecial '\"' }
- '/' { TokSpecial '/' }
+%token '/' { TokSpecial '/' }
'@' { TokSpecial '@' }
+ DQUO { TokSpecial '\"' }
URL { TokURL $$ }
'*' { TokBullet }
'(n)' { TokNumber }
'>' { TokBirdTrack }
+ IDENT { TokIdent $$ }
PARA { TokPara }
STRING { TokString $$ }
@@ -69,13 +66,9 @@ elem1 :: { Doc }
: STRING { DocString $1 }
| '/' STRING '/' { DocEmphasis (DocString $2) }
| URL { DocURL $1 }
- | squo STRING squo { strToHsQNames $2 }
+ | IDENT { DocIdentifier $1 }
| DQUO STRING DQUO { DocModule $2 }
-squo :: { () }
- : SQUO { () }
- | BQUO { () }
-
{
happyError :: [Token] -> Either String a
happyError toks =
@@ -88,30 +81,4 @@ instance Monad (Either String) where
Left l >>= _ = Left l
Right r >>= k = k r
fail msg = Left msg
-
-strToHsQNames :: String -> Doc
-strToHsQNames str
- = case lexer (\t -> returnP t) str (SrcLoc 1 1) 1 1 [] of
- Ok _ (VarId str)
- -> DocIdentifier [ UnQual (HsVarName (HsIdent str)) ]
- Ok _ (QVarId (mod,str))
- -> DocIdentifier [ Qual (Module mod) (HsVarName (HsIdent str)) ]
- Ok _ (ConId str)
- -> DocIdentifier [ UnQual (HsTyClsName (HsIdent str)),
- UnQual (HsVarName (HsIdent str)) ]
- Ok _ (QConId (mod,str))
- -> DocIdentifier [ Qual (Module mod) (HsTyClsName (HsIdent str)),
- Qual (Module mod) (HsVarName (HsIdent str)) ]
- Ok _ (VarSym str)
- -> DocIdentifier [ UnQual (HsVarName (HsSymbol str)) ]
- Ok _ (ConSym str)
- -> DocIdentifier [ UnQual (HsTyClsName (HsSymbol str)),
- UnQual (HsVarName (HsSymbol str)) ]
- Ok _ (QVarSym (mod,str))
- -> DocIdentifier [ Qual (Module mod) (HsVarName (HsSymbol str)) ]
- Ok _ (QConSym (mod,str))
- -> DocIdentifier [ Qual (Module mod) (HsTyClsName (HsSymbol str)),
- Qual (Module mod) (HsVarName (HsSymbol str)) ]
- other
- -> DocString str
}