{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module IHaskell.Eval.Hoogle (
search,
document,
render,
OutputFormat(..),
HoogleResult(..),
HoogleResponse(..),
parseResponse,
) where
import qualified Data.ByteString.Char8 as CBS
import qualified Data.ByteString.Lazy as LBS
import IHaskellPrelude
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 StringUtils (replace, split, splitFirst, strip)
-- | Types of formats to render output to.
data OutputFormat = Plain -- ^ Render to plain text.
| HTML -- ^ Render to HTML.
data HoogleResponse = HoogleResponse { location :: String, self :: String, docs :: String }
deriving (Eq, Show)
data HoogleResult = SearchResult HoogleResponse
| DocResult HoogleResponse
| NoResult String
deriving Show
data HoogleResponseList = HoogleResponseList [HoogleResponse]
instance FromJSON HoogleResponseList where
parseJSON (Array arr) =
HoogleResponseList <$> mapM parseJSON (toList arr)
parseJSON _ = fail "Expected array."
instance FromJSON HoogleResponse where
parseJSON (Object obj) =
HoogleResponse
<$> obj .: "url"
<*> (removeMarkup <$> obj .: "item")
<*> obj .: "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.
query :: String -> IO (Either String String)
query str = do
request <- parseUrlThrow $ queryUrl $ urlEncode str
mgr <- newManager tlsManagerSettings
catch
(Right . CBS.unpack . LBS.toStrict . responseBody <$> httpLbs request mgr)
(\e -> return $ Left $ show (e :: SomeException))
where
queryUrl :: String -> String
queryUrl = printf "http://hoogle.haskell.org/?hoogle=%s&mode=json"
-- | Copied from the HTTP package.
urlEncode :: String -> String
urlEncode [] = []
urlEncode (ch:t)
| (isAscii ch && isAlphaNum ch) || ch `elem` ("-_.~" :: String) = ch : urlEncode t
| not (isAscii ch) = foldr escape (urlEncode t) (eightBs [] (fromEnum ch))
| otherwise = escape (fromEnum ch) (urlEncode t)
where
escape :: Int -> String -> String
escape b rs = '%' : showH (b `div` 16) (showH (b `mod` 16) rs)
showH :: Int -> String -> String
showH x xs
| x <= 9 = toEnum (o_0 + x) : xs
| otherwise = toEnum (o_A + (x - 10)) : xs
where
o_0 = fromEnum '0'
o_A = fromEnum 'A'
eightBs :: [Int] -> Int -> [Int]
eightBs acc x
| x <= 255 = x : acc
| otherwise = eightBs ((x `mod` 256) : acc) (x `div` 256)
-- | Search for a query on Hoogle. Return all search results.
search :: String -> IO [HoogleResult]
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.
document :: String -> IO [HoogleResult]
document string = do
matchingResults <- filter matches <$> search string
return $
case mapMaybe toDocResult matchingResults of
[] -> [NoResult "no matching identifiers found."]
res -> res
where
matches (SearchResult resp) =
("