Add PluginFileType

Author: nlander

ghcide/src/Development/IDE/Core/Shake.hs

@@ -168,7 +168,8 @@ import           Ide.Plugin.Config
 import qualified Ide.PluginUtils                        as HLS
 import           Ide.Types                              (IdePlugins (IdePlugins),
                                                          PluginDescriptor (pluginId),
-                                                         PluginId)
+                                                         PluginId, SourceFileOrigin(..),
+                                                         getSourceFileOrigin)
 import           Language.LSP.Diagnostics
 import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types
@@ -1128,17 +1129,6 @@ defineEarlyCutOffNoFile recorder f = defineEarlyCutoff recorder $ RuleNoDiagnost
     if file == emptyFilePath then do (hash, res) <- f k; return (Just hash, Just res) else
         fail $ "Rule " ++ show k ++ " should always be called with the empty string for a file"
 
-data SourceFileOrigin = FromProject | FromDependency
-
-getSourceFileOrigin :: NormalizedFilePath -> SourceFileOrigin
-getSourceFileOrigin f =
-    case [".hls", "dependencies"] `isInfixOf` (splitDirectories file) of
-        True -> FromDependency
-        False -> FromProject
-    where
-        file :: FilePath
-        file = fromNormalizedFilePath f
-
 defineEarlyCutoff'
     :: forall k v. IdeRule k v
     => (Maybe Int32 -> [FileDiagnostic] -> Action ()) -- ^ update diagnostics

ghcide/src/Development/IDE/LSP/Notifications.hs

@@ -158,6 +158,7 @@ descriptor recorder plId = (defaultPluginDescriptor plId) { pluginNotificationHa
     -- The ghcide descriptors should come last'ish so that the notification handlers
     -- (which restart the Shake build) run after everything else
         pluginPriority = ghcideNotificationsPluginPriority
+    ,   pluginFileType = PluginFileType [FromProject, FromDependency] defaultPluginFileExtensions
     }
 
 ghcideNotificationsPluginPriority :: Natural

ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs

@@ -53,9 +53,10 @@ descriptor plId = (defaultPluginDescriptor plId)
                   <> mkPluginHandler SMethod_TextDocumentDocumentHighlight (\ide _ DocumentHighlightParams{..} ->
                       documentHighlight ide TextDocumentPositionParams{..})
                   <> mkPluginHandler SMethod_TextDocumentReferences (\ide _ params -> references ide params)
-                  <> mkPluginHandler SMethod_WorkspaceSymbol (\ide _ params -> fmap InL <$> wsSymbols ide params),
+                  <> mkPluginHandler SMethod_WorkspaceSymbol (\ide _ params -> fmap InL <$> wsSymbols ide params)
 
-    pluginConfigDescriptor = defaultConfigDescriptor
+  , pluginConfigDescriptor = defaultConfigDescriptor
+  , pluginFileType = PluginFileType [FromProject, FromDependency] defaultPluginFileExtensions
   }
 
 -- ---------------------------------------------------------------------

hls-plugin-api/src/Ide/Types.hs

@@ -23,7 +23,7 @@
 {-# LANGUAGE ViewPatterns               #-}
 module Ide.Types
 ( PluginDescriptor(..), defaultPluginDescriptor, defaultCabalPluginDescriptor
-, defaultPluginPriority
+, defaultPluginPriority, defaultPluginFileExtensions
 , IdeCommand(..)
 , IdeMethod(..)
 , IdeNotification(..)
@@ -36,6 +36,7 @@ module Ide.Types
 , FormattingType(..), FormattingMethod, FormattingHandler, mkFormattingHandlers
 , HasTracing(..)
 , PluginCommand(..), CommandId(..), CommandFunction, mkLspCommand, mkLspCmdId
+, PluginFileType(..)
 , PluginId(..)
 , PluginHandler(..), mkPluginHandler
 , PluginHandlers(..)
@@ -44,6 +45,8 @@ module Ide.Types
 , PluginNotificationHandler(..), mkPluginNotificationHandler
 , PluginNotificationHandlers(..)
 , PluginRequestMethod(..)
+, SourceFileOrigin(..)
+, getSourceFileOrigin
 , getProcessID, getPid
 , installSigUsr1Handler
 , responseError
@@ -76,6 +79,7 @@ import           Data.GADT.Compare
 import           Data.Hashable                 (Hashable)
 import           Data.HashMap.Strict           (HashMap)
 import qualified Data.HashMap.Strict           as HashMap
+import           Data.List                     (isInfixOf)
 import           Data.List.Extra               (find, sortOn)
 import           Data.List.NonEmpty            (NonEmpty (..), toList)
 import qualified Data.Map                      as Map
@@ -276,23 +280,44 @@ data PluginDescriptor (ideState :: *) =
                    , pluginNotificationHandlers :: PluginNotificationHandlers ideState
                    , pluginModifyDynflags :: DynFlagsModifications
                    , pluginCli            :: Maybe (ParserInfo (IdeCommand ideState))
-                   , pluginFileType       :: [T.Text]
+                   , pluginFileType       :: PluginFileType
                    -- ^ File extension of the files the plugin is responsible for.
                    --   The plugin is only allowed to handle files with these extensions.
                    --   When writing handlers, etc. for this plugin it can be assumed that all handled files are of this type.
                    --   The file extension must have a leading '.'.
                    }
 
+data PluginFileType = PluginFileType [SourceFileOrigin] [T.Text]
+
+data SourceFileOrigin = FromProject | FromDependency deriving Eq
+
+getSourceFileOrigin :: NormalizedFilePath -> SourceFileOrigin
+getSourceFileOrigin f =
+    case [".hls", "dependencies"] `isInfixOf` (splitDirectories file) of
+        True -> FromDependency
+        False -> FromProject
+    where
+        file :: FilePath
+        file = fromNormalizedFilePath f
+
 -- | Check whether the given plugin descriptor is responsible for the file with the given path.
 --   Compares the file extension of the file at the given path with the file extension
 --   the plugin is responsible for.
 pluginResponsible :: Uri -> PluginDescriptor c -> Bool
 pluginResponsible uri pluginDesc
     | Just fp <- mfp
-    , T.pack (takeExtension fp) `elem` pluginFileType pluginDesc = True
+    , checkFile (pluginFileType pluginDesc) fp = True
     | otherwise = False
     where
-      mfp = uriToFilePath uri
+        checkFile :: PluginFileType -> NormalizedFilePath -> Bool
+        checkFile (PluginFileType validOrigins validExtensions) fp =
+            getSourceFileOrigin fp `elem` validOrigins
+            &&
+            getExtension fp `elem` validExtensions
+        getExtension :: NormalizedFilePath -> T.Text
+        getExtension = T.pack . takeExtension . fromNormalizedFilePath
+        mfp :: Maybe NormalizedFilePath
+        mfp = uriToNormalizedFilePath $ toNormalizedUri uri
 
 -- | An existential wrapper of 'Properties'
 data CustomConfig = forall r. CustomConfig (Properties r)
@@ -835,7 +860,10 @@ defaultPluginDescriptor plId =
     mempty
     mempty
     Nothing
-    [".hs", ".lhs", ".hs-boot"]
+    (PluginFileType [FromProject] defaultPluginFileExtensions)
+
+defaultPluginFileExtensions :: [T.Text]
+defaultPluginFileExtensions = [".hs", ".lhs", ".hs-boot"]
 
 -- | Set up a plugin descriptor, initialized with default values.
 -- This plugin descriptor is prepared for @.cabal@ files and as such,
@@ -855,7 +883,7 @@ defaultCabalPluginDescriptor plId =
     mempty
     mempty
     Nothing
-    [".cabal"]
+    (PluginFileType [FromProject] [".cabal"])
 
 newtype CommandId = CommandId T.Text
   deriving (Show, Read, Eq, Ord)