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 5eee87275..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,6 +98,7 @@ test-suite haskell-ide-test HaRePluginSpec JsonStdioSpec JsonSpec + UtilsSpec build-depends: base , aeson , containers 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/UtilsSpec.hs b/test/UtilsSpec.hs new file mode 100644 index 000000000..cc1adb6f1 --- /dev/null +++ b/test/UtilsSpec.hs @@ -0,0 +1,319 @@ +{-# LANGUAGE OverloadedStrings #-} +module UtilsSpec where + +import Haskell.Ide.Engine.Utils +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 + +spec :: Spec +spec = do + describe "PluginUtils" pluginUtilsSpec + +pluginUtilsSpec :: Spec +pluginUtilsSpec = do + describe "validatePlugins" $ do + + it "accepts plugins without parameter name collisions" $ do + validatePlugins pluginsWithoutCollisions `shouldBe` Nothing + + it "reports collisions for plugins with parameter name collisions" $ do + fmap pdeCollisions (validatePlugins pluginsWithCollisions) `shouldBe` Just + [ 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 = "b" + , pHelp = "shoud collide" + , pType = PtText + } + , 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 ( + "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" + ) + + +pluginsWithCollisions :: Plugins +pluginsWithCollisions = Map.fromList [("plugin1", PluginDescriptor + { + pdCommands = + [ + Command + { cmdDesc = CommandDesc + { cmdName = "cmd1" + , cmdUiDescription = "" + , cmdFileExtensions = [] + , cmdReturnType = "" + , cmdContexts = [CtxRegion] -- ["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 = [] + , cmdReturnType = "" + , 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 = [] + , cmdReturnType = "" + , 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 = [] + , pdUIShortName = "" + , pdUIOverview = "" + }) + , ("plugin2", PluginDescriptor + { + pdCommands = + [ + Command + { cmdDesc = CommandDesc + { cmdName = "cmd1" + , cmdUiDescription = "" + , cmdFileExtensions = [] + , cmdReturnType = "" + , 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 = [] + , cmdReturnType = "" + , 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 = [] + , pdUIShortName = "" + , pdUIOverview = "" + }) + , ("plugin3", PluginDescriptor + { + pdCommands = + [ + Command + { cmdDesc = CommandDesc + { cmdName = "cmd1" + , cmdUiDescription = "" + , cmdFileExtensions = [] + , cmdReturnType = "" + , cmdContexts = [CtxRegion, CtxPoint] -- ["file", "start_pos", "file", "start_pos", "end_pos"] + , cmdAdditionalParams = [] + } + , cmdFunc = CmdSync $ \_ _ -> return (IdeResponseOk ("" :: T.Text)) + } + ] + , pdExposedServices = [] + , pdUsedServices = [] + , pdUIShortName = "" + , pdUIOverview = "" + }) + ] + + +pluginsWithoutCollisions :: Plugins +pluginsWithoutCollisions = Map.fromList [("plugin1", PluginDescriptor + { + pdCommands = + [ + Command + { cmdDesc = CommandDesc + { cmdName = "cmd1" + , cmdUiDescription = "description" + , cmdFileExtensions = [] + , cmdReturnType = "" + , 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 = [] + , pdUIShortName = "" + , pdUIOverview = "" + })]