From 52602ab11d67d9bdf8e1bb0a435d9298dc58e82a Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Sat, 21 Nov 2015 13:13:47 +0100 Subject: [PATCH 01/21] working poc --- .../Haskell/Ide/Engine/PluginUtils.hs | 1 + src/Haskell/Ide/Engine/Monad.hs | 27 +++++++++++ test/DispatcherSpec.hs | 45 +++++++++++++++++++ 3 files changed, 73 insertions(+) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index e1e9588df..72a91aae8 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -63,6 +63,7 @@ mapEithers _ _ = Right [] -- --------------------------------------------------------------------- -- Helper functions for errors +-- --------------------------------------------------------------------- -- Missing parameter error missingParameter :: forall r. (ValidResponse r) => ParamId -> IdeResponse r diff --git a/src/Haskell/Ide/Engine/Monad.hs b/src/Haskell/Ide/Engine/Monad.hs index 581db6a2a..53622777f 100644 --- a/src/Haskell/Ide/Engine/Monad.hs +++ b/src/Haskell/Ide/Engine/Monad.hs @@ -17,8 +17,12 @@ import Exception import Haskell.Ide.Engine.PluginDescriptor import qualified Language.Haskell.GhcMod.Monad as GM import qualified Language.Haskell.GhcMod.Types as GM +import qualified Data.Map as Map +import Data.List import System.Directory +import Debug.Trace + -- Monad transformer stuff import Control.Monad.Trans.Control ( control, liftBaseOp, liftBaseOp_) @@ -44,8 +48,31 @@ data IdeState = IdeState -- --------------------------------------------------------------------- +type ParamNameCollision = (PluginId, [AcceptedContext], [ParamName]) + +validatePlugins :: Plugins -> IO () +validatePlugins plugins = do + let collisions = concatMap getParamNameCollisions (Map.toList plugins) :: [ParamNameCollision] + in case collisions of + [] -> return () + _ -> error "The parameter names are conflicting" + +getParamNameCollisions :: (PluginId, PluginDescriptor) -> [ParamNameCollision] +getParamNameCollisions (pluginId, pluginDesc) = do + let additionalParams = traceShowId $ extractAdditionalParams pluginDesc + additionalParamsCollisions = traceShowId $ additionalParams \\ (nub additionalParams) + in map (\paramName -> (pluginId, [], [paramName])) additionalParamsCollisions + +findCollisions :: [ParamName] -> [ParamName] +findCollisions paramNames = paramNames + +extractAdditionalParams :: PluginDescriptor -> [ParamName] +extractAdditionalParams pluginDesc = concatMap (map pName . cmdAdditionalParams . cmdDesc) (pdCommands pluginDesc) +-- --------------------------------------------------------------------- + runIdeM :: IdeState -> IdeM a -> IO a runIdeM initState f = do + validatePlugins (idePlugins initState) initializedRef <- newIORef False let inner' = GM.runGmOutT opts $ GM.runGhcModT opts $ do liftIO $ writeIORef initializedRef True diff --git a/test/DispatcherSpec.hs b/test/DispatcherSpec.hs index 9aeb170e8..40fa2bb7b 100644 --- a/test/DispatcherSpec.hs +++ b/test/DispatcherSpec.hs @@ -17,6 +17,7 @@ import Haskell.Ide.Engine.MonadFunctions import Haskell.Ide.Engine.PluginDescriptor import Haskell.Ide.Engine.Types +import Control.Exception (evaluate) import Test.Hspec -- --------------------------------------------------------------------- @@ -38,6 +39,13 @@ spec = do dispatcherSpec :: Spec dispatcherSpec = do + describe "checking plugins" $ do + + it "exits on parameter name collisions" $ do + runIdeM (IdeState testPluginWithParamNameCollison) undefined `shouldThrow` errorCall "The parameter names are conflicting" + + -- ----------------------------------- + describe "checking contexts" $ do it "identifies CtxNone" $ do @@ -245,6 +253,43 @@ dispatcherSpec = do -- --------------------------------------------------------------------- +testPluginWithParamNameCollison :: Plugins +testPluginWithParamNameCollison = Map.fromList [("plugin1", PluginDescriptor + { + pdCommands = + [ + Command + { cmdDesc = CommandDesc + { cmdName = "cmd1" + , cmdUiDescription = "description" + , cmdFileExtensions = [] + , cmdContexts = [CtxFile] + , cmdAdditionalParams = + [ + RP + { pName = "nonUniqueParamName" + , pHelp = "" + , pType = PtText + } + , RP + { pName = "nonUniqueParamName" + , pHelp = "" + , pType = PtText + } + , RP + { pName = "file" + , pHelp = "" + , pType = PtText + } + ] + } + , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) + } + ] + , pdExposedServices = [] + , pdUsedServices = [] + })] + testPlugins :: TChan () -> Plugins testPlugins chSync = Map.fromList [("test",testDescriptor chSync)] From bdfa3e1707928dee1010aa779728b778721116ee Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Sat, 21 Nov 2015 22:41:46 +0100 Subject: [PATCH 02/21] with a different approach: foreach --- src/Haskell/Ide/Engine/Monad.hs | 39 +++++++++++++++++++++------------ 1 file changed, 25 insertions(+), 14 deletions(-) diff --git a/src/Haskell/Ide/Engine/Monad.hs b/src/Haskell/Ide/Engine/Monad.hs index 53622777f..7564cd51c 100644 --- a/src/Haskell/Ide/Engine/Monad.hs +++ b/src/Haskell/Ide/Engine/Monad.hs @@ -17,10 +17,12 @@ import Exception import Haskell.Ide.Engine.PluginDescriptor import qualified Language.Haskell.GhcMod.Monad as GM import qualified Language.Haskell.GhcMod.Types as GM +import Data.Function (on) import qualified Data.Map as Map import Data.List import System.Directory + import Debug.Trace -- Monad transformer stuff @@ -48,26 +50,35 @@ data IdeState = IdeState -- --------------------------------------------------------------------- -type ParamNameCollision = (PluginId, [AcceptedContext], [ParamName]) +{- + transform to [(PluginId, [(Command, [ParamDescription])])] + filter [ParamDescription] on uniqueness + remove empty list items +-} +type ParamNameCollision = (PluginId, [(CommandName, [ParamName])]) validatePlugins :: Plugins -> IO () -validatePlugins plugins = do - let collisions = concatMap getParamNameCollisions (Map.toList plugins) :: [ParamNameCollision] - in case collisions of +validatePlugins plugins = + case extractParams plugins of [] -> return () - _ -> error "The parameter names are conflicting" + collisions -> error (show collisions) + + +foreach :: [a] -> (a -> b) -> [b] +foreach = flip map -getParamNameCollisions :: (PluginId, PluginDescriptor) -> [ParamNameCollision] -getParamNameCollisions (pluginId, pluginDesc) = do - let additionalParams = traceShowId $ extractAdditionalParams pluginDesc - additionalParamsCollisions = traceShowId $ additionalParams \\ (nub additionalParams) - in map (\paramName -> (pluginId, [], [paramName])) additionalParamsCollisions +extractParams :: Plugins -> [ParamNameCollision] +extractParams plugins = + foreach (Map.toList plugins) + (\(pluginId, pluginDesc) -> (pluginId, foreach (map cmdDesc (pdCommands pluginDesc)) + (\cmd -> (cmdName cmd, collidingParams (cmdAdditionalParams cmd))))) -findCollisions :: [ParamName] -> [ParamName] -findCollisions paramNames = paramNames +collidingParams :: [ParamDescription] ->[ParamName] +collidingParams params = + let pNames = map pName params + uniquePNames = nub pNames + in pNames \\ uniquePNames -extractAdditionalParams :: PluginDescriptor -> [ParamName] -extractAdditionalParams pluginDesc = concatMap (map pName . cmdAdditionalParams . cmdDesc) (pdCommands pluginDesc) -- --------------------------------------------------------------------- runIdeM :: IdeState -> IdeM a -> IO a From 3c4a079720c7572c30489f6d0ecacc104e3cc17b Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Sat, 21 Nov 2015 23:32:59 +0100 Subject: [PATCH 03/21] move validatePlugins to PluginUtil --- .../Haskell/Ide/Engine/PluginUtils.hs | 29 ++++++++++++++ src/Haskell/Ide/Engine/Monad.hs | 38 +------------------ test/DispatcherSpec.hs | 1 - 3 files changed, 30 insertions(+), 38 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index 72a91aae8..af3a66885 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -9,10 +9,12 @@ module Haskell.Ide.Engine.PluginUtils , mapEithers , missingParameter , incorrectParameter + , validatePlugins ) where import Data.Aeson +import Data.List import Data.Monoid import Data.Vinyl import Haskell.Ide.Engine.PluginDescriptor @@ -80,3 +82,30 @@ incorrectParameter name expected value = IdeResponseFail T.pack (show expected) <>" , got:" <> T.pack (show value)) (Just $ object ["param" .= toJSON name,"expected".= toJSON (show expected), "value" .= toJSON (show value)])) + + +-- --------------------------------------------------------------------- + +type ParamNameCollision = (PluginId, [(CommandName, [ParamName])]) + + +validatePlugins :: Plugins -> IO () +validatePlugins plugins = + case extractParams plugins of + [] -> return () + collisions -> error (show collisions) + +foreach :: [a] -> (a -> b) -> [b] +foreach = flip map + +extractParams :: Plugins -> [ParamNameCollision] +extractParams plugins = + foreach (Map.toList plugins) + (\(pluginId, pluginDesc) -> (pluginId, foreach (map cmdDesc (pdCommands pluginDesc)) + (\cmd -> (cmdName cmd, collidingParams (cmdAdditionalParams cmd))))) + +collidingParams :: [ParamDescription] ->[ParamName] +collidingParams params = + let pNames = map pName params + uniquePNames = nub pNames + in pNames \\ uniquePNames diff --git a/src/Haskell/Ide/Engine/Monad.hs b/src/Haskell/Ide/Engine/Monad.hs index 7564cd51c..cc8508a70 100644 --- a/src/Haskell/Ide/Engine/Monad.hs +++ b/src/Haskell/Ide/Engine/Monad.hs @@ -15,16 +15,11 @@ import Control.Monad.State import Data.IORef import Exception import Haskell.Ide.Engine.PluginDescriptor +import Haskell.Ide.Engine.PluginUtils import qualified Language.Haskell.GhcMod.Monad as GM import qualified Language.Haskell.GhcMod.Types as GM -import Data.Function (on) -import qualified Data.Map as Map -import Data.List import System.Directory - -import Debug.Trace - -- Monad transformer stuff import Control.Monad.Trans.Control ( control, liftBaseOp, liftBaseOp_) @@ -50,37 +45,6 @@ data IdeState = IdeState -- --------------------------------------------------------------------- -{- - transform to [(PluginId, [(Command, [ParamDescription])])] - filter [ParamDescription] on uniqueness - remove empty list items --} -type ParamNameCollision = (PluginId, [(CommandName, [ParamName])]) - -validatePlugins :: Plugins -> IO () -validatePlugins plugins = - case extractParams plugins of - [] -> return () - collisions -> error (show collisions) - - -foreach :: [a] -> (a -> b) -> [b] -foreach = flip map - -extractParams :: Plugins -> [ParamNameCollision] -extractParams plugins = - foreach (Map.toList plugins) - (\(pluginId, pluginDesc) -> (pluginId, foreach (map cmdDesc (pdCommands pluginDesc)) - (\cmd -> (cmdName cmd, collidingParams (cmdAdditionalParams cmd))))) - -collidingParams :: [ParamDescription] ->[ParamName] -collidingParams params = - let pNames = map pName params - uniquePNames = nub pNames - in pNames \\ uniquePNames - --- --------------------------------------------------------------------- - runIdeM :: IdeState -> IdeM a -> IO a runIdeM initState f = do validatePlugins (idePlugins initState) diff --git a/test/DispatcherSpec.hs b/test/DispatcherSpec.hs index 40fa2bb7b..e898345fd 100644 --- a/test/DispatcherSpec.hs +++ b/test/DispatcherSpec.hs @@ -17,7 +17,6 @@ import Haskell.Ide.Engine.MonadFunctions import Haskell.Ide.Engine.PluginDescriptor import Haskell.Ide.Engine.Types -import Control.Exception (evaluate) import Test.Hspec -- --------------------------------------------------------------------- From 8ac99810c29a782a509095d124d8edb2bcd1cb72 Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Sun, 22 Nov 2015 01:03:17 +0100 Subject: [PATCH 04/21] rename functions --- hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index af3a66885..57e1845af 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -88,24 +88,24 @@ incorrectParameter name expected value = IdeResponseFail type ParamNameCollision = (PluginId, [(CommandName, [ParamName])]) - +-- throw an error if the parameter names are colliding in any of the plugins validatePlugins :: Plugins -> IO () validatePlugins plugins = - case extractParams plugins of + case findParameterNameCollisions plugins of [] -> return () collisions -> error (show collisions) foreach :: [a] -> (a -> b) -> [b] foreach = flip map -extractParams :: Plugins -> [ParamNameCollision] -extractParams plugins = +findParameterNameCollisions :: Plugins -> [ParamNameCollision] +findParameterNameCollisions plugins = foreach (Map.toList plugins) (\(pluginId, pluginDesc) -> (pluginId, foreach (map cmdDesc (pdCommands pluginDesc)) - (\cmd -> (cmdName cmd, collidingParams (cmdAdditionalParams cmd))))) + (\cmd -> (cmdName cmd, collidingParamNames (cmdAdditionalParams cmd))))) -collidingParams :: [ParamDescription] ->[ParamName] -collidingParams params = +collidingParamNames :: [ParamDescription] ->[ParamName] +collidingParamNames params = let pNames = map pName params uniquePNames = nub pNames in pNames \\ uniquePNames From 5c779af585f7f100bde5a9304d00fe763012a233 Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Sun, 22 Nov 2015 01:25:59 +0100 Subject: [PATCH 05/21] checking AcceptedContext too --- hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs | 2 +- test/DispatcherSpec.hs | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index 57e1845af..e27dc5d9f 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -102,7 +102,7 @@ findParameterNameCollisions :: Plugins -> [ParamNameCollision] findParameterNameCollisions plugins = foreach (Map.toList plugins) (\(pluginId, pluginDesc) -> (pluginId, foreach (map cmdDesc (pdCommands pluginDesc)) - (\cmd -> (cmdName cmd, collidingParamNames (cmdAdditionalParams cmd))))) + (\cmd -> (cmdName cmd, collidingParamNames (cmdAdditionalParams cmd ++ concatMap contextMapping (cmdContexts cmd)))))) collidingParamNames :: [ParamDescription] ->[ParamName] collidingParamNames params = diff --git a/test/DispatcherSpec.hs b/test/DispatcherSpec.hs index e898345fd..4bffe6e5b 100644 --- a/test/DispatcherSpec.hs +++ b/test/DispatcherSpec.hs @@ -262,7 +262,7 @@ testPluginWithParamNameCollison = Map.fromList [("plugin1", PluginDescriptor { cmdName = "cmd1" , cmdUiDescription = "description" , cmdFileExtensions = [] - , cmdContexts = [CtxFile] + , cmdContexts = [CtxRegion] , cmdAdditionalParams = [ RP @@ -280,6 +280,11 @@ testPluginWithParamNameCollison = Map.fromList [("plugin1", PluginDescriptor , pHelp = "" , pType = PtText } + , OP + { pName = "end_pos" + , pHelp = "" + , pType = PtText + } ] } , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) From 2788b3baf173d418d377fc3cb91ec1a020865523 Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Sun, 22 Nov 2015 23:12:39 +0100 Subject: [PATCH 06/21] improve test data --- test/DispatcherSpec.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/test/DispatcherSpec.hs b/test/DispatcherSpec.hs index 4bffe6e5b..25ff7aad5 100644 --- a/test/DispatcherSpec.hs +++ b/test/DispatcherSpec.hs @@ -262,7 +262,7 @@ testPluginWithParamNameCollison = Map.fromList [("plugin1", PluginDescriptor { cmdName = "cmd1" , cmdUiDescription = "description" , cmdFileExtensions = [] - , cmdContexts = [CtxRegion] + , cmdContexts = [CtxRegion, CtxPoint] -- ["file", "start_pos", "file", "start_pos", "end_pos"] , cmdAdditionalParams = [ RP @@ -271,18 +271,18 @@ testPluginWithParamNameCollison = Map.fromList [("plugin1", PluginDescriptor , pType = PtText } , RP - { pName = "nonUniqueParamName" - , pHelp = "" + { pName = "uniqueParamName" + , pHelp = "shoud not collide" , pType = PtText } , RP - { pName = "file" - , pHelp = "" + { pName = "nonUniqueParamName" + , pHelp = "should collide with the first param" , pType = PtText } , OP { pName = "end_pos" - , pHelp = "" + , pHelp = "this should collide with CtxPoint from cmdContext" , pType = PtText } ] From 8ebd0d07c8f62e80aa92871dcb01154f81507007 Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Sun, 22 Nov 2015 23:19:40 +0100 Subject: [PATCH 07/21] change code style --- hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index e27dc5d9f..a28301089 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -95,14 +95,15 @@ validatePlugins plugins = [] -> return () collisions -> error (show collisions) -foreach :: [a] -> (a -> b) -> [b] -foreach = flip map - findParameterNameCollisions :: Plugins -> [ParamNameCollision] findParameterNameCollisions plugins = - foreach (Map.toList plugins) - (\(pluginId, pluginDesc) -> (pluginId, foreach (map cmdDesc (pdCommands pluginDesc)) - (\cmd -> (cmdName cmd, collidingParamNames (cmdAdditionalParams cmd ++ concatMap contextMapping (cmdContexts cmd)))))) + let collisionsForPlugin (pluginId, pluginDesc) = (pluginId, collisionsForPluginDesc pluginDesc) + collisionsForPluginDesc pluginDesc = map collisionsForCmd (getCmdDesc pluginDesc) + collisionsForCmd cmd = (cmdName cmd, collidingParamNames (allParams cmd)) + in map collisionsForPlugin (Map.toList plugins) + where getCmdDesc = map cmdDesc . pdCommands + allParams cmd = cmdAdditionalParams cmd ++ uniqueParamNamesFromContext cmd + uniqueParamNamesFromContext cmd = nub (concatMap contextMapping (cmdContexts cmd)) collidingParamNames :: [ParamDescription] ->[ParamName] collidingParamNames params = From 5b026545586f60eec9676a0c88519ce179ccdfa2 Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Mon, 23 Nov 2015 20:57:12 +0100 Subject: [PATCH 08/21] don't report collisions when there are none --- .../Haskell/Ide/Engine/PluginUtils.hs | 25 +++++++++--- test/DispatcherSpec.hs | 39 ++++++++++++++++++- 2 files changed, 57 insertions(+), 7 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index a28301089..856e12454 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -15,6 +15,7 @@ module Haskell.Ide.Engine.PluginUtils import Data.Aeson import Data.List +import Data.Maybe import Data.Monoid import Data.Vinyl import Haskell.Ide.Engine.PluginDescriptor @@ -93,15 +94,27 @@ validatePlugins :: Plugins -> IO () validatePlugins plugins = case findParameterNameCollisions plugins of [] -> return () - collisions -> error (show collisions) + collisions -> error (formatParamNameCollisionErrorMsg collisions) + +formatParamNameCollisionErrorMsg :: [ParamNameCollision] -> String +formatParamNameCollisionErrorMsg = show -- TODO findParameterNameCollisions :: Plugins -> [ParamNameCollision] findParameterNameCollisions plugins = - let collisionsForPlugin (pluginId, pluginDesc) = (pluginId, collisionsForPluginDesc pluginDesc) - collisionsForPluginDesc pluginDesc = map collisionsForCmd (getCmdDesc pluginDesc) - collisionsForCmd cmd = (cmdName cmd, collidingParamNames (allParams cmd)) - in map collisionsForPlugin (Map.toList plugins) - where getCmdDesc = map cmdDesc . pdCommands + let + collisionsForPlugin (pluginId, pluginDesc) = + case collisionsForPluginDesc pluginDesc of + [] -> Nothing + commands -> Just (pluginId, commands) + collisionsForPluginDesc pluginDesc = mapMaybe collisionsForCmd (getCmdDesc pluginDesc) + collisionsForCmd cmd = + case allCollidingParamNames cmd of + [] -> Nothing + paramNames -> Just (cmdName cmd, paramNames) + in mapMaybe collisionsForPlugin (Map.toList plugins) + where + allCollidingParamNames = collidingParamNames . allParams + getCmdDesc = map cmdDesc . pdCommands allParams cmd = cmdAdditionalParams cmd ++ uniqueParamNamesFromContext cmd uniqueParamNamesFromContext cmd = nub (concatMap contextMapping (cmdContexts cmd)) diff --git a/test/DispatcherSpec.hs b/test/DispatcherSpec.hs index 25ff7aad5..361d91d6b 100644 --- a/test/DispatcherSpec.hs +++ b/test/DispatcherSpec.hs @@ -38,11 +38,16 @@ spec = do dispatcherSpec :: Spec dispatcherSpec = do - describe "checking plugins" $ do + describe "checking plugins on startup" $ do it "exits on parameter name collisions" $ do runIdeM (IdeState testPluginWithParamNameCollison) undefined `shouldThrow` errorCall "The parameter names are conflicting" + -- --------------------------------- + + it "does not exit on non-colliding parameter names" $ do + runIdeM (IdeState testPluginWithoutParamNameCollison) undefined `shouldThrow` errorCall "The parameter names are conflicting" + -- ----------------------------------- describe "checking contexts" $ do @@ -252,6 +257,38 @@ dispatcherSpec = do -- --------------------------------------------------------------------- +testPluginWithoutParamNameCollison :: Plugins +testPluginWithoutParamNameCollison = Map.fromList [("plugin1", PluginDescriptor + { + pdCommands = + [ + Command + { cmdDesc = CommandDesc + { cmdName = "cmd1" + , cmdUiDescription = "description" + , cmdFileExtensions = [] + , cmdContexts = [CtxRegion, CtxPoint] -- ["file", "start_pos", "file", "start_pos", "end_pos"] + , cmdAdditionalParams = + [ + RP + { pName = "uniqueParamName1" + , pHelp = "shoud not collide" + , pType = PtText + } + , RP + { pName = "uniqueParamName2" + , pHelp = "shoud not collide" + , pType = PtText + } + ] + } + , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) + } + ] + , pdExposedServices = [] + , pdUsedServices = [] + })] + testPluginWithParamNameCollison :: Plugins testPluginWithParamNameCollison = Map.fromList [("plugin1", PluginDescriptor { From bf4b19fb9c440ff04848fa965fb5bdf8796efa08 Mon Sep 17 00:00:00 2001 From: Tobias Gulbrandsen Waaler Date: Tue, 24 Nov 2015 15:06:37 +0100 Subject: [PATCH 09/21] WIP: leave only a shallow test in DispatcherSpec and write more detailed ones in PluginUtilsSpec after changing the return type of validatePlugins to Maybe Error --- test/DispatcherSpec.hs | 7 +------ test/PluginUtilsSpec.hs | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+), 6 deletions(-) create mode 100644 test/PluginUtilsSpec.hs diff --git a/test/DispatcherSpec.hs b/test/DispatcherSpec.hs index 361d91d6b..cae878413 100644 --- a/test/DispatcherSpec.hs +++ b/test/DispatcherSpec.hs @@ -41,15 +41,10 @@ dispatcherSpec = do describe "checking plugins on startup" $ do it "exits on parameter name collisions" $ do - runIdeM (IdeState testPluginWithParamNameCollison) undefined `shouldThrow` errorCall "The parameter names are conflicting" + runIdeM (IdeState testPluginWithParamNameCollison) undefined `shouldThrow` anyErrorCall -- --------------------------------- - it "does not exit on non-colliding parameter names" $ do - runIdeM (IdeState testPluginWithoutParamNameCollison) undefined `shouldThrow` errorCall "The parameter names are conflicting" - - -- ----------------------------------- - describe "checking contexts" $ do it "identifies CtxNone" $ do diff --git a/test/PluginUtilsSpec.hs b/test/PluginUtilsSpec.hs new file mode 100644 index 000000000..f9d074ed3 --- /dev/null +++ b/test/PluginUtilsSpec.hs @@ -0,0 +1,18 @@ +module PluginUtilsSpec where + +import Haskell.Ide.Engine.PluginUtils +import Test.Hspec + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "PluginUtils" pluginUtilsSpec + +dispatcherSpec :: Spec +dispatcherSpec = do + describe "" $ do + + it "" $ do + validatePlugins pluginsWithoutCollisions `shouldBe` [] From eb32bf62451409c2d6acad8058223c171c41a520 Mon Sep 17 00:00:00 2001 From: Tobias Gulbrandsen Waaler Date: Wed, 25 Nov 2015 11:23:47 +0100 Subject: [PATCH 10/21] move more files to PluginUtilsSpec --- .../Haskell/Ide/Engine/PluginUtils.hs | 16 ++++-- src/Haskell/Ide/Engine/Monad.hs | 4 +- test/DispatcherSpec.hs | 32 ----------- test/PluginUtilsSpec.hs | 54 ++++++++++++++++--- 4 files changed, 62 insertions(+), 44 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index 856e12454..cd70e2cfc 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -10,6 +10,7 @@ module Haskell.Ide.Engine.PluginUtils , missingParameter , incorrectParameter , validatePlugins + , PluginDescriptionError(..) ) where import Data.Aeson @@ -88,13 +89,20 @@ incorrectParameter name expected value = IdeResponseFail -- --------------------------------------------------------------------- type ParamNameCollision = (PluginId, [(CommandName, [ParamName])]) +data PluginDescriptionError = + PluginDescriptionError { + paramNameCollisions :: [ParamNameCollision] + , paramNameCollisionErrorMsg :: String + } deriving Eq --- throw an error if the parameter names are colliding in any of the plugins -validatePlugins :: Plugins -> IO () +validatePlugins :: Plugins -> Maybe PluginDescriptionError validatePlugins plugins = case findParameterNameCollisions plugins of - [] -> return () - collisions -> error (formatParamNameCollisionErrorMsg collisions) + [] -> Nothing + collisions -> Just PluginDescriptionError { + paramNameCollisions = collisions + , paramNameCollisionErrorMsg = formatParamNameCollisionErrorMsg collisions + } formatParamNameCollisionErrorMsg :: [ParamNameCollision] -> String formatParamNameCollisionErrorMsg = show -- TODO diff --git a/src/Haskell/Ide/Engine/Monad.hs b/src/Haskell/Ide/Engine/Monad.hs index cc8508a70..dd4c66c65 100644 --- a/src/Haskell/Ide/Engine/Monad.hs +++ b/src/Haskell/Ide/Engine/Monad.hs @@ -47,7 +47,9 @@ data IdeState = IdeState runIdeM :: IdeState -> IdeM a -> IO a runIdeM initState f = do - validatePlugins (idePlugins initState) + case validatePlugins (idePlugins initState) of + Just err -> error (paramNameCollisionErrorMsg err) + Nothing -> return () initializedRef <- newIORef False let inner' = GM.runGmOutT opts $ GM.runGhcModT opts $ do liftIO $ writeIORef initializedRef True diff --git a/test/DispatcherSpec.hs b/test/DispatcherSpec.hs index cae878413..9ec5abb4f 100644 --- a/test/DispatcherSpec.hs +++ b/test/DispatcherSpec.hs @@ -252,38 +252,6 @@ dispatcherSpec = do -- --------------------------------------------------------------------- -testPluginWithoutParamNameCollison :: Plugins -testPluginWithoutParamNameCollison = Map.fromList [("plugin1", PluginDescriptor - { - pdCommands = - [ - Command - { cmdDesc = CommandDesc - { cmdName = "cmd1" - , cmdUiDescription = "description" - , cmdFileExtensions = [] - , cmdContexts = [CtxRegion, CtxPoint] -- ["file", "start_pos", "file", "start_pos", "end_pos"] - , cmdAdditionalParams = - [ - RP - { pName = "uniqueParamName1" - , pHelp = "shoud not collide" - , pType = PtText - } - , RP - { pName = "uniqueParamName2" - , pHelp = "shoud not collide" - , pType = PtText - } - ] - } - , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) - } - ] - , pdExposedServices = [] - , pdUsedServices = [] - })] - testPluginWithParamNameCollison :: Plugins testPluginWithParamNameCollison = Map.fromList [("plugin1", PluginDescriptor { diff --git a/test/PluginUtilsSpec.hs b/test/PluginUtilsSpec.hs index f9d074ed3..9f7d6b302 100644 --- a/test/PluginUtilsSpec.hs +++ b/test/PluginUtilsSpec.hs @@ -1,7 +1,13 @@ +{-# LANGUAGE OverloadedStrings #-} module PluginUtilsSpec where -import Haskell.Ide.Engine.PluginUtils -import Test.Hspec +import Haskell.Ide.Engine.PluginUtils +import Haskell.Ide.Engine.PluginDescriptor + +import qualified Data.Map as Map +import qualified Data.Text as T + +import Test.Hspec main :: IO () main = hspec spec @@ -10,9 +16,43 @@ spec :: Spec spec = do describe "PluginUtils" pluginUtilsSpec -dispatcherSpec :: Spec -dispatcherSpec = do - describe "" $ do +pluginUtilsSpec :: Spec +pluginUtilsSpec = do + describe "validatePlugins" $ do + + it "accepts plugins without parameter name collisions" $ do + validatePlugins pluginsWithoutCollisions `shouldBe` Nothing + + - it "" $ do - validatePlugins pluginsWithoutCollisions `shouldBe` [] +pluginsWithoutCollisions :: Plugins +pluginsWithoutCollisions = Map.fromList [("plugin1", PluginDescriptor + { + pdCommands = + [ + Command + { cmdDesc = CommandDesc + { cmdName = "cmd1" + , cmdUiDescription = "description" + , cmdFileExtensions = [] + , cmdContexts = [CtxRegion, CtxPoint] -- ["file", "start_pos", "file", "start_pos", "end_pos"] + , cmdAdditionalParams = + [ + RP + { pName = "uniqueParamName1" + , pHelp = "shoud not collide" + , pType = PtText + } + , RP + { pName = "uniqueParamName2" + , pHelp = "shoud not collide" + , pType = PtText + } + ] + } + , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) + } + ] + , pdExposedServices = [] + , pdUsedServices = [] + })] From e9cea16128708e58ce54ea86d54d08d395caf7ad Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Wed, 25 Nov 2015 22:27:03 +0100 Subject: [PATCH 11/21] more tests --- haskell-ide-engine.cabal | 1 + .../Haskell/Ide/Engine/PluginUtils.hs | 3 +- test/DispatcherSpec.hs | 2 +- test/PluginUtilsSpec.hs | 148 ++++++++++++++++++ 4 files changed, 152 insertions(+), 2 deletions(-) diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index 5eee87275..68b799244 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -97,6 +97,7 @@ test-suite haskell-ide-test HaRePluginSpec JsonStdioSpec JsonSpec + PluginUtilsSpec build-depends: base , aeson , containers diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index cd70e2cfc..41550d64d 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -11,6 +11,7 @@ module Haskell.Ide.Engine.PluginUtils , incorrectParameter , validatePlugins , PluginDescriptionError(..) + , ParamNameCollision ) where import Data.Aeson @@ -93,7 +94,7 @@ data PluginDescriptionError = PluginDescriptionError { paramNameCollisions :: [ParamNameCollision] , paramNameCollisionErrorMsg :: String - } deriving Eq + } deriving (Eq, Show) validatePlugins :: Plugins -> Maybe PluginDescriptionError validatePlugins plugins = diff --git a/test/DispatcherSpec.hs b/test/DispatcherSpec.hs index 9ec5abb4f..21cdefb54 100644 --- a/test/DispatcherSpec.hs +++ b/test/DispatcherSpec.hs @@ -40,7 +40,7 @@ dispatcherSpec :: Spec dispatcherSpec = do describe "checking plugins on startup" $ do - it "exits on parameter name collisions" $ do + it "exits with an error if any command has a parameter name collision" $ do runIdeM (IdeState testPluginWithParamNameCollison) undefined `shouldThrow` anyErrorCall -- --------------------------------- diff --git a/test/PluginUtilsSpec.hs b/test/PluginUtilsSpec.hs index 9f7d6b302..19aaa437a 100644 --- a/test/PluginUtilsSpec.hs +++ b/test/PluginUtilsSpec.hs @@ -23,6 +23,154 @@ pluginUtilsSpec = do it "accepts plugins without parameter name collisions" $ do validatePlugins pluginsWithoutCollisions `shouldBe` Nothing + it "reports collisions for plugins with parameter name collisions" $ do + fmap paramNameCollisions (validatePlugins pluginsWithCollisions) `shouldBe` Just + [ + ("plugin1", + [ + ("cmd1", ["file"]) + , ("cmd2", ["end_pos"]) + , ("cmd3", ["a", "a", "b"]) + ] + ) + , ("plugin2", + [ + ("cmd1", ["file"]) + ] + ) + ] + + + it "pretty prints the error message" $ do + fmap paramNameCollisionErrorMsg (validatePlugins pluginsWithCollisions) `shouldBe` Just ( + "In plugin \"plugin1\" the command \"cmd1\" has multiple parameters named \"file\"" ++ + "\nIn plugin \"plugin1\" the command \"cmd2\" has multiple parameters named \"end_pos\"" ++ + "\nIn plugin \"plugin1\" the command \"cmd3\" has multiple parameters named \"a\", \"b\"" ++ + "\nIn plugin \"plugin2\" the command \"cmd1\" has multiple parameters named \"file\"" + ) + + +pluginsWithCollisions :: Plugins +pluginsWithCollisions = Map.fromList [("plugin1", PluginDescriptor + { + pdCommands = + [ + Command + { cmdDesc = CommandDesc + { cmdName = "cmd1" + , cmdUiDescription = "" + , cmdFileExtensions = [] + , cmdContexts = [CtxRegion, CtxPoint] -- ["file", "start_pos", "file", "start_pos", "end_pos"] + , cmdAdditionalParams = + [ + RP + { pName = "file" + , pHelp = "shoud collide" + , pType = PtText + } + , RP + { pName = "uniqueParamName1" + , pHelp = "shoud not collide" + , pType = PtText + } + ] + } + , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) + } + , Command + { cmdDesc = CommandDesc + { cmdName = "cmd2" + , cmdUiDescription = "" + , cmdFileExtensions = [] + , cmdContexts = [CtxRegion] + , cmdAdditionalParams = + [ + RP + { pName = "end_pos" + , pHelp = "shoud collide" + , pType = PtText + } + , OP + { pName = "uniqueParamName1" + , pHelp = "shoud not collide" + , pType = PtText + } + ] + } + , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) + } + , Command + { cmdDesc = CommandDesc + { cmdName = "cmd3" + , cmdUiDescription = "" + , cmdFileExtensions = [] + , cmdContexts = [] -- ["file", "start_pos", "file", "start_pos", "end_pos"] + , cmdAdditionalParams = + [ + RP + { pName = "a" + , pHelp = "shoud collide" + , pType = PtText + } + , OP + { pName = "a" + , pHelp = "shoud collide" + , pType = PtText + } + , OP + { pName = "a" + , pHelp = "shoud collide" + , pType = PtText + } + , RP + { pName = "b" + , pHelp = "shoud collide" + , pType = PtText + } + , RP + { pName = "b" + , pHelp = "shoud collide" + , pType = PtText + } + ] + } + , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) + } + ] + , pdExposedServices = [] + , pdUsedServices = [] + }) + , ("plugin2", PluginDescriptor + { + pdCommands = + [ + Command + { cmdDesc = CommandDesc + { cmdName = "cmd1" + , cmdUiDescription = "" + , cmdFileExtensions = [] + , cmdContexts = [CtxRegion, CtxPoint] -- ["file", "start_pos", "file", "start_pos", "end_pos"] + , cmdAdditionalParams = + [ + RP + { pName = "file" + , pHelp = "shoud collide" + , pType = PtText + } + , RP + { pName = "uniqueParamName1" + , pHelp = "shoud not collide" + , pType = PtText + } + ] + } + , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) + } + ] + , pdExposedServices = [] + , pdUsedServices = [] + }) + ] pluginsWithoutCollisions :: Plugins From da5b7bc4453ef89b8554c35a96e25e59b3629e10 Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Thu, 26 Nov 2015 22:41:29 +0100 Subject: [PATCH 12/21] add ParamDescriptions for each param name --- hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs | 10 ++++++++-- test/PluginUtilsSpec.hs | 8 ++++---- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index 41550d64d..d7b2d62ea 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -89,7 +89,7 @@ incorrectParameter name expected value = IdeResponseFail -- --------------------------------------------------------------------- -type ParamNameCollision = (PluginId, [(CommandName, [ParamName])]) +type ParamNameCollision = (PluginId, [(CommandName, [(ParamName, [ParamDescription])])]) data PluginDescriptionError = PluginDescriptionError { paramNameCollisions :: [ParamNameCollision] @@ -122,11 +122,17 @@ findParameterNameCollisions plugins = paramNames -> Just (cmdName cmd, paramNames) in mapMaybe collisionsForPlugin (Map.toList plugins) where - allCollidingParamNames = collidingParamNames . allParams + allCollidingParamNames cmd = map (\p -> (p, collidingParamNameSources cmd p)) (collidingParamNames (allParams cmd)) getCmdDesc = map cmdDesc . pdCommands allParams cmd = cmdAdditionalParams cmd ++ uniqueParamNamesFromContext cmd uniqueParamNamesFromContext cmd = nub (concatMap contextMapping (cmdContexts cmd)) +collidingParamNameSources :: CommandDescriptor -> ParamName -> [ParamDescription] +collidingParamNameSources cmdDescriptor paramName = + let additionalParams = filter (\p -> pName p == paramName) (cmdAdditionalParams cmdDescriptor) + contextParams = filter (\p -> pName p == paramName) (concatMap contextMapping (cmdContexts cmdDescriptor)) + in additionalParams ++ contextParams + collidingParamNames :: [ParamDescription] ->[ParamName] collidingParamNames params = let pNames = map pName params diff --git a/test/PluginUtilsSpec.hs b/test/PluginUtilsSpec.hs index 19aaa437a..6035a3ca8 100644 --- a/test/PluginUtilsSpec.hs +++ b/test/PluginUtilsSpec.hs @@ -28,14 +28,14 @@ pluginUtilsSpec = do [ ("plugin1", [ - ("cmd1", ["file"]) - , ("cmd2", ["end_pos"]) - , ("cmd3", ["a", "a", "b"]) + ("cmd1", [("file", [])]) + , ("cmd2", [("end_pos", [])]) + , ("cmd3", [("a", []), ("b", [])]) ] ) , ("plugin2", [ - ("cmd1", ["file"]) + ("cmd1", [("file", [])]) ] ) ] From 5a3cd8236322f47c6ccc93a91eefd778b3527f4d Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Fri, 27 Nov 2015 21:41:01 +0100 Subject: [PATCH 13/21] updated tests --- test/PluginUtilsSpec.hs | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/test/PluginUtilsSpec.hs b/test/PluginUtilsSpec.hs index 6035a3ca8..a49b12dfc 100644 --- a/test/PluginUtilsSpec.hs +++ b/test/PluginUtilsSpec.hs @@ -28,9 +28,22 @@ pluginUtilsSpec = do [ ("plugin1", [ - ("cmd1", [("file", [])]) - , ("cmd2", [("end_pos", [])]) - , ("cmd3", [("a", []), ("b", [])]) + ("cmd1", [("file", [ fileParam + , RP + { pName = "file" + , pHelp = "shoud collide" + , pType = PtText + } + ])]) + , ("cmd2", [("end_pos", [ endPosParam + , RP + { pName = "end_pos" + , pHelp = "shoud collide" + , pType = PtText + } + ])]) + , ("cmd3", [ ("a", []) + , ("b", [])]) ] ) , ("plugin2", From 9bcc96fe08d32c74fff8df35569f83324bc4c4d1 Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Sun, 29 Nov 2015 15:55:54 +0100 Subject: [PATCH 14/21] flatter data structures --- .../Haskell/Ide/Engine/PluginUtils.hs | 89 +++++++++---------- 1 file changed, 44 insertions(+), 45 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index d7b2d62ea..0a13101b2 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -11,7 +11,7 @@ module Haskell.Ide.Engine.PluginUtils , incorrectParameter , validatePlugins , PluginDescriptionError(..) - , ParamNameCollision + , ParamCollision ) where import Data.Aeson @@ -89,52 +89,51 @@ incorrectParameter name expected value = IdeResponseFail -- --------------------------------------------------------------------- -type ParamNameCollision = (PluginId, [(CommandName, [(ParamName, [ParamDescription])])]) +data ParamCollision = ParamCollision ParamLocation ParamCollisionInfo deriving (Eq, Show) +data ParamLocation = ParamLocation PluginId CommandName ParamName deriving (Eq, Show) +data ParamCollisionInfo = AdditionalParam ParamDescription | ContextParam AcceptedContext ParamDescription deriving (Eq, Show) +type AdditionalParams = [ParamDescription] +type ContextParams = [(AcceptedContext, ParamDescription)] + +paramNameCollisions :: Plugins -> [ParamCollision] +paramNameCollisions plugins = + concatMap (\(plId, plDesc) -> + concatMap (paramNameCollisionsForCmd plId . cmdDesc) (pdCommands plDesc)) (Map.toList plugins) + +paramNameCollisionsForCmd :: PluginId -> CommandDescriptor -> [ParamCollision] +paramNameCollisionsForCmd plId cmdDescriptor = + let collidingParamNames = findCollidingParamNames cmdDescriptor + location = ParamLocation plId (cmdName cmdDescriptor) + collisionSources = + concatMap (\paramName -> + map (ParamCollision (location paramName)) + (paramsByName cmdDescriptor paramName)) + collidingParamNames + in collisionSources + +-- find all the parameters within the CommandDescriptor that goes by the given ParamName +paramsByName :: CommandDescriptor -> ParamName -> [ParamCollisionInfo] +paramsByName cmdDesc paramName = + undefined + +findCollidingParamNames :: CommandDescriptor -> [ParamName] +findCollidingParamNames = -- TODO: remember that collisions within AcceptedContext should not count + undefined + data PluginDescriptionError = - PluginDescriptionError { - paramNameCollisions :: [ParamNameCollision] - , paramNameCollisionErrorMsg :: String - } deriving (Eq, Show) + PluginDescriptionError { + pdeCollisions :: [ParamCollision] + , pdeErrorMsg :: String + } deriving (Eq, Show) validatePlugins :: Plugins -> Maybe PluginDescriptionError validatePlugins plugins = - case findParameterNameCollisions plugins of - [] -> Nothing - collisions -> Just PluginDescriptionError { - paramNameCollisions = collisions - , paramNameCollisionErrorMsg = formatParamNameCollisionErrorMsg collisions - } - -formatParamNameCollisionErrorMsg :: [ParamNameCollision] -> String + case paramNameCollisions plugins of + [] -> Nothing + collisions -> Just PluginDescriptionError { + pdeCollisions = collisions + , pdeErrorMsg = formatParamNameCollisionErrorMsg collisions + } + +formatParamNameCollisionErrorMsg :: [ParamCollision] -> String formatParamNameCollisionErrorMsg = show -- TODO - -findParameterNameCollisions :: Plugins -> [ParamNameCollision] -findParameterNameCollisions plugins = - let - collisionsForPlugin (pluginId, pluginDesc) = - case collisionsForPluginDesc pluginDesc of - [] -> Nothing - commands -> Just (pluginId, commands) - collisionsForPluginDesc pluginDesc = mapMaybe collisionsForCmd (getCmdDesc pluginDesc) - collisionsForCmd cmd = - case allCollidingParamNames cmd of - [] -> Nothing - paramNames -> Just (cmdName cmd, paramNames) - in mapMaybe collisionsForPlugin (Map.toList plugins) - where - allCollidingParamNames cmd = map (\p -> (p, collidingParamNameSources cmd p)) (collidingParamNames (allParams cmd)) - getCmdDesc = map cmdDesc . pdCommands - allParams cmd = cmdAdditionalParams cmd ++ uniqueParamNamesFromContext cmd - uniqueParamNamesFromContext cmd = nub (concatMap contextMapping (cmdContexts cmd)) - -collidingParamNameSources :: CommandDescriptor -> ParamName -> [ParamDescription] -collidingParamNameSources cmdDescriptor paramName = - let additionalParams = filter (\p -> pName p == paramName) (cmdAdditionalParams cmdDescriptor) - contextParams = filter (\p -> pName p == paramName) (concatMap contextMapping (cmdContexts cmdDescriptor)) - in additionalParams ++ contextParams - -collidingParamNames :: [ParamDescription] ->[ParamName] -collidingParamNames params = - let pNames = map pName params - uniquePNames = nub pNames - in pNames \\ uniquePNames From d0e2f1e8b4d01f6b94fa0f28a65d20700892995b Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Sun, 29 Nov 2015 17:00:06 +0100 Subject: [PATCH 15/21] handle parameters from cmdContexts --- .../Haskell/Ide/Engine/PluginUtils.hs | 26 ++++++++++++++----- src/Haskell/Ide/Engine/Monad.hs | 2 +- test/PluginUtilsSpec.hs | 4 +-- 3 files changed, 22 insertions(+), 10 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index 0a13101b2..1d5c4ac92 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -91,9 +91,9 @@ incorrectParameter name expected value = IdeResponseFail data ParamCollision = ParamCollision ParamLocation ParamCollisionInfo deriving (Eq, Show) data ParamLocation = ParamLocation PluginId CommandName ParamName deriving (Eq, Show) -data ParamCollisionInfo = AdditionalParam ParamDescription | ContextParam AcceptedContext ParamDescription deriving (Eq, Show) -type AdditionalParams = [ParamDescription] -type ContextParams = [(AcceptedContext, ParamDescription)] +data ParamCollisionInfo = AdditionalParam ParamDescription + | ContextParam ParamDescription AcceptedContext + deriving (Eq, Show) paramNameCollisions :: Plugins -> [ParamCollision] paramNameCollisions plugins = @@ -113,12 +113,24 @@ paramNameCollisionsForCmd plId cmdDescriptor = -- find all the parameters within the CommandDescriptor that goes by the given ParamName paramsByName :: CommandDescriptor -> ParamName -> [ParamCollisionInfo] -paramsByName cmdDesc paramName = - undefined +paramsByName cmdDescriptor paramName = + let matchingParamName param = pName param == paramName + additionalParams = map AdditionalParam $ filter matchingParamName (cmdAdditionalParams cmdDescriptor) + cmdContextParams = concatMap + (\accContext -> map + (\param -> (param, accContext)) + (contextMapping accContext)) + (cmdContexts cmdDescriptor) + cmdContextParamsWithCollisions = map (uncurry ContextParam) $ filter (\(param, _) -> matchingParamName param) cmdContextParams + in additionalParams ++ cmdContextParamsWithCollisions findCollidingParamNames :: CommandDescriptor -> [ParamName] -findCollidingParamNames = -- TODO: remember that collisions within AcceptedContext should not count - undefined +findCollidingParamNames cmdDescriptor = + let cmdContextPNames = nub $ concatMap (map pName . contextMapping) (cmdContexts cmdDescriptor) -- collisions within AcceptedContext should not count + additionalPNames = map pName (cmdAdditionalParams cmdDescriptor) + allPNames = cmdContextPNames ++ additionalPNames + uniquePNames = nub allPNames + in nub (allPNames \\ uniquePNames) data PluginDescriptionError = PluginDescriptionError { diff --git a/src/Haskell/Ide/Engine/Monad.hs b/src/Haskell/Ide/Engine/Monad.hs index dd4c66c65..be02958b9 100644 --- a/src/Haskell/Ide/Engine/Monad.hs +++ b/src/Haskell/Ide/Engine/Monad.hs @@ -48,7 +48,7 @@ data IdeState = IdeState runIdeM :: IdeState -> IdeM a -> IO a runIdeM initState f = do case validatePlugins (idePlugins initState) of - Just err -> error (paramNameCollisionErrorMsg err) + Just err -> error (pdeErrorMsg err) Nothing -> return () initializedRef <- newIORef False let inner' = GM.runGmOutT opts $ GM.runGhcModT opts $ do diff --git a/test/PluginUtilsSpec.hs b/test/PluginUtilsSpec.hs index a49b12dfc..da1e752ca 100644 --- a/test/PluginUtilsSpec.hs +++ b/test/PluginUtilsSpec.hs @@ -24,7 +24,7 @@ pluginUtilsSpec = do validatePlugins pluginsWithoutCollisions `shouldBe` Nothing it "reports collisions for plugins with parameter name collisions" $ do - fmap paramNameCollisions (validatePlugins pluginsWithCollisions) `shouldBe` Just + fmap pdeCollisions (validatePlugins pluginsWithCollisions) `shouldBe` Just [ ("plugin1", [ @@ -55,7 +55,7 @@ pluginUtilsSpec = do it "pretty prints the error message" $ do - fmap paramNameCollisionErrorMsg (validatePlugins pluginsWithCollisions) `shouldBe` Just ( + fmap pdeErrorMsg (validatePlugins pluginsWithCollisions) `shouldBe` Just ( "In plugin \"plugin1\" the command \"cmd1\" has multiple parameters named \"file\"" ++ "\nIn plugin \"plugin1\" the command \"cmd2\" has multiple parameters named \"end_pos\"" ++ "\nIn plugin \"plugin1\" the command \"cmd3\" has multiple parameters named \"a\", \"b\"" ++ From 0ae2cd54c9f055bbe3af2dc72f760c3af9124caa Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Sun, 29 Nov 2015 17:20:52 +0100 Subject: [PATCH 16/21] start updating the tests --- hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs | 4 +++- test/PluginUtilsSpec.hs | 16 ++++++++++++++-- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index 1d5c4ac92..f59824aff 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -11,7 +11,9 @@ module Haskell.Ide.Engine.PluginUtils , incorrectParameter , validatePlugins , PluginDescriptionError(..) - , ParamCollision + , ParamCollision(..) + , ParamLocation(..) + , ParamCollisionInfo(..) ) where import Data.Aeson diff --git a/test/PluginUtilsSpec.hs b/test/PluginUtilsSpec.hs index da1e752ca..9aeee31fd 100644 --- a/test/PluginUtilsSpec.hs +++ b/test/PluginUtilsSpec.hs @@ -25,7 +25,19 @@ pluginUtilsSpec = do it "reports collisions for plugins with parameter name collisions" $ do fmap pdeCollisions (validatePlugins pluginsWithCollisions) `shouldBe` Just - [ + [ ParamCollision + (ParamLocation "plugin1" "cmd1" "file") + (AdditionalParam + RP + { pName = "file" + , pHelp = "shoud collide" + , pType = PtText + }) + , ParamCollision + (ParamLocation "plugin1" "cmd1" "file") + (ContextParam fileParam CtxRegion) + ] +{- ("plugin1", [ ("cmd1", [("file", [ fileParam @@ -52,7 +64,7 @@ pluginUtilsSpec = do ] ) ] - +-} it "pretty prints the error message" $ do fmap pdeErrorMsg (validatePlugins pluginsWithCollisions) `shouldBe` Just ( From 1dd63242ee1dd4f1e791f9500cee1cf2feaaa945 Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Sun, 29 Nov 2015 18:26:19 +0100 Subject: [PATCH 17/21] change data structure --- .../Haskell/Ide/Engine/PluginUtils.hs | 30 ++-- test/PluginUtilsSpec.hs | 155 +++++++++++++----- 2 files changed, 129 insertions(+), 56 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index f59824aff..3d3d55883 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -12,8 +12,7 @@ module Haskell.Ide.Engine.PluginUtils , validatePlugins , PluginDescriptionError(..) , ParamCollision(..) - , ParamLocation(..) - , ParamCollisionInfo(..) + , ParamOccurence(..) ) where import Data.Aeson @@ -91,11 +90,10 @@ incorrectParameter name expected value = IdeResponseFail -- --------------------------------------------------------------------- -data ParamCollision = ParamCollision ParamLocation ParamCollisionInfo deriving (Eq, Show) -data ParamLocation = ParamLocation PluginId CommandName ParamName deriving (Eq, Show) -data ParamCollisionInfo = AdditionalParam ParamDescription - | ContextParam ParamDescription AcceptedContext - deriving (Eq, Show) +data ParamCollision = ParamCollision PluginId CommandName ParamName [ParamOccurence] deriving (Eq, Show) +data ParamOccurence = AdditionalParam ParamDescription + | ContextParam ParamDescription AcceptedContext + deriving (Eq, Show) paramNameCollisions :: Plugins -> [ParamCollision] paramNameCollisions plugins = @@ -105,16 +103,11 @@ paramNameCollisions plugins = paramNameCollisionsForCmd :: PluginId -> CommandDescriptor -> [ParamCollision] paramNameCollisionsForCmd plId cmdDescriptor = let collidingParamNames = findCollidingParamNames cmdDescriptor - location = ParamLocation plId (cmdName cmdDescriptor) - collisionSources = - concatMap (\paramName -> - map (ParamCollision (location paramName)) - (paramsByName cmdDescriptor paramName)) - collidingParamNames + collisionSources = map (\param -> ParamCollision plId (cmdName cmdDescriptor) param (paramsByName cmdDescriptor param)) collidingParamNames in collisionSources -- find all the parameters within the CommandDescriptor that goes by the given ParamName -paramsByName :: CommandDescriptor -> ParamName -> [ParamCollisionInfo] +paramsByName :: CommandDescriptor -> ParamName -> [ParamOccurence] paramsByName cmdDescriptor paramName = let matchingParamName param = pName param == paramName additionalParams = map AdditionalParam $ filter matchingParamName (cmdAdditionalParams cmdDescriptor) @@ -150,4 +143,11 @@ validatePlugins plugins = } formatParamNameCollisionErrorMsg :: [ParamCollision] -> String -formatParamNameCollisionErrorMsg = show -- TODO +formatParamNameCollisionErrorMsg paramCollisions = + "Error: Parameter name collision in plugin description\n" ++ + "Parameter names must be unique for each command. The following collisions were found:\n" ++ + concatMap (\(ParamCollision plId cmd paramName occurences) -> + ("In " ++ show plId ++ ":" ++ show cmd ++ " the parameter " ++ show paramName ++ " is defined in:\n" ++ unlines (map formatOccurence occurences))) + paramCollisions + where formatOccurence (AdditionalParam paramDesc) = " cmdAdditionalParams = " ++ show paramDesc + formatOccurence (ContextParam paramDesc accContext) = " cmdContexts = [" ++ show accContext ++ "]: " ++ show paramDesc diff --git a/test/PluginUtilsSpec.hs b/test/PluginUtilsSpec.hs index 9aeee31fd..8027f8af1 100644 --- a/test/PluginUtilsSpec.hs +++ b/test/PluginUtilsSpec.hs @@ -25,53 +25,91 @@ pluginUtilsSpec = do it "reports collisions for plugins with parameter name collisions" $ do fmap pdeCollisions (validatePlugins pluginsWithCollisions) `shouldBe` Just - [ ParamCollision - (ParamLocation "plugin1" "cmd1" "file") - (AdditionalParam + [ ParamCollision "plugin1" "cmd1" "file" + [ AdditionalParam + RP + { pName = "file" + , pHelp = "shoud collide" + , pType = PtText + } + , ContextParam fileParam CtxRegion + ] + , ParamCollision "plugin1" "cmd2" "end_pos" + [ AdditionalParam + RP + { pName = "end_pos" + , pHelp = "shoud collide" + , pType = PtText + } + , ContextParam endPosParam CtxRegion + ] + , ParamCollision "plugin1" "cmd3" "a" + [ AdditionalParam + RP + { pName = "a" + , pHelp = "shoud collide" + , pType = PtText + } + , AdditionalParam + OP + { pName = "a" + , pHelp = "shoud collide" + , pType = PtText + } + , AdditionalParam + OP + { pName = "a" + , pHelp = "shoud collide" + , pType = PtText + } + ] + , ParamCollision "plugin1" "cmd3" "b" + [ AdditionalParam RP - { pName = "file" + { pName = "b" , pHelp = "shoud collide" , pType = PtText - }) - , ParamCollision - (ParamLocation "plugin1" "cmd1" "file") - (ContextParam fileParam CtxRegion) - ] -{- - ("plugin1", - [ - ("cmd1", [("file", [ fileParam - , RP - { pName = "file" - , pHelp = "shoud collide" - , pType = PtText - } - ])]) - , ("cmd2", [("end_pos", [ endPosParam - , RP - { pName = "end_pos" - , pHelp = "shoud collide" - , pType = PtText - } - ])]) - , ("cmd3", [ ("a", []) - , ("b", [])]) - ] - ) - , ("plugin2", - [ - ("cmd1", [("file", [])]) - ] - ) + } + , AdditionalParam + RP + { pName = "b" + , pHelp = "shoud collide" + , pType = PtText + } + ] + , ParamCollision "plugin2" "cmd1" "file" + [ AdditionalParam + RP + { pName = "file" + , pHelp = "shoud collide" + , pType = PtText + } + , ContextParam fileParam CtxRegion + , ContextParam fileParam CtxPoint + ] ] --} it "pretty prints the error message" $ do fmap pdeErrorMsg (validatePlugins pluginsWithCollisions) `shouldBe` Just ( - "In plugin \"plugin1\" the command \"cmd1\" has multiple parameters named \"file\"" ++ - "\nIn plugin \"plugin1\" the command \"cmd2\" has multiple parameters named \"end_pos\"" ++ - "\nIn plugin \"plugin1\" the command \"cmd3\" has multiple parameters named \"a\", \"b\"" ++ - "\nIn plugin \"plugin2\" the command \"cmd1\" has multiple parameters named \"file\"" + "Error: Parameter name collision in plugin description\n"++ + "Parameter names must be unique for each command. The following collisions were found:\n" ++ + "In \"plugin1\":\"cmd1\" the parameter \"file\" is defined in:\n" ++ + " cmdAdditionalParams = RP {pName = \"file\", pHelp = \"shoud collide\", pType = PtText}\n"++ + " cmdContexts = [CtxRegion]: RP {pName = \"file\", pHelp = \"a file name\", pType = PtFile}\n"++ + "In \"plugin1\":\"cmd2\" the parameter \"end_pos\" is defined in:\n"++ + " cmdAdditionalParams = RP {pName = \"end_pos\", pHelp = \"shoud collide\", pType = PtText}\n"++ + " cmdContexts = [CtxRegion]: RP {pName = \"end_pos\", pHelp = \"end line and col\", pType = PtPos}\n"++ + "In \"plugin1\":\"cmd3\" the parameter \"a\" is defined in:\n"++ + " cmdAdditionalParams = RP {pName = \"a\", pHelp = \"shoud collide\", pType = PtText}\n"++ + " cmdAdditionalParams = OP {pName = \"a\", pHelp = \"shoud collide\", pType = PtText}\n"++ + " cmdAdditionalParams = OP {pName = \"a\", pHelp = \"shoud collide\", pType = PtText}\n"++ + "In \"plugin1\":\"cmd3\" the parameter \"b\" is defined in:\n"++ + " cmdAdditionalParams = RP {pName = \"b\", pHelp = \"shoud collide\", pType = PtText}\n"++ + " cmdAdditionalParams = RP {pName = \"b\", pHelp = \"shoud collide\", pType = PtText}\n"++ + "In \"plugin2\":\"cmd1\" the parameter \"file\" is defined in:\n"++ + " cmdAdditionalParams = RP {pName = \"file\", pHelp = \"shoud collide\", pType = PtText}\n"++ + " cmdContexts = [CtxRegion]: RP {pName = \"file\", pHelp = \"a file name\", pType = PtFile}\n"++ + " cmdContexts = [CtxPoint]: RP {pName = \"file\", pHelp = \"a file name\", pType = PtFile}\n" ) @@ -85,7 +123,7 @@ pluginsWithCollisions = Map.fromList [("plugin1", PluginDescriptor { cmdName = "cmd1" , cmdUiDescription = "" , cmdFileExtensions = [] - , cmdContexts = [CtxRegion, CtxPoint] -- ["file", "start_pos", "file", "start_pos", "end_pos"] + , cmdContexts = [CtxRegion] -- ["file", "start_pos", "file", "start_pos", "end_pos"] , cmdAdditionalParams = [ RP @@ -191,6 +229,41 @@ pluginsWithCollisions = Map.fromList [("plugin1", PluginDescriptor } , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) } + , Command + { cmdDesc = CommandDesc + { cmdName = "cmd2" + , cmdUiDescription = "" + , cmdFileExtensions = [] + , cmdContexts = [] -- ["file", "start_pos", "file", "start_pos", "end_pos"] + , cmdAdditionalParams = + [ + RP + { pName = "uniqueParamName1" + , pHelp = "shoud not collide" + , pType = PtText + } + ] + } + , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) + } + ] + , pdExposedServices = [] + , pdUsedServices = [] + }) + , ("plugin3", PluginDescriptor + { + pdCommands = + [ + Command + { cmdDesc = CommandDesc + { cmdName = "cmd1" + , cmdUiDescription = "" + , cmdFileExtensions = [] + , cmdContexts = [CtxRegion, CtxPoint] -- ["file", "start_pos", "file", "start_pos", "end_pos"] + , cmdAdditionalParams = [] + } + , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) + } ] , pdExposedServices = [] , pdUsedServices = [] From 71a6bd3680afd9c9eb8970f4282562d86f360bf8 Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Mon, 30 Nov 2015 08:13:57 +0100 Subject: [PATCH 18/21] wip: update DispatcherSpec --- test/DispatcherSpec.hs | 52 ++++++++++++++++------------------------- test/PluginUtilsSpec.hs | 15 ++++++++++++ 2 files changed, 35 insertions(+), 32 deletions(-) diff --git a/test/DispatcherSpec.hs b/test/DispatcherSpec.hs index 6159eea11..567eb33c7 100644 --- a/test/DispatcherSpec.hs +++ b/test/DispatcherSpec.hs @@ -256,38 +256,26 @@ testPluginWithParamNameCollison :: Plugins testPluginWithParamNameCollison = Map.fromList [("plugin1", PluginDescriptor { pdCommands = - [ - Command - { cmdDesc = CommandDesc - { cmdName = "cmd1" - , cmdUiDescription = "description" - , cmdFileExtensions = [] - , cmdContexts = [CtxRegion, CtxPoint] -- ["file", "start_pos", "file", "start_pos", "end_pos"] - , cmdAdditionalParams = - [ - RP - { pName = "nonUniqueParamName" - , pHelp = "" - , pType = PtText - } - , RP - { pName = "uniqueParamName" - , pHelp = "shoud not collide" - , pType = PtText - } - , RP - { pName = "nonUniqueParamName" - , pHelp = "should collide with the first param" - , pType = PtText - } - , OP - { pName = "end_pos" - , pHelp = "this should collide with CtxPoint from cmdContext" - , pType = PtText - } - ] - } - , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) + [ mkCmdWithContext "cmd1" [CtxRegion, CtxPoint] [ + RP + { pName = "nonUniqueParamName" + , pHelp = "" + , pType = PtText + } + , RP + { pName = "uniqueParamName" + , pHelp = "shoud not collide" + , pType = PtText + } + , RP + { pName = "nonUniqueParamName" + , pHelp = "should collide with the first param" + , pType = PtText + } + , OP + { pName = "end_pos" + , pHelp = "this should collide with CtxPoint from cmdContext" + , pType = PtText } ] , pdExposedServices = [] diff --git a/test/PluginUtilsSpec.hs b/test/PluginUtilsSpec.hs index 8027f8af1..34e2f7335 100644 --- a/test/PluginUtilsSpec.hs +++ b/test/PluginUtilsSpec.hs @@ -123,6 +123,7 @@ pluginsWithCollisions = Map.fromList [("plugin1", PluginDescriptor { cmdName = "cmd1" , cmdUiDescription = "" , cmdFileExtensions = [] + , cmdReturnType = "" , cmdContexts = [CtxRegion] -- ["file", "start_pos", "file", "start_pos", "end_pos"] , cmdAdditionalParams = [ @@ -145,6 +146,7 @@ pluginsWithCollisions = Map.fromList [("plugin1", PluginDescriptor { cmdName = "cmd2" , cmdUiDescription = "" , cmdFileExtensions = [] + , cmdReturnType = "" , cmdContexts = [CtxRegion] , cmdAdditionalParams = [ @@ -167,6 +169,7 @@ pluginsWithCollisions = Map.fromList [("plugin1", PluginDescriptor { cmdName = "cmd3" , cmdUiDescription = "" , cmdFileExtensions = [] + , cmdReturnType = "" , cmdContexts = [] -- ["file", "start_pos", "file", "start_pos", "end_pos"] , cmdAdditionalParams = [ @@ -202,6 +205,8 @@ pluginsWithCollisions = Map.fromList [("plugin1", PluginDescriptor ] , pdExposedServices = [] , pdUsedServices = [] + , pdUIShortName = "" + , pdUIOverview = "" }) , ("plugin2", PluginDescriptor { @@ -212,6 +217,7 @@ pluginsWithCollisions = Map.fromList [("plugin1", PluginDescriptor { cmdName = "cmd1" , cmdUiDescription = "" , cmdFileExtensions = [] + , cmdReturnType = "" , cmdContexts = [CtxRegion, CtxPoint] -- ["file", "start_pos", "file", "start_pos", "end_pos"] , cmdAdditionalParams = [ @@ -234,6 +240,7 @@ pluginsWithCollisions = Map.fromList [("plugin1", PluginDescriptor { cmdName = "cmd2" , cmdUiDescription = "" , cmdFileExtensions = [] + , cmdReturnType = "" , cmdContexts = [] -- ["file", "start_pos", "file", "start_pos", "end_pos"] , cmdAdditionalParams = [ @@ -249,6 +256,8 @@ pluginsWithCollisions = Map.fromList [("plugin1", PluginDescriptor ] , pdExposedServices = [] , pdUsedServices = [] + , pdUIShortName = "" + , pdUIOverview = "" }) , ("plugin3", PluginDescriptor { @@ -259,6 +268,7 @@ pluginsWithCollisions = Map.fromList [("plugin1", PluginDescriptor { cmdName = "cmd1" , cmdUiDescription = "" , cmdFileExtensions = [] + , cmdReturnType = "" , cmdContexts = [CtxRegion, CtxPoint] -- ["file", "start_pos", "file", "start_pos", "end_pos"] , cmdAdditionalParams = [] } @@ -267,6 +277,8 @@ pluginsWithCollisions = Map.fromList [("plugin1", PluginDescriptor ] , pdExposedServices = [] , pdUsedServices = [] + , pdUIShortName = "" + , pdUIOverview = "" }) ] @@ -281,6 +293,7 @@ pluginsWithoutCollisions = Map.fromList [("plugin1", PluginDescriptor { cmdName = "cmd1" , cmdUiDescription = "description" , cmdFileExtensions = [] + , cmdReturnType = "" , cmdContexts = [CtxRegion, CtxPoint] -- ["file", "start_pos", "file", "start_pos", "end_pos"] , cmdAdditionalParams = [ @@ -301,4 +314,6 @@ pluginsWithoutCollisions = Map.fromList [("plugin1", PluginDescriptor ] , pdExposedServices = [] , pdUsedServices = [] + , pdUIShortName = "" + , pdUIOverview = "" })] From d2ec061d78d36652a02411fd70110122ad937af7 Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Mon, 30 Nov 2015 22:00:00 +0100 Subject: [PATCH 19/21] updated tests in DispatcherSpec --- test/DispatcherSpec.hs | 50 +++++++++++++++++++++++------------------- 1 file changed, 27 insertions(+), 23 deletions(-) diff --git a/test/DispatcherSpec.hs b/test/DispatcherSpec.hs index 567eb33c7..a30481852 100644 --- a/test/DispatcherSpec.hs +++ b/test/DispatcherSpec.hs @@ -255,29 +255,33 @@ dispatcherSpec = do testPluginWithParamNameCollison :: Plugins testPluginWithParamNameCollison = Map.fromList [("plugin1", PluginDescriptor { - pdCommands = - [ mkCmdWithContext "cmd1" [CtxRegion, CtxPoint] [ - RP - { pName = "nonUniqueParamName" - , pHelp = "" - , pType = PtText - } - , RP - { pName = "uniqueParamName" - , pHelp = "shoud not collide" - , pType = PtText - } - , RP - { pName = "nonUniqueParamName" - , pHelp = "should collide with the first param" - , pType = PtText - } - , OP - { pName = "end_pos" - , pHelp = "this should collide with CtxPoint from cmdContext" - , pType = PtText - } - ] + pdUIShortName = "testDescriptor" + , pdUIOverview = "PluginDescriptor with parameter name collisions" + , pdCommands = + [ mkCmdWithContext "cmd1" [CtxRegion, CtxPoint] + [ + RP + { pName = "nonUniqueParamName" + , pHelp = "" + , pType = PtText + } + , RP + { pName = "uniqueParamName" + , pHelp = "shoud not collide" + , pType = PtText + } + , RP + { pName = "nonUniqueParamName" + , pHelp = "should collide with the first param" + , pType = PtText + } + , OP + { pName = "end_pos" + , pHelp = "this should collide with CtxPoint from cmdContext" + , pType = PtText + } + ] + ] , pdExposedServices = [] , pdUsedServices = [] })] From 07391ddfb8951f44f5b98e0d2db93efa839a7593 Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Tue, 1 Dec 2015 21:52:01 +0100 Subject: [PATCH 20/21] moved validatePlugin to a separate module (Haskell.Ide.Engine.Utils). Perform validation in main, before the dispatcher runs --- app/MainHie.hs | 6 +- haskell-ide-engine.cabal | 3 +- .../Haskell/Ide/Engine/PluginUtils.hs | 69 ----------------- src/Haskell/Ide/Engine/Monad.hs | 4 - src/Haskell/Ide/Engine/Utils.hs | 77 +++++++++++++++++++ test/DispatcherSpec.hs | 41 ---------- test/{PluginUtilsSpec.hs => UtilsSpec.hs} | 4 +- 7 files changed, 86 insertions(+), 118 deletions(-) create mode 100644 src/Haskell/Ide/Engine/Utils.hs rename test/{PluginUtilsSpec.hs => UtilsSpec.hs} (99%) diff --git a/app/MainHie.hs b/app/MainHie.hs index 78d842f72..61c3ef818 100644 --- a/app/MainHie.hs +++ b/app/MainHie.hs @@ -22,6 +22,7 @@ import Haskell.Ide.Engine.Monad import Haskell.Ide.Engine.MonadFunctions import Haskell.Ide.Engine.Options import Haskell.Ide.Engine.PluginDescriptor +import Haskell.Ide.Engine.Utils import Haskell.Ide.Engine.Transport.JsonHttp import Haskell.Ide.Engine.Transport.JsonStdio import Haskell.Ide.Engine.Types @@ -110,6 +111,10 @@ run opts = do -- log $ T.pack $ "replPluginInfo:" ++ show replPluginInfo + case validatePlugins plugins of + Just err -> error (pdeErrorMsg err) + Nothing -> return () + -- launch the dispatcher. _ <- forkIO (runIdeM (IdeState plugins) (dispatcher cin)) @@ -142,4 +147,3 @@ getUserHomeDirectory = do -- whatever it takes. listener :: TChan ChannelRequest -> IO () listener = assert False undefined - diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index 68b799244..d41ba1f85 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -24,6 +24,7 @@ library Haskell.Ide.Engine.Transport.JsonHttp Haskell.Ide.Engine.Transport.JsonStdio Haskell.Ide.Engine.Types + Haskell.Ide.Engine.Utils other-modules: Paths_haskell_ide_engine build-depends: Cabal >= 1.22 , aeson @@ -97,7 +98,7 @@ test-suite haskell-ide-test HaRePluginSpec JsonStdioSpec JsonSpec - PluginUtilsSpec + UtilsSpec build-depends: base , aeson , containers diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index 3d3d55883..bf36396c0 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -9,10 +9,6 @@ module Haskell.Ide.Engine.PluginUtils , mapEithers , missingParameter , incorrectParameter - , validatePlugins - , PluginDescriptionError(..) - , ParamCollision(..) - , ParamOccurence(..) ) where import Data.Aeson @@ -86,68 +82,3 @@ incorrectParameter name expected value = IdeResponseFail T.pack (show expected) <>" , got:" <> T.pack (show value)) (Just $ object ["param" .= toJSON name,"expected".= toJSON (show expected), "value" .= toJSON (show value)])) - - --- --------------------------------------------------------------------- - -data ParamCollision = ParamCollision PluginId CommandName ParamName [ParamOccurence] deriving (Eq, Show) -data ParamOccurence = AdditionalParam ParamDescription - | ContextParam ParamDescription AcceptedContext - deriving (Eq, Show) - -paramNameCollisions :: Plugins -> [ParamCollision] -paramNameCollisions plugins = - concatMap (\(plId, plDesc) -> - concatMap (paramNameCollisionsForCmd plId . cmdDesc) (pdCommands plDesc)) (Map.toList plugins) - -paramNameCollisionsForCmd :: PluginId -> CommandDescriptor -> [ParamCollision] -paramNameCollisionsForCmd plId cmdDescriptor = - let collidingParamNames = findCollidingParamNames cmdDescriptor - collisionSources = map (\param -> ParamCollision plId (cmdName cmdDescriptor) param (paramsByName cmdDescriptor param)) collidingParamNames - in collisionSources - --- find all the parameters within the CommandDescriptor that goes by the given ParamName -paramsByName :: CommandDescriptor -> ParamName -> [ParamOccurence] -paramsByName cmdDescriptor paramName = - let matchingParamName param = pName param == paramName - additionalParams = map AdditionalParam $ filter matchingParamName (cmdAdditionalParams cmdDescriptor) - cmdContextParams = concatMap - (\accContext -> map - (\param -> (param, accContext)) - (contextMapping accContext)) - (cmdContexts cmdDescriptor) - cmdContextParamsWithCollisions = map (uncurry ContextParam) $ filter (\(param, _) -> matchingParamName param) cmdContextParams - in additionalParams ++ cmdContextParamsWithCollisions - -findCollidingParamNames :: CommandDescriptor -> [ParamName] -findCollidingParamNames cmdDescriptor = - let cmdContextPNames = nub $ concatMap (map pName . contextMapping) (cmdContexts cmdDescriptor) -- collisions within AcceptedContext should not count - additionalPNames = map pName (cmdAdditionalParams cmdDescriptor) - allPNames = cmdContextPNames ++ additionalPNames - uniquePNames = nub allPNames - in nub (allPNames \\ uniquePNames) - -data PluginDescriptionError = - PluginDescriptionError { - pdeCollisions :: [ParamCollision] - , pdeErrorMsg :: String - } deriving (Eq, Show) - -validatePlugins :: Plugins -> Maybe PluginDescriptionError -validatePlugins plugins = - case paramNameCollisions plugins of - [] -> Nothing - collisions -> Just PluginDescriptionError { - pdeCollisions = collisions - , pdeErrorMsg = formatParamNameCollisionErrorMsg collisions - } - -formatParamNameCollisionErrorMsg :: [ParamCollision] -> String -formatParamNameCollisionErrorMsg paramCollisions = - "Error: Parameter name collision in plugin description\n" ++ - "Parameter names must be unique for each command. The following collisions were found:\n" ++ - concatMap (\(ParamCollision plId cmd paramName occurences) -> - ("In " ++ show plId ++ ":" ++ show cmd ++ " the parameter " ++ show paramName ++ " is defined in:\n" ++ unlines (map formatOccurence occurences))) - paramCollisions - where formatOccurence (AdditionalParam paramDesc) = " cmdAdditionalParams = " ++ show paramDesc - formatOccurence (ContextParam paramDesc accContext) = " cmdContexts = [" ++ show accContext ++ "]: " ++ show paramDesc diff --git a/src/Haskell/Ide/Engine/Monad.hs b/src/Haskell/Ide/Engine/Monad.hs index be02958b9..581db6a2a 100644 --- a/src/Haskell/Ide/Engine/Monad.hs +++ b/src/Haskell/Ide/Engine/Monad.hs @@ -15,7 +15,6 @@ import Control.Monad.State import Data.IORef import Exception import Haskell.Ide.Engine.PluginDescriptor -import Haskell.Ide.Engine.PluginUtils import qualified Language.Haskell.GhcMod.Monad as GM import qualified Language.Haskell.GhcMod.Types as GM import System.Directory @@ -47,9 +46,6 @@ data IdeState = IdeState runIdeM :: IdeState -> IdeM a -> IO a runIdeM initState f = do - case validatePlugins (idePlugins initState) of - Just err -> error (pdeErrorMsg err) - Nothing -> return () initializedRef <- newIORef False let inner' = GM.runGmOutT opts $ GM.runGhcModT opts $ do liftIO $ writeIORef initializedRef True diff --git a/src/Haskell/Ide/Engine/Utils.hs b/src/Haskell/Ide/Engine/Utils.hs new file mode 100644 index 000000000..2f91db0bd --- /dev/null +++ b/src/Haskell/Ide/Engine/Utils.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Haskell.Ide.Engine.Utils + ( + validatePlugins + , PluginDescriptionError(..) + , ParamCollision(..) + , ParamOccurence(..) + ) where + +import Data.List +import Haskell.Ide.Engine.PluginDescriptor +import qualified Data.Map as Map + +-- |For all the plugins, validate that parameter names are unique within each +-- command. Otherwise return an error, describing the collisions. +validatePlugins :: Plugins -> Maybe PluginDescriptionError +validatePlugins plugins = + case paramNameCollisions plugins of + [] -> Nothing + collisions -> Just PluginDescriptionError { + pdeCollisions = collisions + , pdeErrorMsg = formatParamNameCollisionErrorMsg collisions + } + +data PluginDescriptionError = + PluginDescriptionError { + pdeCollisions :: [ParamCollision] + , pdeErrorMsg :: String + } deriving (Eq, Show) + +data ParamCollision = ParamCollision PluginId CommandName ParamName [ParamOccurence] deriving (Eq, Show) +data ParamOccurence = AdditionalParam ParamDescription + | ContextParam ParamDescription AcceptedContext + deriving (Eq, Show) + +paramNameCollisions :: Plugins -> [ParamCollision] +paramNameCollisions plugins = + concatMap (\(plId, plDesc) -> + concatMap (paramNameCollisionsForCmd plId . cmdDesc) (pdCommands plDesc)) (Map.toList plugins) + +paramNameCollisionsForCmd :: PluginId -> CommandDescriptor -> [ParamCollision] +paramNameCollisionsForCmd plId cmdDescriptor = + let collidingParamNames = findCollidingParamNames cmdDescriptor + collisionSources = map (\param -> ParamCollision plId (cmdName cmdDescriptor) param (paramsByName cmdDescriptor param)) collidingParamNames + in collisionSources + +-- |Find all the parameters within the CommandDescriptor that goes by the given ParamName +paramsByName :: CommandDescriptor -> ParamName -> [ParamOccurence] +paramsByName cmdDescriptor paramName = + let matchingParamName param = pName param == paramName + additionalParams = map AdditionalParam $ filter matchingParamName (cmdAdditionalParams cmdDescriptor) + cmdContextParams = concatMap + (\accContext -> map + (\param -> (param, accContext)) + (contextMapping accContext)) + (cmdContexts cmdDescriptor) + cmdContextParamsWithCollisions = map (uncurry ContextParam) $ filter (\(param, _) -> matchingParamName param) cmdContextParams + in additionalParams ++ cmdContextParamsWithCollisions + +findCollidingParamNames :: CommandDescriptor -> [ParamName] +findCollidingParamNames cmdDescriptor = + let cmdContextPNames = nub $ concatMap (map pName . contextMapping) (cmdContexts cmdDescriptor) -- collisions within AcceptedContext should not count + additionalPNames = map pName (cmdAdditionalParams cmdDescriptor) + allPNames = cmdContextPNames ++ additionalPNames + uniquePNames = nub allPNames + in nub (allPNames \\ uniquePNames) + +formatParamNameCollisionErrorMsg :: [ParamCollision] -> String +formatParamNameCollisionErrorMsg paramCollisions = + "Error: Parameter name collision in plugin description\n" ++ + "Parameter names must be unique for each command. The following collisions were found:\n" ++ + concatMap (\(ParamCollision plId cmd paramName occurences) -> + ("In " ++ show plId ++ ":" ++ show cmd ++ " the parameter " ++ show paramName ++ " is defined in:\n" ++ unlines (map formatOccurence occurences))) + paramCollisions + where formatOccurence (AdditionalParam paramDesc) = " cmdAdditionalParams = " ++ show paramDesc + formatOccurence (ContextParam paramDesc accContext) = " cmdContexts = [" ++ show accContext ++ "]: " ++ show paramDesc diff --git a/test/DispatcherSpec.hs b/test/DispatcherSpec.hs index a30481852..11ccff65d 100644 --- a/test/DispatcherSpec.hs +++ b/test/DispatcherSpec.hs @@ -38,13 +38,6 @@ spec = do dispatcherSpec :: Spec dispatcherSpec = do - describe "checking plugins on startup" $ do - - it "exits with an error if any command has a parameter name collision" $ do - runIdeM (IdeState testPluginWithParamNameCollison) undefined `shouldThrow` anyErrorCall - - -- --------------------------------- - describe "checking contexts" $ do it "identifies CtxNone" $ do @@ -252,40 +245,6 @@ dispatcherSpec = do -- --------------------------------------------------------------------- -testPluginWithParamNameCollison :: Plugins -testPluginWithParamNameCollison = Map.fromList [("plugin1", PluginDescriptor - { - pdUIShortName = "testDescriptor" - , pdUIOverview = "PluginDescriptor with parameter name collisions" - , pdCommands = - [ mkCmdWithContext "cmd1" [CtxRegion, CtxPoint] - [ - RP - { pName = "nonUniqueParamName" - , pHelp = "" - , pType = PtText - } - , RP - { pName = "uniqueParamName" - , pHelp = "shoud not collide" - , pType = PtText - } - , RP - { pName = "nonUniqueParamName" - , pHelp = "should collide with the first param" - , pType = PtText - } - , OP - { pName = "end_pos" - , pHelp = "this should collide with CtxPoint from cmdContext" - , pType = PtText - } - ] - ] - , pdExposedServices = [] - , pdUsedServices = [] - })] - testPlugins :: TChan () -> Plugins testPlugins chSync = Map.fromList [("test",testDescriptor chSync)] diff --git a/test/PluginUtilsSpec.hs b/test/UtilsSpec.hs similarity index 99% rename from test/PluginUtilsSpec.hs rename to test/UtilsSpec.hs index 34e2f7335..cc1adb6f1 100644 --- a/test/PluginUtilsSpec.hs +++ b/test/UtilsSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module PluginUtilsSpec where +module UtilsSpec where -import Haskell.Ide.Engine.PluginUtils +import Haskell.Ide.Engine.Utils import Haskell.Ide.Engine.PluginDescriptor import qualified Data.Map as Map From 2f5d6abf146a9db930ac5139da222035d0c9662f Mon Sep 17 00:00:00 2001 From: "Tobias G. Waaler" Date: Tue, 1 Dec 2015 22:01:12 +0100 Subject: [PATCH 21/21] reverted some uneccessary changes --- hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index bf36396c0..e1e9588df 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -13,8 +13,6 @@ module Haskell.Ide.Engine.PluginUtils import Data.Aeson -import Data.List -import Data.Maybe import Data.Monoid import Data.Vinyl import Haskell.Ide.Engine.PluginDescriptor @@ -65,7 +63,6 @@ mapEithers _ _ = Right [] -- --------------------------------------------------------------------- -- Helper functions for errors --- --------------------------------------------------------------------- -- Missing parameter error missingParameter :: forall r. (ValidResponse r) => ParamId -> IdeResponse r