Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit 4d66429

Browse files
committed
Fix test, only show one link
1 parent 919b046 commit 4d66429

File tree

2 files changed

+29
-15
lines changed

2 files changed

+29
-15
lines changed

src/Haskell/Ide/Engine/Plugin/Hoogle.hs

Lines changed: 28 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -103,7 +103,14 @@ infoCmd' expr = do
103103
if null res then
104104
Left NoResults
105105
else
106-
return $ renderTarget $ head res
106+
return $ renderTargetInfo $ head res
107+
108+
renderTargetInfo :: Target -> T.Text
109+
renderTargetInfo t =
110+
T.intercalate "\n"
111+
$ ["```haskell\n" <> unHTML (T.pack $ targetItem t) <> "\n```"]
112+
++ [renderDocs $ targetDocs t]
113+
++ [T.pack $ curry annotate "More info" $ targetURL t]
107114

108115
-- | Command to get the prettified documentation of an hoogle identifier.
109116
-- Identifier should be understandable for hoogle.
@@ -128,23 +135,30 @@ infoCmdFancyRender expr = do
128135
renderTarget :: Target -> T.Text
129136
-- renderTarget t = T.intercalate "\n\n" $
130137
renderTarget t = T.intercalate "\n" $
131-
["```haskell\n" <> unHTML (T.pack $ targetItem t) <> "\n```"]
138+
["```haskell\n" <> unHTML (T.pack $ targetItem t) <> "```"]
132139
++ [T.pack $ unwords mdl | not $ null mdl]
133140
++ [renderDocs $ targetDocs t]
134141
++ [T.pack $ curry annotate "More info" $ targetURL t]
135142
where mdl = map annotate $ catMaybes [targetPackage t, targetModule t]
136-
annotate (thing,url) = "["<>thing++"]"++"("++url++")"
137-
unHTML = T.replace "<0>" "" . innerText . parseTags
138-
renderDocs = T.concat . map htmlToMarkDown . parseTree . T.pack
139-
htmlToMarkDown :: TagTree T.Text -> T.Text
140-
htmlToMarkDown (TagLeaf x) = fromMaybe "" $ maybeTagText x
141-
htmlToMarkDown (TagBranch "i" _ tree) = "*" <> T.concat (map htmlToMarkDown tree) <> "*"
142-
htmlToMarkDown (TagBranch "b" _ tree) = "**" <> T.concat (map htmlToMarkDown tree) <> "**"
143-
htmlToMarkDown (TagBranch "a" _ tree) = "`" <> T.concat (map htmlToMarkDown tree) <> "`"
144-
htmlToMarkDown (TagBranch "li" _ tree) = "- " <> T.concat (map htmlToMarkDown tree)
145-
htmlToMarkDown (TagBranch "tt" _ tree) = "`" <> innerText (flattenTree tree) <> "`"
146-
htmlToMarkDown (TagBranch "pre" _ tree) = "```haskell\n" <> T.concat (map htmlToMarkDown tree) <> "```"
147-
htmlToMarkDown (TagBranch _ _ tree) = T.concat $ map htmlToMarkDown tree
143+
144+
annotate :: (String, String) -> String
145+
annotate (thing,url) = "["<>thing<>"]"<>"("<>url<>")"
146+
147+
unHTML :: T.Text -> T.Text
148+
unHTML = T.replace "<0>" "" . innerText . parseTags
149+
150+
renderDocs :: String -> T.Text
151+
renderDocs = T.concat . map htmlToMarkDown . parseTree . T.pack
152+
153+
htmlToMarkDown :: TagTree T.Text -> T.Text
154+
htmlToMarkDown (TagLeaf x) = fromMaybe "" $ maybeTagText x
155+
htmlToMarkDown (TagBranch "i" _ tree) = "*" <> T.concat (map htmlToMarkDown tree) <> "*"
156+
htmlToMarkDown (TagBranch "b" _ tree) = "**" <> T.concat (map htmlToMarkDown tree) <> "**"
157+
htmlToMarkDown (TagBranch "a" _ tree) = "`" <> T.concat (map htmlToMarkDown tree) <> "`"
158+
htmlToMarkDown (TagBranch "li" _ tree) = "- " <> T.concat (map htmlToMarkDown tree)
159+
htmlToMarkDown (TagBranch "tt" _ tree) = "`" <> innerText (flattenTree tree) <> "`"
160+
htmlToMarkDown (TagBranch "pre" _ tree) = "```haskell\n" <> T.concat (map htmlToMarkDown tree) <> "```"
161+
htmlToMarkDown (TagBranch _ _ tree) = T.concat $ map htmlToMarkDown tree
148162

149163
------------------------------------------------------------------------
150164

test/unit/HooglePluginSpec.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,7 +48,7 @@ hoogleSpec = do
4848
it "runs the info command" $ do
4949
let req = liftToGhc $ infoCmd' "head"
5050
r <- dispatchRequestP $ initializeHoogleDb >> req
51-
r `shouldBe` Right "head :: [a] -> a\nbase Prelude\nExtract the first element of a list, which must be non-empty.\n\n"
51+
r `shouldBe` Right "```haskell\nhead :: [a] -> a\n```\nExtract the first element of a list, which must be non-empty.\n\n[More info](https://hackage.haskell.org/package/base/docs/Prelude.html#v:head)"
5252

5353
-- ---------------------------------
5454

0 commit comments

Comments
 (0)