From e4e524ffabd531498693d004eee50a041b6f69cf Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Mon, 23 Nov 2015 12:05:57 +0200 Subject: [PATCH 1/2] PluginDescriptor no longer serialisable. Elisp tests currently fail Addresses #92 --- .../Haskell/Ide/Engine/PluginDescriptor.hs | 41 ++++++------------- hie-plugin-api/hie-plugin-api.cabal | 1 + src/Haskell/Ide/Engine/BasePlugin.hs | 6 ++- src/Haskell/Ide/Engine/Console.hs | 5 ++- test/JsonSpec.hs | 10 ++++- 5 files changed, 29 insertions(+), 34 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginDescriptor.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginDescriptor.hs index 18fdcc4e5..e73387079 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginDescriptor.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginDescriptor.hs @@ -29,7 +29,6 @@ module Haskell.Ide.Engine.PluginDescriptor where import Control.Applicative -import Control.Monad import Control.Monad.IO.Class import Data.Aeson import Data.Aeson.Types @@ -37,6 +36,7 @@ import qualified Data.Map as Map import Data.Maybe import qualified Data.HashMap.Strict as H import qualified Data.Text as T +import qualified Data.Vector as V import qualified GHC import GHC.Generics @@ -58,9 +58,9 @@ instance Show PluginDescriptor where showString " " . showList used --- | Ideally a Command is defined in such a way that it can be exposed via the --- native CLI for the tool being exposed as well. Perhaps use --- Options.Applicative for this in some way. +-- | Ideally a Command is defined in such a way that its CommandDescriptor +-- can be exposed via the native CLI for the tool being exposed as well. +-- Perhaps use Options.Applicative for this in some way. data Command = forall a .(ValidResponse a) => Command { cmdDesc :: !CommandDescriptor , cmdFunc :: !(CommandFunc a) @@ -85,6 +85,11 @@ type PluginName = T.Text data ExtendedCommandDescriptor = ExtendedCommandDescriptor CommandDescriptor PluginName + deriving (Show, Eq) + +-- | Subset type extracted from 'Plugins' to be sent to the IDE as +-- a description of the available commands +type IdePlugins = [(PluginId,[CommandDescriptor])] -- | Define what context will be accepted from the frontend for the specific @@ -346,16 +351,9 @@ instance ValidResponse CommandDescriptor where <*> v .: "contexts" <*> v .: "additional_params" -instance ValidResponse Plugins where - jsWrite m = H.fromList ["plugins" .= H.fromList - ( map (\(k,v)-> k .= toJSON v) - $ Map.assocs m)] - - jsRead v = do - ps <- v .: "plugins" - liftM Map.fromList $ mapM (\(k,vp) -> do - p<-parseJSON vp - return (k,p)) $ H.toList ps +instance ValidResponse IdePlugins where + jsWrite idePlugins = H.fromList [ "plugins" .= V.fromList idePlugins ] + jsRead v = (v .: "plugins") instance ValidResponse TypeInfo where jsWrite (TypeInfo t) = H.fromList ["type_info" .= t] @@ -458,21 +456,6 @@ instance FromJSON Service where -- ------------------------------------- -instance ToJSON PluginDescriptor where - toJSON pluginDescriptor = object [ "commands" .= map cmdDesc (pdCommands pluginDescriptor) - , "exposed_services" .= pdExposedServices pluginDescriptor - , "used_services" .= pdUsedServices pluginDescriptor - ] - -instance FromJSON PluginDescriptor where - parseJSON (Object v) = - PluginDescriptor <$> fmap (fmap (\desc -> Command desc (CmdAsync (\_ _ _ -> return ())::CommandFunc T.Text))) (v .: "commands") - <*> v .: "exposed_services" - <*> v .: "used_services" - parseJSON _ = empty - --- ------------------------------------- - instance ToJSON IdeRequest where toJSON (IdeRequest{ideCommand = command, ideParams = params}) = object [ "command" .= command diff --git a/hie-plugin-api/hie-plugin-api.cabal b/hie-plugin-api/hie-plugin-api.cabal index 368a5eae9..5e17f7a7d 100644 --- a/hie-plugin-api/hie-plugin-api.cabal +++ b/hie-plugin-api/hie-plugin-api.cabal @@ -21,6 +21,7 @@ library , ghc , text , transformers + , vector , vinyl >= 0.5 && < 0.6 ghc-options: -Wall default-language: Haskell2010 diff --git a/src/Haskell/Ide/Engine/BasePlugin.hs b/src/Haskell/Ide/Engine/BasePlugin.hs index f30a960c8..bac210993 100644 --- a/src/Haskell/Ide/Engine/BasePlugin.hs +++ b/src/Haskell/Ide/Engine/BasePlugin.hs @@ -78,10 +78,12 @@ baseDescriptor = PluginDescriptor versionCmd :: CommandFunc String versionCmd = CmdSync $ \_ _ -> return (IdeResponseOk version) -pluginsCmd :: CommandFunc Plugins +pluginsCmd :: CommandFunc IdePlugins pluginsCmd = CmdSync $ \_ _ -> do plugins <- getPlugins - return (IdeResponseOk plugins) + let commands = map getOne $ Map.toList plugins + getOne (pid,pd) = (pid,map (\c -> cmdDesc c) $ pdCommands pd) + return (IdeResponseOk commands) commandsCmd :: CommandFunc [CommandName] commandsCmd = CmdSync $ \_ req -> do diff --git a/src/Haskell/Ide/Engine/Console.hs b/src/Haskell/Ide/Engine/Console.hs index 3637ac79e..73d48214a 100644 --- a/src/Haskell/Ide/Engine/Console.hs +++ b/src/Haskell/Ide/Engine/Console.hs @@ -5,7 +5,9 @@ module Haskell.Ide.Engine.Console where import Control.Concurrent.STM.TChan import Control.Monad.IO.Class import Control.Monad.STM +import Data.Aeson import Data.Attoparsec.Text +import qualified Data.ByteString.Lazy.Char8 as C8 import qualified Data.Map as Map import Data.Monoid import qualified Data.Text as T @@ -54,7 +56,8 @@ consoleListener plugins cin = do Right (plugin,reqVal) -> do liftIO $ atomically $ writeTChan cin (CReq plugin cid reqVal cout) rsp <- liftIO $ atomically $ readTChan cout - outputStrLn $ show (coutResp rsp) + -- outputStrLn $ show (coutResp rsp) + outputStrLn $ C8.unpack $ encode (coutResp rsp) loop env (cid + 1) runInputT defaultSettings (startLoop emptyEnv 1) diff --git a/test/JsonSpec.hs b/test/JsonSpec.hs index 8a91197a2..16ff05ad3 100644 --- a/test/JsonSpec.hs +++ b/test/JsonSpec.hs @@ -41,8 +41,10 @@ jsonSpec = do prop "()" (propertyValidRoundtrip :: () -> Bool) prop "Aeson.Object" (propertyValidRoundtrip :: Object -> Bool) prop "CommandDescriptor" (propertyValidRoundtrip :: CommandDescriptor -> Bool) - prop "Plugins" (propertyValidRoundtrip :: Plugins -> Bool) + prop "ExtendedCommandDescriptor" (propertyValidRoundtrip :: ExtendedCommandDescriptor -> Bool) + prop "IdePlugins" (propertyValidRoundtrip :: IdePlugins -> Bool) prop "TypeInfo" (propertyValidRoundtrip :: TypeInfo -> Bool) + describe "General JSON instances round trip" $ do prop "ParamValP" (propertyJsonRoundtrip :: ParamValP -> Bool) prop "CabalSection" (propertyJsonRoundtrip :: CabalSection -> Bool) @@ -51,7 +53,6 @@ jsonSpec = do prop "ParamDescription" (propertyJsonRoundtrip :: ParamDescription -> Bool) prop "CommandDescriptor" (propertyJsonRoundtrip :: CommandDescriptor -> Bool) prop "Service" (propertyJsonRoundtrip :: Service -> Bool) - prop "PluginDescriptor" (propertyJsonRoundtrip :: PluginDescriptor -> Bool) prop "IdeRequest" (propertyJsonRoundtrip :: IdeRequest -> Bool) prop "IdeErrorCode" (propertyJsonRoundtrip :: IdeErrorCode -> Bool) prop "IdeError" (propertyJsonRoundtrip :: IdeError -> Bool) @@ -78,6 +79,11 @@ instance Arbitrary CommandDescriptor where <*> smallList arbitraryBoundedEnum <*> smallList arbitrary +instance Arbitrary ExtendedCommandDescriptor where + arbitrary = ExtendedCommandDescriptor + <$> arbitrary + <*> arbitrary + instance Arbitrary ParamDescription where arbitrary = do i <- choose (1::Int,2) From a137ac0e9404ec4312589e5f9730fc953967bc02 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Mon, 23 Nov 2015 13:59:45 +0200 Subject: [PATCH 2/2] Change IdePlugins to be a map --- .../Haskell/Ide/Engine/PluginDescriptor.hs | 14 ++++++++++---- hie-plugin-api/hie-plugin-api.cabal | 1 - src/Haskell/Ide/Engine/BasePlugin.hs | 2 +- 3 files changed, 11 insertions(+), 6 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginDescriptor.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginDescriptor.hs index e73387079..039ddea37 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginDescriptor.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginDescriptor.hs @@ -29,6 +29,7 @@ module Haskell.Ide.Engine.PluginDescriptor where import Control.Applicative +import Control.Monad import Control.Monad.IO.Class import Data.Aeson import Data.Aeson.Types @@ -36,7 +37,6 @@ import qualified Data.Map as Map import Data.Maybe import qualified Data.HashMap.Strict as H import qualified Data.Text as T -import qualified Data.Vector as V import qualified GHC import GHC.Generics @@ -89,7 +89,7 @@ data ExtendedCommandDescriptor = -- | Subset type extracted from 'Plugins' to be sent to the IDE as -- a description of the available commands -type IdePlugins = [(PluginId,[CommandDescriptor])] +type IdePlugins = Map.Map PluginId [CommandDescriptor] -- | Define what context will be accepted from the frontend for the specific @@ -352,8 +352,14 @@ instance ValidResponse CommandDescriptor where <*> v .: "additional_params" instance ValidResponse IdePlugins where - jsWrite idePlugins = H.fromList [ "plugins" .= V.fromList idePlugins ] - jsRead v = (v .: "plugins") + jsWrite m = H.fromList ["plugins" .= H.fromList + ( map (\(k,v)-> k .= toJSON v) + $ Map.assocs m)] + jsRead v = do + ps <- v .: "plugins" + liftM Map.fromList $ mapM (\(k,vp) -> do + p<-parseJSON vp + return (k,p)) $ H.toList ps instance ValidResponse TypeInfo where jsWrite (TypeInfo t) = H.fromList ["type_info" .= t] diff --git a/hie-plugin-api/hie-plugin-api.cabal b/hie-plugin-api/hie-plugin-api.cabal index 5e17f7a7d..368a5eae9 100644 --- a/hie-plugin-api/hie-plugin-api.cabal +++ b/hie-plugin-api/hie-plugin-api.cabal @@ -21,7 +21,6 @@ library , ghc , text , transformers - , vector , vinyl >= 0.5 && < 0.6 ghc-options: -Wall default-language: Haskell2010 diff --git a/src/Haskell/Ide/Engine/BasePlugin.hs b/src/Haskell/Ide/Engine/BasePlugin.hs index bac210993..d77b9bf4f 100644 --- a/src/Haskell/Ide/Engine/BasePlugin.hs +++ b/src/Haskell/Ide/Engine/BasePlugin.hs @@ -81,7 +81,7 @@ versionCmd = CmdSync $ \_ _ -> return (IdeResponseOk version) pluginsCmd :: CommandFunc IdePlugins pluginsCmd = CmdSync $ \_ _ -> do plugins <- getPlugins - let commands = map getOne $ Map.toList plugins + let commands = Map.fromList $ map getOne $ Map.toList plugins getOne (pid,pd) = (pid,map (\c -> cmdDesc c) $ pdCommands pd) return (IdeResponseOk commands)