From f95b71d2933ce24e366136603a4037b04faf92d2 Mon Sep 17 00:00:00 2001 From: Thomas Peiselt Date: Wed, 24 Oct 2018 20:30:59 +0200 Subject: [PATCH] Use hoogle v5. Hoogle v5 uses a different json representation for the data, requires a new URL and also contains HTML markup inside the json fields. This commit removes all markup to be able to handle the hoogle responses using the same structure as with the previous response structure (from hoogle v4). --- ihaskell.cabal | 2 + src/IHaskell/Eval/Hoogle.hs | 87 +++++++++++++++++++------------ src/tests/Hspec.hs | 4 +- src/tests/IHaskell/Test/Hoogle.hs | 63 ++++++++++++++++++++++ 4 files changed, 123 insertions(+), 33 deletions(-) create mode 100644 src/tests/IHaskell/Test/Hoogle.hs diff --git a/ihaskell.cabal b/ihaskell.cabal index a033bdd3..751bd83b 100644 --- a/ihaskell.cabal +++ b/ihaskell.cabal @@ -164,6 +164,7 @@ Test-Suite hspec IHaskell.Test.Completion IHaskell.Test.Util IHaskell.Test.Parser + IHaskell.Test.Hoogle default-language: Haskell2010 build-depends: base, @@ -178,6 +179,7 @@ Test-Suite hspec directory, text, shelly, + raw-strings-qq, setenv source-repository head diff --git a/src/IHaskell/Eval/Hoogle.hs b/src/IHaskell/Eval/Hoogle.hs index bb326999..aa0521cc 100644 --- a/src/IHaskell/Eval/Hoogle.hs +++ b/src/IHaskell/Eval/Hoogle.hs @@ -1,24 +1,33 @@ -{-# LANGUAGE NoImplicitPrelude, FlexibleInstances, OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} module IHaskell.Eval.Hoogle ( search, document, render, OutputFormat(..), - HoogleResult, + HoogleResult(..), + HoogleResponse(..), + parseResponse, ) where +import qualified Data.ByteString.Char8 as CBS +import qualified Data.ByteString.Lazy as LBS +import Data.Either (either) import IHaskellPrelude -import qualified Data.ByteString.Lazy as LBS -import qualified Data.ByteString.Char8 as CBS +import Data.Aeson +import Data.Char (isAlphaNum, isAscii) +import qualified Data.List as List +import qualified Data.Text as T +import Data.Vector (toList) import Network.HTTP.Client import Network.HTTP.Client.TLS -import Data.Aeson -import qualified Data.List as List -import Data.Char (isAscii, isAlphaNum) -import StringUtils (split, strip, replace) +import StringUtils (replace, split, strip) + +import Debug.Trace -- | Types of formats to render output to. data OutputFormat = Plain -- ^ Render to plain text. @@ -35,17 +44,19 @@ data HoogleResult = SearchResult HoogleResponse data HoogleResponseList = HoogleResponseList [HoogleResponse] instance FromJSON HoogleResponseList where - parseJSON (Object obj) = do - results <- obj .: "results" - HoogleResponseList <$> mapM parseJSON results + parseJSON (Array arr) = + HoogleResponseList <$> mapM parseJSON (toList arr) - parseJSON _ = fail "Expected object with 'results' field." + parseJSON _ = fail "Expected array." instance FromJSON HoogleResponse where parseJSON (Object obj) = - HoogleResponse <$> obj .: "location" <*> obj .: "self" <*> obj .: "docs" + HoogleResponse + <$> obj .: "url" + <*> (removeMarkup <$> obj .: "item") + <*> obj .: "docs" - parseJSON _ = fail "Expected object with fields: location, self, docs" + parseJSON _ = fail "Expected object with fields: url, item, docs" -- | Query Hoogle for the given string. This searches Hoogle using the internet. It returns either -- an error message or the successful JSON result. @@ -59,7 +70,7 @@ query str = do where queryUrl :: String -> String - queryUrl = printf "https://www.haskell.org/hoogle/?hoogle=%s&mode=json" + queryUrl = printf "http://hoogle.haskell.org/?hoogle=%s&mode=json" -- | Copied from the HTTP package. urlEncode :: String -> String @@ -87,18 +98,16 @@ urlEncode (ch:t) -- | Search for a query on Hoogle. Return all search results. search :: String -> IO [HoogleResult] -search string = do - response <- query string - return $ - case response of - Left err -> [NoResult err] - Right jsn -> - case eitherDecode $ LBS.fromStrict $ CBS.pack jsn of - Left err -> [NoResult err] - Right results -> - case map SearchResult $ (\(HoogleResponseList l) -> l) results of - [] -> [NoResult "no matching identifiers found."] - res -> res +search string = either ((:[]) . NoResult) parseResponse <$> query string + +parseResponse :: String -> [HoogleResult] +parseResponse jsn = + case eitherDecode $ LBS.fromStrict $ CBS.pack jsn of + Left err -> [NoResult err] + Right results -> + case map SearchResult $ (\(HoogleResponseList l) -> l) results of + [] -> [NoResult "no matching identifiers found."] + res -> res -- | Look up an identifier on Hoogle. Return documentation for that identifier. If there are many -- identifiers, include documentation for all of them. @@ -118,13 +127,13 @@ document string = do matches _ = False toDocResult (SearchResult resp) = Just $ DocResult resp - toDocResult (DocResult _) = Nothing - toDocResult (NoResult _) = Nothing + toDocResult (DocResult _) = Nothing + toDocResult (NoResult _) = Nothing -- | Render a Hoogle search result into an output format. render :: OutputFormat -> HoogleResult -> String render Plain = renderPlain -render HTML = renderHtml +render HTML = renderHtml -- | Render a Hoogle result to plain text. renderPlain :: HoogleResult -> String @@ -182,7 +191,7 @@ renderSelf string loc packageSub package | otherwise = - let [name, args] = split "::" string + let [name, args] = trace string $ split "::" string package = extractPackageName loc modname = extractModuleName loc in span "hoogle-name" @@ -231,7 +240,7 @@ renderDocs doc = isPrefixOf ">" (strip s2) isCode xs = case xs of - [] -> False + [] -> False (s:_) -> isPrefixOf ">" $ strip s makeBlock xs = if isCode xs @@ -259,3 +268,17 @@ span = printf "%s" link :: String -> String -> String link = printf "%s" + +-- | very explicit cleaning of the type signature in the hoogle 5 response, +-- to remove html markup and escaped characters. +removeMarkup :: String -> String +removeMarkup s = T.unpack $ List.foldl (flip ($)) (T.pack s) replaceAll + where replacements :: [ (T.Text, T.Text) ] + replacements = [ ( "<0>", "" ) + , ( "", "" ) + , ( ">", ">" ) + , ( "<", "<" ) + , ( "", "") + , ( "", "") + ] + replaceAll = uncurry T.replace <$> replacements diff --git a/src/tests/Hspec.hs b/src/tests/Hspec.hs index 38b58169..eb708f3b 100644 --- a/src/tests/Hspec.hs +++ b/src/tests/Hspec.hs @@ -7,10 +7,12 @@ import Test.Hspec import IHaskell.Test.Completion (testCompletions) import IHaskell.Test.Parser (testParser) import IHaskell.Test.Eval (testEval) +import IHaskell.Test.Hoogle (testHoogle) main :: IO () -main = +main = hspec $ do testParser testEval testCompletions + testHoogle diff --git a/src/tests/IHaskell/Test/Hoogle.hs b/src/tests/IHaskell/Test/Hoogle.hs new file mode 100644 index 00000000..49227b52 --- /dev/null +++ b/src/tests/IHaskell/Test/Hoogle.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE QuasiQuotes #-} + +module IHaskell.Test.Hoogle ( testHoogle ) where + +import Test.Hspec +import Text.RawString.QQ + +import IHaskell.Eval.Hoogle +-- import Data.Text (unpack) +-- import qualified Data.Text.IO as T +preludeFmapJson :: String +preludeFmapJson = [r| +[ + { + "url": "https://hackage.haskell.org/package/base/docs/Prelude.html#v:fmap", + "module": { + "url": "https://hackage.haskell.org/package/base/docs/Prelude.html", + "name": "Prelude" + }, + "package": { + "url": "https://hackage.haskell.org/package/base", + "name": "base" + }, + "item": "<0>fmap :: Functor f => (a -> b) -> f a -> f b", + "type": "", + "docs": "" + } +]|] + +moduleJson :: String +moduleJson = [r| +[ + { + "url": "https://hackage.haskell.org/package/universum/docs/Universum-Functor-Fmap.html", + "module": {}, + "package": { + "url": "https://hackage.haskell.org/package/universum", + "name": "universum" + }, + "item": "module Universum.Functor.<0>Fmap", + "type": "module", + "docs": "This module contains useful functions to work with Functor type\nclass.\n" + } +]|] + +testHoogle :: Spec +testHoogle = describe "Hoogle Search" $ do + describe "fmap search result" $ do + let results = parseResponse preludeFmapJson :: [HoogleResult] + it "should find 1 results" $ do + length results `shouldBe` 1 + let (SearchResult (HoogleResponse loc signature _docUrl)) = head results + it "should not contain html markup" $ do + loc `shouldBe` "https://hackage.haskell.org/package/base/docs/Prelude.html#v:fmap" + signature `shouldBe` "fmap :: Functor f => (a -> b) -> f a -> f b" + describe "module result" $ do + let results = parseResponse moduleJson :: [HoogleResult] + let (SearchResult (HoogleResponse _loc signature _docUrl)) = head results + it "should not contain html markup" $ do + signature `shouldBe` "module Universum.Functor.Fmap" + it "should be renderable" $ do + (render Plain $ head results) `shouldStartWith` "module Universum.Functor.Fmap" + (render HTML $ head results) `shouldStartWith` "module"