From b8e3380f80da15b1e384ff56f992baac3fd7f3ee Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 24 May 2016 16:19:46 +0300 Subject: UnfelpfulSpan line number omitted Kind of resolves https://github.com/haskell/haddock/issues/508 --- haddock-api/src/Haddock/Backends/Xhtml/Utils.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'haddock-api') diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs index 1d49807d..391bb50c 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs @@ -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 -- cgit v1.2.3 From 7c60df10642d90d7205cb9c4296903b8de094029 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 24 May 2016 16:53:35 +0300 Subject: Change Hyperlinked lexer to know about DataKinds ticks --- haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 12 +++++++++++- haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs | 3 +++ 2 files changed, 14 insertions(+), 1 deletion(-) (limited to 'haddock-api') diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index e206413e..e4345602 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -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, @@ -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 diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs index 5f4dbc8c..b27ec4d8 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs @@ -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 -- cgit v1.2.3