Skip to content
This repository was archived by the owner on Aug 3, 2024. It is now read-only.
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 11 additions & 1 deletion haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,12 +31,20 @@ chunk str@(c:_)
chunk str
| "--" `isPrefixOf` str = chunk' $ spanToNewline str
| "{-" `isPrefixOf` str = chunk' $ chunkComment 0 str
| otherwise = case lex str of
| otherwise = case lex' str of
(tok:_) -> chunk' tok
[] -> [str]
where
chunk' (c, rest) = c:(chunk rest)

-- | A bit better lexer then the default, i.e. handles DataKinds quotes
lex' :: ReadS String
lex' ('\'' : '\'' : rest) = [("''", rest)]
lex' str@('\'' : '\\' : _ : '\'' : _) = lex str
lex' str@('\'' : _ : '\'' : _) = lex str
lex' ('\'' : rest) = [("'", rest)]
lex' str = lex str

-- | Split input to "first line" string and the rest of it.
--
-- Ideally, this should be done simply with @'break' (== '\n')@. However,
Expand Down Expand Up @@ -124,6 +132,8 @@ classify str
| "--" `isPrefixOf` str = TkComment
| "{-#" `isPrefixOf` str = TkPragma
| "{-" `isPrefixOf` str = TkComment
classify "''" = TkSpecial
classify "'" = TkSpecial
classify str@(c:_)
| isSpace c = TkSpace
| isDigit c = TkNumber
Expand Down
3 changes: 3 additions & 0 deletions haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,16 +12,19 @@ data Token = Token
, tkValue :: String
, tkSpan :: Span
}
deriving (Show)

data Position = Position
{ posRow :: !Int
, posCol :: !Int
}
deriving (Show)

data Span = Span
{ spStart :: Position
, spEnd :: Position
}
deriving (Show)

data TokenType
= TkIdentifier
Expand Down
3 changes: 1 addition & 2 deletions haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -75,8 +75,7 @@ spliceURL' maybe_file maybe_mod maybe_name maybe_loc = run
case span_ of
RealSrcSpan span__ ->
show $ srcSpanStartLine span__
UnhelpfulSpan _ ->
error "spliceURL UnhelpfulSpan"
UnhelpfulSpan _ -> ""

run "" = ""
run ('%':'M':rest) = mdl ++ run rest
Expand Down