Skip to content

Commit a75da01

Browse files
vidit-odvidit-od
committed
Other Typed rules
1 parent 23295ca commit a75da01

40 files changed

Lines changed: 346 additions & 163 deletions

File tree

‎ghcide/session-loader/Development/IDE/Session.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,7 @@ import Data.Maybe
4242
import Data.Proxy
4343
import qualified Data.Text as T
4444
import Data.Version
45+
import Development.IDE.Core.InputPath
4546
import Development.IDE.Core.RuleTypes
4647
import Development.IDE.Core.Shake hiding (Log, knownTargets,
4748
withHieDb)
@@ -906,9 +907,9 @@ session recorder sessionShake sessionState knownTargetsVar(hieYaml, cfp, opts, l
906907
unless (null new_components_info || not checkProject) $ do
907908
cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) (concatMap targetLocations all_targets)
908909
void $ enqueueActions sessionShake $ mkDelayedAction "InitialLoad" Debug $ void $ do
909-
mmt <- uses GetModificationTime cfps'
910+
mmt <- uses GetModificationTime $ classifyAllHaskellInputs cfps'
910911
let cs_exist = catMaybes (zipWith (<$) cfps' mmt)
911-
modIfaces <- uses GetModIface cs_exist
912+
modIfaces <- uses GetModIface $ classifyProjectHaskellInputs cs_exist
912913
-- update exports map
913914
shakeExtras <- getShakeExtras
914915
let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces

‎ghcide/src/Development/IDE/Core/InputPath.hs‎

Lines changed: 26 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,10 +5,14 @@ module Development.IDE.Core.InputPath
55
, unInputPath
66
, unsafeMkInputPath
77
, toAllHaskellInput
8+
, toCabalFileInput
89
, toNoFileInput
910
, toProjectHaskellInput
11+
, toStackYamlInput
1012
, classifyAllHaskellInputs
13+
, classifyCabalFileInputs
1114
, classifyProjectHaskellInputs
15+
, classifyStackYamlInputs
1216
, generalizeProjectInput
1317
, isDependencyInputPath
1418
) where
@@ -19,7 +23,8 @@ import Data.List.Extra (isInfixOf)
1923
import Data.Maybe (mapMaybe)
2024
import Development.IDE.Graph (InputClass (..))
2125
import Development.IDE.Types.Location
22-
import System.FilePath (splitDirectories)
26+
import System.FilePath (splitDirectories, takeExtension,
27+
takeFileName)
2328

2429
-- | A NormalizedFilePath tagged with the class of rules it may be passed to.
2530
--
@@ -47,6 +52,18 @@ unsafeMkInputPath = InputPath
4752
toAllHaskellInput :: NormalizedFilePath -> InputPath AllHaskellFiles
4853
toAllHaskellInput = InputPath
4954

55+
-- | Classify a Cabal package description file.
56+
toCabalFileInput :: NormalizedFilePath -> Maybe (InputPath CabalFile)
57+
toCabalFileInput nfp
58+
| takeExtension (fromNormalizedFilePath nfp) == ".cabal" = Just (InputPath nfp)
59+
| otherwise = Nothing
60+
61+
-- | Classify a Stack project configuration file.
62+
toStackYamlInput :: NormalizedFilePath -> Maybe (InputPath StackYaml)
63+
toStackYamlInput nfp
64+
| takeFileName (fromNormalizedFilePath nfp) == "stack.yaml" = Just (InputPath nfp)
65+
| otherwise = Nothing
66+
5067
-- | The sentinel input for rules that do not operate on a real file.
5168
toNoFileInput :: InputPath NoFile
5269
toNoFileInput = InputPath emptyFilePath
@@ -65,10 +82,18 @@ toProjectHaskellInput nfp
6582
classifyAllHaskellInputs :: [NormalizedFilePath] -> [InputPath AllHaskellFiles]
6683
classifyAllHaskellInputs = map toAllHaskellInput
6784

85+
-- | Keep only Cabal package description files.
86+
classifyCabalFileInputs :: [NormalizedFilePath] -> [InputPath CabalFile]
87+
classifyCabalFileInputs = mapMaybe toCabalFileInput
88+
6889
-- | Keep only paths that are safe to pass to project-only rules.
6990
classifyProjectHaskellInputs :: [NormalizedFilePath] -> [InputPath ProjectHaskellFiles]
7091
classifyProjectHaskellInputs = mapMaybe toProjectHaskellInput
7192

93+
-- | Keep only Stack project configuration files.
94+
classifyStackYamlInputs :: [NormalizedFilePath] -> [InputPath StackYaml]
95+
classifyStackYamlInputs = mapMaybe toStackYamlInput
96+
7297
-- | A project file can always be used where an all-Haskell file is expected.
7398
--
7499
-- The opposite direction is intentionally not provided. To go from

‎ghcide/src/Development/IDE/Core/PluginUtils.hs‎

Lines changed: 38 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,8 @@
1-
{-# LANGUAGE GADTs #-}
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE FlexibleInstances #-}
3+
{-# LANGUAGE GADTs #-}
4+
{-# LANGUAGE KindSignatures #-}
5+
{-# LANGUAGE MultiParamTypeClasses #-}
26
module Development.IDE.Core.PluginUtils
37
(-- * Wrapped Action functions
48
runActionE
@@ -82,31 +86,32 @@ runActionMT herald ide act =
8286
join $ shakeEnqueue (shakeExtras ide) (mkDelayedAction herald Logger.Debug $ runMaybeT act)
8387

8488
-- |ExceptT version of `use` that throws a PluginRuleFailed upon failure
85-
useE :: IdeRule k i v => k -> InputPath i -> ExceptT PluginError Action v
89+
useE :: (IdeRule k i v, ToInputArg i a) => k -> a -> ExceptT PluginError Action v
8690
useE k = maybeToExceptT (PluginRuleFailed (T.pack $ show k)) . useMT k
8791

8892
-- |MaybeT version of `use`
89-
useMT :: IdeRule k i v => k -> InputPath i -> MaybeT Action v
90-
useMT k = MaybeT . Shake.use k
93+
useMT :: (IdeRule k i v, ToInputArg i a) => k -> a -> MaybeT Action v
94+
useMT k = MaybeT . maybe (pure Nothing) (Shake.use k) . toInputArg
9195

9296
-- |ExceptT version of `uses` that throws a PluginRuleFailed upon failure
93-
usesE :: (Traversable f, IdeRule k i v) => k -> f (InputPath i) -> ExceptT PluginError Action (f v)
97+
usesE :: (Traversable f, IdeRule k i v, ToInputArg i a) => k -> f a -> ExceptT PluginError Action (f v)
9498
usesE k = maybeToExceptT (PluginRuleFailed (T.pack $ show k)) . usesMT k
9599

96100
-- |MaybeT version of `uses`
97-
usesMT :: (Traversable f, IdeRule k i v) => k -> f (InputPath i) -> MaybeT Action (f v)
98-
usesMT k xs = MaybeT $ sequence <$> Shake.uses k xs
101+
usesMT :: (Traversable f, IdeRule k i v, ToInputArg i a) => k -> f a -> MaybeT Action (f v)
102+
usesMT k xs = MaybeT $ traverse toInputArg xs & maybe (pure Nothing) (fmap sequence . Shake.uses k)
99103

100104
-- |ExceptT version of `useWithStale` that throws a PluginRuleFailed upon
101105
-- failure
102-
useWithStaleE :: IdeRule k i v
103-
=> k -> InputPath i -> ExceptT PluginError Action (v, PositionMapping)
106+
useWithStaleE :: (IdeRule k i v, ToInputArg i a)
107+
=> k -> a -> ExceptT PluginError Action (v, PositionMapping)
104108
useWithStaleE key = maybeToExceptT (PluginRuleFailed (T.pack $ show key)) . useWithStaleMT key
105109

106110
-- |MaybeT version of `useWithStale`
107-
useWithStaleMT :: IdeRule k i v
108-
=> k -> InputPath i -> MaybeT Action (v, PositionMapping)
109-
useWithStaleMT key file = MaybeT $ runIdentity <$> Shake.usesWithStale key (Identity file)
111+
useWithStaleMT :: (IdeRule k i v, ToInputArg i a)
112+
=> k -> a -> MaybeT Action (v, PositionMapping)
113+
useWithStaleMT key file =
114+
MaybeT $ maybe (pure Nothing) (fmap runIdentity . Shake.usesWithStale key . Identity) (toInputArg file)
110115

111116
-- ----------------------------------------------------------------------------
112117
-- IdeAction wrappers
@@ -122,12 +127,30 @@ runIdeActionMT _herald s i = MaybeT $ liftIO $ runReaderT (Shake.runIdeActionT $
122127

123128
-- |ExceptT version of `useWithStaleFast` that throws a PluginRuleFailed upon
124129
-- failure
125-
useWithStaleFastE :: IdeRule k i v => k -> InputPath i -> ExceptT PluginError IdeAction (v, PositionMapping)
130+
useWithStaleFastE :: (IdeRule k i v, ToInputArg i a) => k -> a -> ExceptT PluginError IdeAction (v, PositionMapping)
126131
useWithStaleFastE k = maybeToExceptT (PluginRuleFailed (T.pack $ show k)) . useWithStaleFastMT k
127132

128133
-- |MaybeT version of `useWithStaleFast`
129-
useWithStaleFastMT :: IdeRule k i v => k -> InputPath i -> MaybeT IdeAction (v, PositionMapping)
130-
useWithStaleFastMT k = MaybeT . Shake.useWithStaleFast k
134+
useWithStaleFastMT :: (IdeRule k i v, ToInputArg i a) => k -> a -> MaybeT IdeAction (v, PositionMapping)
135+
useWithStaleFastMT k = MaybeT . maybe (pure Nothing) (Shake.useWithStaleFast k) . toInputArg
136+
137+
class ToInputArg (i :: InputClass) a where
138+
toInputArg :: a -> Maybe (InputPath i)
139+
140+
instance ToInputArg i (InputPath i) where
141+
toInputArg = Just
142+
143+
instance ToInputArg ProjectHaskellFiles NormalizedFilePath where
144+
toInputArg = toProjectHaskellInput
145+
146+
instance ToInputArg AllHaskellFiles NormalizedFilePath where
147+
toInputArg = Just . toAllHaskellInput
148+
149+
instance ToInputArg CabalFile NormalizedFilePath where
150+
toInputArg = toCabalFileInput
151+
152+
instance ToInputArg StackYaml NormalizedFilePath where
153+
toInputArg = toStackYamlInput
131154

132155
-- ----------------------------------------------------------------------------
133156
-- Location wrappers

‎ghcide/src/Development/IDE/Plugin/TypeLenses.hs‎

Lines changed: 14 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -159,17 +159,19 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif
159159
then do
160160
-- In this mode we get the global bindings from the
161161
-- GlobalBindingTypeSigs rule.
162-
let input = maybe (error "codeLensProvider: expected a project Haskell file") id $ toProjectHaskellInput nfp
163-
(GlobalBindingTypeSigsResult gblSigs, gblSigsMp) <-
164-
runActionE "codeLens.GetGlobalBindingTypeSigs" ideState
165-
$ useWithStaleE GetGlobalBindingTypeSigs input
166-
-- Depending on whether we only want exported or not we filter our list
167-
-- of signatures to get what we want
168-
let relevantGlobalSigs =
169-
if mode == Exported
170-
then filter gbExported gblSigs
171-
else gblSigs
172-
pure $ InL $ generateLensFromGlobal relevantGlobalSigs gblSigsMp
162+
case toProjectHaskellInput nfp of
163+
Nothing -> pure $ InL []
164+
Just input -> do
165+
(GlobalBindingTypeSigsResult gblSigs, gblSigsMp) <-
166+
runActionE "codeLens.GetGlobalBindingTypeSigs" ideState
167+
$ useWithStaleE GetGlobalBindingTypeSigs input
168+
-- Depending on whether we only want exported or not we filter our list
169+
-- of signatures to get what we want
170+
let relevantGlobalSigs =
171+
if mode == Exported
172+
then filter gbExported gblSigs
173+
else gblSigs
174+
pure $ InL $ generateLensFromGlobal relevantGlobalSigs gblSigsMp
173175
else do
174176
-- For this mode we exclusively use diagnostics to create the lenses.
175177
-- However we will still use the GlobalBindingTypeSigs to resolve them.
@@ -181,7 +183,7 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif
181183
codeLensResolveProvider :: ResolveFunction IdeState TypeLensesResolve Method_CodeLensResolve
182184
codeLensResolveProvider ideState pId lens@CodeLens{_range} uri TypeLensesResolve = do
183185
nfp <- getNormalizedFilePathE uri
184-
let input = maybe (error "codeLensResolveProvider: expected a project Haskell file") id $ toProjectHaskellInput nfp
186+
input <- handleMaybe PluginStaleResolve $ toProjectHaskellInput nfp
185187
(gblSigs@(GlobalBindingTypeSigsResult _), pm) <-
186188
runActionE "codeLens.GetGlobalBindingTypeSigs" ideState
187189
$ useWithStaleE GetGlobalBindingTypeSigs input

‎ghcide/src/Development/IDE/Spans/Pragmas.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,8 @@ import Development.IDE.GHC.Compat.Util
2525
import qualified Language.LSP.Protocol.Types as LSP
2626
import Control.Monad.IO.Class (MonadIO (..))
2727
import Control.Monad.Trans.Except (ExceptT)
28-
import Ide.Plugin.Error (PluginError)
28+
import Ide.Plugin.Error (PluginError (..),
29+
handleMaybe)
2930
import Ide.Types (PluginId(..))
3031
import qualified Data.Text as T
3132
import Development.IDE.Core.PluginUtils
@@ -54,7 +55,7 @@ insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma = LSP.TextEdit prag
5455

5556
getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m NextPragmaInfo
5657
getFirstPragma (PluginId pId) state nfp = do
57-
let input = Maybe.fromMaybe (error "getFirstPragma: expected a project Haskell file") $ toProjectHaskellInput nfp
58+
input <- handleMaybe (PluginInvalidParams "Expected project Haskell file") $ toProjectHaskellInput nfp
5859
(hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE (T.unpack pId <> ".GhcSession") state $ useWithStaleE GhcSession input
5960
fileContents <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents $ generalizeProjectInput input
6061
pure $ getNextPragmaInfo sessionDynFlags fileContents

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

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,7 @@ module Ide.Types
3939
, PluginNotificationHandler(..), mkPluginNotificationHandler
4040
, PluginNotificationHandlers(..)
4141
, PluginRequestMethod(..)
42+
, InputClass(..), RuleInput, RuleResult, Rules, Key, alwaysRerun
4243
, getProcessID, getPid
4344
, getVirtualFileFromVFS
4445
, installSigUsr1Handler
@@ -67,7 +68,8 @@ import Control.Monad (void)
6768
import Control.Monad.Error.Class (MonadError (throwError))
6869
import Control.Monad.IO.Class (MonadIO)
6970
import Control.Monad.Trans.Except (ExceptT, runExceptT)
70-
import Data.Aeson hiding (Null, defaultOptions)
71+
import Data.Aeson hiding (Key, Null,
72+
defaultOptions)
7173
import qualified Data.Aeson.Types as A
7274
import Data.Default
7375
import Data.Dependent.Map (DMap)

‎plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,7 @@ instance Hashable CollectLiterals
5353
instance NFData CollectLiterals
5454

5555
type instance RuleResult CollectLiterals = CollectLiteralsResult
56+
type instance RuleInput CollectLiterals = ProjectHaskellFiles
5657

5758
data CollectLiteralsResult = CLR
5859
{ literals :: RangeMap Literal

0 commit comments

Comments
 (0)