psc-ide 0.2.0.0 → 0.3.0.0

raw patch · 7 files changed

+146/−48 lines, 7 filesdep +http-clientPVP ok

version bump matches the API change (PVP)

Dependencies added: http-client

API changes (from Hackage documentation)

Files

• lib/PureScript/Ide.hs +7/−3
• lib/PureScript/Ide/Command.hs +8/−1
• lib/PureScript/Ide/Completion.hs +8/−9
• lib/PureScript/Ide/Pursuit.hs +66/−21
• lib/PureScript/Ide/Types.hs +39/−0
• psc-ide.cabal +6/−6
• server/Main.hs +12/−8

@@ -6,7 +6,6 @@ import qualified Data.Map.Lazy            as M import           Data.Maybe               (mapMaybe) import           Data.Monoid-import           Data.Text                (Text ()) import qualified Data.Text  as T import           PureScript.Ide.Completion import           PureScript.Ide.Externs@@ -32,8 +31,13 @@ findType search filters =     CompletionResult <$> getExactMatches search filters <$> getAllModules -findPursuitCompletions :: Text -> PscIde [Completion]-findPursuitCompletions = liftIO . searchPursuit+findPursuitCompletions :: PursuitQuery -> PscIde Success+findPursuitCompletions (PursuitQuery q) =+    PursuitResult <$> liftIO (searchPursuitForDeclarations q)++findPursuitPackages :: PursuitQuery -> PscIde Success+findPursuitPackages (PursuitQuery q) =+  PursuitResult <$> liftIO (findPackagesForModuleIdent q)  loadExtern :: FilePath -> PscIde (Either Error ()) loadExtern fp = runEitherT $ do

@@ -4,8 +4,8 @@ import           Control.Monad import           Data.Aeson import           Data.Maybe-import           PureScript.Ide.Matcher import           PureScript.Ide.Filter+import           PureScript.Ide.Matcher import           PureScript.Ide.Types  data Command@@ -15,6 +15,8 @@            , typeFilters :: [Filter]}     | Complete { completeFilters :: [Filter]                , completeMatcher :: Matcher}+    | Pursuit { pursuitQuery      :: PursuitQuery+              , pursuitSearchType :: PursuitSearchType}     | List     | Cwd     | Quit@@ -41,6 +43,11 @@         filters <- params .:? "filters"         matcher <- params .:? "matcher"         return $ Complete (fromMaybe [] filters) (fromMaybe (Matcher id) matcher)+      "pursuit" -> do+        params <- o .: "params"+        query <- params .: "query"+        queryType <- params .: "type"+        return $ Pursuit query queryType       _ -> mzero  instance FromJSON Filter where

@@ -21,14 +21,13 @@ applyFilters = foldl (\f (Filter g) -> f . g) id  completionsFromModules :: [Module] -> [Completion]-completionsFromModules = concat . fmap completionFromModule--completionFromModule :: Module -> [Completion]-completionFromModule (moduleIdent, decls) =-    mapMaybe go decls+completionsFromModules = foldMap completionFromModule     where-        go (FunctionDecl name type') = Just (Completion (moduleIdent, name, type'))-        go (DataDecl name kind)      = Just (Completion (moduleIdent, name, kind))-        go (ModuleDecl name _)       = Just (Completion ("module", name, "module"))-        go _                         = Nothing+        completionFromModule :: Module -> [Completion]+        completionFromModule (moduleIdent, decls) = mapMaybe (completionFromDecl moduleIdent) decls +completionFromDecl :: ModuleIdent -> ExternDecl -> Maybe Completion+completionFromDecl mi (FunctionDecl name type') = Just (Completion (mi, name, type'))+completionFromDecl mi (DataDecl name kind)      = Just (Completion (mi, name, kind))+completionFromDecl mi (ModuleDecl name _)       = Just (Completion ("module", name, "module"))+completionFromDecl mi _                         = Nothing

@@ -1,33 +1,78 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module PureScript.Ide.Pursuit where +import qualified Control.Exception      as E import           Control.Lens+import           Control.Monad+import           Data.Aeson import           Data.Aeson.Lens-import           Data.Either-import           Data.Monoid+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           PureScript.Ide.Externs (typeParse)+import           PureScript.Ide.Types -queryUrl :: Text-queryUrl = "http://pursuit.purescript.org/search?q="+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 -jsonOpts :: Options-jsonOpts = defaults & header "Accept" .~ ["application/json"]+queryUrl :: String+queryUrl = "http://pursuit.purescript.org/search" -myZip :: [a] -> [(b, c)] -> [(a, b, c)]-myZip = zipWith (\a (b, c) -> (a, b, c))+jsonOpts :: Text -> Options+jsonOpts q =+    defaults & header "Accept" .~ ["application/json"] & param "q" .~ [q] -searchPursuit :: Text -> IO [Completion]-searchPursuit query = do-    r <- getWith jsonOpts (T.unpack $ queryUrl <> query)-    let texts = r ^.. responseBody . values . key "text" . _String-    let moduleNames = r ^..-                      responseBody .-                      values .-                      key "info" .-                      key "module" .-                      _String-    return . fmap Completion . myZip moduleNames . rights $ typeParse <$> texts+-- We need to remove trailing dots because Pursuit will return a 400 otherwise+-- TODO: remove this when the issue is fixed at Pursuit+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

@@ -1,3 +1,4 @@+{-# LANGUAGE RecordWildCards #-} module PureScript.Ide.Types where  import           Control.Monad@@ -53,6 +54,7 @@ data Success =   CompletionResult [Completion]   | TextResult Text+  | PursuitResult [PursuitResponse]     deriving(Show, Eq)  encodeSuccess :: (ToJSON a) => a -> Value@@ -64,6 +66,43 @@ instance ToJSON Success where   toJSON (CompletionResult cs) = encodeSuccess cs   toJSON (TextResult t) = encodeSuccess t+  toJSON (PursuitResult resp) = encodeSuccess resp  newtype Filter  = Filter ([Module] -> [Module]) newtype Matcher = Matcher ([Completion] -> [Completion])++newtype PursuitQuery = PursuitQuery Text+                     deriving (Show, Eq)++data PursuitSearchType = Package | Identifier+                       deriving (Show, Eq)++instance FromJSON PursuitSearchType where+  parseJSON (String t) = case t of+    "package"    -> return Package+    "completion" -> return Identifier+    _            -> mzero+  parseJSON _ = mzero++instance FromJSON PursuitQuery where+  parseJSON o = fmap PursuitQuery (parseJSON o)++data PursuitResponse+    = ModuleResponse { moduleResponseName    :: Text+                     , moduleResponsePackage :: Text}+    | DeclarationResponse { declarationResponseType    :: Text+                          , declarationResponseModule  :: Text+                          , declarationResponseIdent   :: Text+                          , declarationResponsePackage :: Text+                          }+    deriving (Show,Eq)++instance ToJSON PursuitResponse where+    toJSON (ModuleResponse{moduleResponseName = name, moduleResponsePackage = package}) =+        object ["module" .= name, "package" .= package]+    toJSON (DeclarationResponse{..}) =+        object+            [ "module"  .= declarationResponseModule+            , "ident"   .= declarationResponseIdent+            , "type"    .= declarationResponseType+            , "package" .= declarationResponsePackage]

@@ -1,5 +1,5 @@ name:                psc-ide-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Language support for the PureScript programming language description:         Please see README.md homepage:            http://github.com/kRITZCREEK/psc-ide@@ -28,16 +28,17 @@   build-depends:         aeson                        , base >= 4.7 && < 5                        , containers+                       , directory+                       , either+                       , filepath+                       , http-client                        , lens                        , lens-aeson                        , mtl                        , parsec-                       , directory-                       , filepath                        , regex-tdfa                        , text                        , wreq-                       , either   default-extensions:    OverloadedStrings   ghc-options:         -O2 @@ -57,7 +58,6 @@   hs-source-dirs:      server   main-is:             Main.hs   default-language:    Haskell2010-  ghc-options:         -threaded   build-depends:     base >= 4.7 && < 5                    , mtl                    , network@@ -65,7 +65,7 @@                    , directory                    , psc-ide                    , text-  ghc-options:         -O2 -Wall+  ghc-options:         -threaded -O2 -Wall  test-suite spec   type:                exitcode-stdio-1.0

@@ -1,16 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} module Main where +import           Control.Exception        (bracketOnError) import           Control.Monad-import           Control.Exception         (bracketOnError) import           Control.Monad.State.Lazy-import           Data.Maybe                (fromMaybe)-import qualified Data.Text                 as T-import qualified Data.Text.IO              as T-import           Network                   hiding (socketPort)-import           Network.BSD               (getProtocolNumber)-import           Network.Socket            hiding (PortNumber, Type, accept,-                                            sClose)+import           Data.Maybe               (fromMaybe)+import qualified Data.Text                as T+import qualified Data.Text.IO             as T+import           Network                  hiding (socketPort)+import           Network.BSD              (getProtocolNumber)+import           Network.Socket           hiding (PortNumber, Type, accept,+                                           sClose) import           Options.Applicative import           PureScript.Ide import           PureScript.Ide.CodecJSON@@ -91,6 +91,10 @@     Right <$> findType search filters handleCommand (Complete filters matcher) =     Right <$> findCompletions filters matcher+handleCommand (Pursuit query Package) =+    Right <$> findPursuitPackages query+handleCommand (Pursuit query Identifier) =+    Right <$> findPursuitCompletions query handleCommand List =     Right <$> printModules handleCommand Cwd =