CommandName -> CommandId, make that and PluginId newtypes

We definitely do not want to get those mixed up with plain old texts

Author: lukel97

hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs

@@ -24,8 +24,8 @@ module Haskell.Ide.Engine.PluginsIdeMonads
  , allLspCmdIds
  , mkLspCmdId
  -- * Plugins
- , PluginId
- , CommandName
+ , PluginId(..)
+ , CommandId(..)
  , PluginDescriptor(..)
  , pluginDescToIdePlugins
  , PluginCommand(..)
@@ -105,6 +105,7 @@ import UnliftIO
 import Control.Applicative
 
 import Data.Aeson hiding (defaultOptions)
+import Data.Coerce
 import qualified Data.ConstrainedDynamic as CD
 import Data.Default
 import qualified Data.List as List
@@ -113,6 +114,7 @@ import qualified Data.Map as Map
 import Data.Maybe
 import Data.Monoid ( (<>) )
 import qualified Data.Set as S
+import Data.String
 import qualified Data.Text as T
 import Data.Typeable ( TypeRep
  , Typeable
@@ -175,7 +177,7 @@ instance HasPidCache IO where
 instance HasPidCache m => HasPidCache (IdeResultT m) where
  getPidCache = lift getPidCache
 
-mkLspCommand :: HasPidCache m => PluginId -> CommandName -> T.Text -> Maybe [Value] -> m Command
+mkLspCommand :: HasPidCache m => PluginId -> CommandId -> T.Text -> Maybe [Value] -> m Command
 mkLspCommand plid cn title args' = do
  cmdId <- mkLspCmdId plid cn
  let args = List <$> args'
@@ -184,12 +186,12 @@ mkLspCommand plid cn title args' = do
 allLspCmdIds :: HasPidCache m => IdePlugins -> m [T.Text]
 allLspCmdIds (IdePlugins m) = concat <$> mapM go (Map.toList (pluginCommands <$> m))
  where
- go (plid, cmds) = mapM (mkLspCmdId plid . commandName) cmds
+ go (plid, cmds) = mapM (mkLspCmdId plid . commandId) cmds
 
-mkLspCmdId :: HasPidCache m => PluginId -> CommandName -> m T.Text
-mkLspCmdId plid cn = do
+mkLspCmdId :: HasPidCache m => PluginId -> CommandId -> m T.Text
+mkLspCmdId plid cid = do
  pid <- T.pack . show <$> getPidCache
- return $ pid <> ":" <> plid <> ":" <> cn
+ return $ pid <> ":" <> coerce plid <> ":" <> coerce cid
 
 -- ---------------------------------------------------------------------
 -- Plugins
@@ -260,6 +262,11 @@ type FormattingProvider = T.Text -- ^ Text to format
  -> FormattingOptions -- ^ Options for the formatter
  -> IdeM (IdeResult [TextEdit]) -- ^ Result of the formatting or the unchanged text.
 
+newtype PluginId = PluginId T.Text
+ deriving (Show, Read, Eq, Ord)
+instance IsString PluginId where
+ fromString = PluginId . T.pack
+
 data PluginDescriptor =
  PluginDescriptor { pluginId :: PluginId
  , pluginCommands :: [PluginCommand]
@@ -271,13 +278,15 @@ data PluginDescriptor =
  } deriving (Generic)
 
 instance Show PluginCommand where
- show (PluginCommand name _) = "PluginCommand { name = " ++ T.unpack name ++ " }"
+ show (PluginCommand i _) = "PluginCommand { name = " ++ show i ++ " }"
 
-type PluginId = T.Text
-type CommandName = T.Text
+newtype CommandId = CommandId T.Text
+ deriving (Show, Read, Eq, Ord)
+instance IsString CommandId where
+ fromString = CommandId . T.pack
 
 data PluginCommand = forall a b. (FromJSON a, ToJSON b, Typeable b) =>
- PluginCommand { commandName :: CommandName
+ PluginCommand { commandId :: CommandId
  , commandFunc :: a -> IdeGhcM (IdeResult b)
  }
 
@@ -295,21 +304,21 @@ fromDynJSON = CD.fromDynamic
 toDynJSON :: (Typeable a, ToJSON a) => a -> DynamicJSON
 toDynJSON = CD.toDyn
 
--- | Runs a plugin command given a PluginId, CommandName and
+-- | Runs a plugin command given a PluginId, CommandId and
 -- arguments in the form of a JSON object.
-runPluginCommand :: PluginId -> CommandName -> Value
+runPluginCommand :: PluginId -> CommandId -> Value
  -> IdeGhcM (IdeResult DynamicJSON)
 runPluginCommand p com arg = do
  IdePlugins m <- getPlugins
  case Map.lookup p m of
  Nothing -> return $
- IdeResultFail $ IdeError UnknownPlugin ("Plugin " <> p <> " doesn't exist") Null
- Just PluginDescriptor { pluginCommands = xs } -> case List.find ((com ==) . commandName) xs of
+ IdeResultFail $ IdeError UnknownPlugin ("Plugin " <> coerce p <> " doesn't exist") Null
+ Just PluginDescriptor { pluginCommands = xs } -> case List.find ((com ==) . commandId) xs of
  Nothing -> return $ IdeResultFail $
- IdeError UnknownCommand ("Command " <> com <> " isn't defined for plugin " <> p <> ". Legal commands are: " <> T.pack(show $ map commandName xs)) Null
+ IdeError UnknownCommand ("Command " <> coerce com <> " isn't defined for plugin " <> coerce p <> ". Legal commands are: " <> T.pack(show $ map commandId xs)) Null
  Just (PluginCommand _ f) -> case fromJSON arg of
  Error err -> return $ IdeResultFail $
- IdeError ParameterError ("error while parsing args for " <> com <> " in plugin " <> p <> ": " <> T.pack err) Null
+ IdeError ParameterError ("error while parsing args for " <> coerce com <> " in plugin " <> coerce p <> ": " <> T.pack err) Null
  Success a -> do
  res <- f a
  return $ fmap toDynJSON res
@@ -319,11 +328,6 @@ newtype IdePlugins = IdePlugins
  { ipMap :: Map.Map PluginId PluginDescriptor
  } deriving (Generic)
 
--- TODO:AZ this is a defective instance, do we actually need it?
--- Perhaps rather make a separate type explicitly for this purpose.
-instance ToJSON IdePlugins where
- toJSON (IdePlugins m) = toJSON $ fmap commandName <$> fmap pluginCommands m
-
 -- | For the diagnostic providers in the config, return a map of
 -- current enabled state, indexed by the plugin id.
 getDiagnosticProvidersConfig :: Config -> Map.Map PluginId Bool

src/Haskell/Ide/Engine/Plugin/Package.hs

@@ -50,7 +50,7 @@ import Distribution.Types.CondTree
 import qualified Distribution.PackageDescription.PrettyPrint as PP
 import qualified Data.Yaml as Y
 
-packageDescriptor :: T.Text -> PluginDescriptor
+packageDescriptor :: PluginId -> PluginDescriptor
 packageDescriptor plId = PluginDescriptor
  { pluginId = plId
  , pluginCommands = [PluginCommand "add" addCmd]

src/Haskell/Ide/Engine/Server.hs

@@ -558,10 +558,10 @@ reactor inp diagIn = do
 
  let params = req ^. J.params
 
- parseCmdId :: T.Text -> Maybe (T.Text, T.Text)
+ parseCmdId :: T.Text -> Maybe (PluginId, CommandId)
  parseCmdId x = case T.splitOn ":" x of
- [plugin, command] -> Just (plugin, command)
- [_, plugin, command] -> Just (plugin, command)
+ [plugin, command] -> Just (PluginId plugin, CommandId command)
+ [_, plugin, command] -> Just (PluginId plugin, CommandId command)
  _ -> Nothing
 
  callback obj = do
@@ -854,22 +854,23 @@ requestDiagnostics DiagnosticsRequest{trigger, file, trackingNumber, documentVer
  forM_ dss $ \(pid,ds) -> do
  debugm $ "requestDiagnostics: calling diagFunc for plugin:" ++ show pid
  let
+ pid' = coerce pid
  enabled = Map.findWithDefault True pid dpsEnabled
  publishDiagnosticsIO = Core.publishDiagnosticsFunc lf
  maxToSend = maxNumberOfProblems clientConfig
  sendOne (fileUri,ds') = do
  debugm $ "LspStdio.sendone:(fileUri,ds')=" ++ show(fileUri,ds')
- publishDiagnosticsIO maxToSend (J.toNormalizedUri fileUri) Nothing (Map.fromList [(Just pid,SL.toSortedList ds')])
+ publishDiagnosticsIO maxToSend (J.toNormalizedUri fileUri) Nothing (Map.fromList [(Just pid',SL.toSortedList ds')])
 
  sendEmpty = do
  debugm "LspStdio.sendempty"
- publishDiagnosticsIO maxToSend (J.toNormalizedUri file) Nothing (Map.fromList [(Just pid,SL.toSortedList [])])
+ publishDiagnosticsIO maxToSend (J.toNormalizedUri file) Nothing (Map.fromList [(Just pid',SL.toSortedList [])])
 
  -- fv = case documentVersion of
  -- Nothing -> Nothing
  -- Just v -> Just (file,v)
  -- let fakeId = J.IdString "fake,remove" -- TODO:AZ: IReq should take a Maybe LspId
- let fakeId = J.IdString ("fake,remove:pid=" <> pid) -- TODO:AZ: IReq should take a Maybe LspId
+ let fakeId = J.IdString ("fake,remove:pid=" <> pid') -- TODO:AZ: IReq should take a Maybe LspId
  let reql = case ds of
  DiagnosticProviderSync dps ->
  IReq trackingNumber "diagnostics" fakeId callbackl

src/Haskell/Ide/Engine/Support/HieExtras.hs

@@ -436,7 +436,7 @@ splitCaseCmd' uri newPos =
 getFormattingPlugin :: Config -> IdePlugins -> Maybe (PluginDescriptor, FormattingProvider)
 getFormattingPlugin config plugins = do
  let providerName = formattingProvider config
- fmtPlugin <- Map.lookup providerName (ipMap plugins)
+ fmtPlugin <- Map.lookup (PluginId providerName) (ipMap plugins)
  fmtProvider <- pluginFormattingProvider fmtPlugin
  return (fmtPlugin, fmtProvider)
 

test/utils/TestUtils.hs

@@ -51,7 +51,7 @@ testOptions = HIE.defaultOptions { cradleOptsVerbosity = Verbose }
 
 
 testCommand :: (ToJSON a, Typeable b, ToJSON b, Show b, Eq b)
- => IdePlugins -> IdeGhcM (IdeResult b) -> PluginId -> CommandName -> a -> IdeResult b -> IO ()
+ => IdePlugins -> IdeGhcM (IdeResult b) -> PluginId -> CommandId -> a -> IdeResult b -> IO ()
 testCommand testPlugins act plugin cmd arg res = do
  flushStackEnvironment
  (newApiRes, oldApiRes) <- runIGM testPlugins $ do
@@ -65,10 +65,10 @@ runSingle :: IdePlugins -> IdeGhcM (IdeResult b) -> IO (IdeResult b)
 runSingle testPlugins act = runIGM testPlugins act
 
 runSingleReq :: ToJSON a
- => IdePlugins -> PluginId -> CommandName -> a -> IO (IdeResult DynamicJSON)
+ => IdePlugins -> PluginId -> CommandId -> a -> IO (IdeResult DynamicJSON)
 runSingleReq testPlugins plugin com arg = runIGM testPlugins (makeRequest plugin com arg)
 
-makeRequest :: ToJSON a => PluginId -> CommandName -> a -> IdeGhcM (IdeResult DynamicJSON)
+makeRequest :: ToJSON a => PluginId -> CommandId -> a -> IdeGhcM (IdeResult DynamicJSON)
 makeRequest plugin com arg = runPluginCommand plugin com (toJSON arg)
 
 runIGM :: IdePlugins -> IdeGhcM a -> IO a