module PureScript.Ide.Pursuit where
import qualified Control.Exception as E
import Control.Lens hiding (noneOf)
import Control.Monad
import Data.Aeson
import Data.Aeson.Lens
import Data.ByteString.Lazy (ByteString)
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Network.HTTP.Client (HttpException (StatusCodeException))
import Network.Wreq
import PureScript.Ide.Types
import Text.Parsec
import Text.Parsec.Text
instance FromJSON PursuitResponse where
parseJSON (Object o) = do
package <- o .: "package"
info <- o .: "info"
(type' :: String) <- info .: "type"
case type' of
"module" -> do
name <- info .: "module"
return
ModuleResponse
{ moduleResponseName = name
, moduleResponsePackage = package
}
"declaration" -> do
moduleName <- info .: "module"
Right (ident, declType) <- typeParse <$> o .: "text"
return
DeclarationResponse
{ declarationResponseType = declType
, declarationResponseModule = moduleName
, declarationResponseIdent = ident
, declarationResponsePackage = package
}
_ -> mzero
parseJSON _ = mzero
queryUrl :: String
queryUrl = "http://pursuit.purescript.org/search"
jsonOpts :: Text -> Options
jsonOpts q =
defaults & header "Accept" .~ ["application/json"] & param "q" .~ [q]
queryPursuit :: Text -> IO (Response ByteString)
queryPursuit q = getWith (jsonOpts (T.dropWhileEnd (== '.') q)) queryUrl
handler :: HttpException -> IO [a]
handler (StatusCodeException{}) = return []
handler _ = return []
searchPursuitForDeclarations :: Text -> IO [PursuitResponse]
searchPursuitForDeclarations query =
(do r <- queryPursuit query
let results = map fromJSON (r ^.. responseBody . values)
return (mapMaybe isDeclarationResponse results)) `E.catch`
handler
where
isDeclarationResponse (Success a@(DeclarationResponse{})) = Just a
isDeclarationResponse _ = Nothing
findPackagesForModuleIdent :: Text -> IO [PursuitResponse]
findPackagesForModuleIdent query =
(do r <- queryPursuit query
let results = map fromJSON (r ^.. responseBody . values)
return (mapMaybe isModuleResponse results)) `E.catch`
handler
where
isModuleResponse (Success a@(ModuleResponse{})) = Just a
isModuleResponse _ = Nothing
parseType :: Parser (String, String)
parseType = do
name <- identifier
_ <- string "::"
spaces
type' <- many1 anyChar
return (T.unpack name, type')
typeParse :: Text -> Either Text (Text, Text)
typeParse t = case parse parseType "" t of
Right (x,y) -> Right (T.pack x, T.pack y)
Left err -> Left (T.pack (show err))
identifier :: Parser Text
identifier = do
spaces
ident <-
between (char '(') (char ')') (many1 (noneOf ", )")) <|>
many1 (noneOf ", )")
spaces
return (T.pack ident)