content: {-# LANGUAGE OverloadedStrings   #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  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]
  
  -- We need to remove trailing dots because Pursuit will return a 400 otherwise
  -- TODO: remove this when the issue is fixed at Pursuit
  
  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 <-
        -- necessary for being able to parse the following ((++), concat)
        between (char '(') (char ')') (many1 (noneOf ", )")) <|>
        many1 (noneOf ", )")
    spaces
    return (T.pack ident)
  