{-# 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 Data.Either (either)
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, 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) =
("