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