42461c4 · ghcide · git.iko.soy

git.iko.soy/ghcide

on master help sign in

Simplify IDE rules (#708)

42461c4Neil Mitchell8 years ago

src/Development/IDE/State/FileStore.hs+3−3

compare with master

unifiedsplit

@@ -42,13 +42,13 @@ instance IsIdeGlobal GlobalDirtyFiles

44-- | Get the modification time of a file.

45−type instance RuleResult GetModificationTime = IdeResult UTCTime

45+type instance RuleResult GetModificationTime = UTCTime

47-- | Get the contents of a file, either dirty (if the buffer is modified) or from disk.

48−type instance RuleResult GetFileContents = IdeResult (UTCTime, StringBuffer)

48+type instance RuleResult GetFileContents = (UTCTime, StringBuffer)

50-- | Does the file exist.

51−type instance RuleResult GetFileExists = IdeResult Bool

51+type instance RuleResult GetFileExists = Bool

54data GetFileExists = GetFileExists

src/Development/IDE/State/RuleTypes.hs+11−12

@@ -27,7 +27,6 @@ import GHC.Generics (Generic)

27import "ghc-lib" GHC

28import "ghc-lib-parser" Module

30−import Development.IDE.State.Shake

31import Development.IDE.Types.SpanInfo

30import Development.IDE.Types.SpanInfo

@@ -36,44 +35,44 @@ import Development.IDE.Types.SpanInfo

36-- Foo* means Foo for me and Foo+

35-- Foo* means Foo for me and Foo+

38-- | Kick off things

37-- | Kick off things

39−type instance RuleResult OfInterest = IdeResult ()

38+type instance RuleResult OfInterest = ()

41-- | The parse tree for the file using GetFileContents

40-- | The parse tree for the file using GetFileContents

42−type instance RuleResult GetParsedModule = IdeResult ParsedModule

41+type instance RuleResult GetParsedModule = ParsedModule

44-- | The dependency information produced by following the imports recursively.

43-- | The dependency information produced by following the imports recursively.

45-- This rule will succeed even if there is an error, e.g., a module could not be located,

44-- This rule will succeed even if there is an error, e.g., a module could not be located,

46-- a module could not be parsed or an import cycle.

45-- a module could not be parsed or an import cycle.

47−type instance RuleResult GetDependencyInformation = IdeResult DependencyInformation

46+type instance RuleResult GetDependencyInformation = DependencyInformation

49-- | Transitive module and pkg dependencies based on the information produced by GetDependencyInformation.

48-- | Transitive module and pkg dependencies based on the information produced by GetDependencyInformation.

50-- This rule is also responsible for calling ReportImportCycles for each file in the transitive closure.

49-- This rule is also responsible for calling ReportImportCycles for each file in the transitive closure.

51−type instance RuleResult GetDependencies = IdeResult TransitiveDependencies

50+type instance RuleResult GetDependencies = TransitiveDependencies

53-- | The type checked version of this file, requires TypeCheck+

52-- | The type checked version of this file, requires TypeCheck+

54−type instance RuleResult TypeCheck = IdeResult TcModuleResult

53+type instance RuleResult TypeCheck = TcModuleResult

56-- | The result of loading a module from a package.

55-- | The result of loading a module from a package.

57−type instance RuleResult LoadPackage = IdeResult LoadPackageResult

56+type instance RuleResult LoadPackage = LoadPackageResult

59-- | Information about what spans occur where, requires TypeCheck

58-- | Information about what spans occur where, requires TypeCheck

60−type instance RuleResult GetSpanInfo = IdeResult [SpanInfo]

59+type instance RuleResult GetSpanInfo = [SpanInfo]

62-- | Convert to Core, requires TypeCheck*

61-- | Convert to Core, requires TypeCheck*

63−type instance RuleResult GenerateCore = IdeResult GhcModule

62+type instance RuleResult GenerateCore = GhcModule

65-- | We capture the subset of `DynFlags` that is computed by package initialization in a rule to

64-- | We capture the subset of `DynFlags` that is computed by package initialization in a rule to

66-- make session initialization cheaper by reusing it.

65-- make session initialization cheaper by reusing it.

67−type instance RuleResult GeneratePackageState = IdeResult Compile.PackageState

66+type instance RuleResult GeneratePackageState = Compile.PackageState

69-- | Resolve the imports in a module to the list of either external packages or absolute file paths

68-- | Resolve the imports in a module to the list of either external packages or absolute file paths

70-- for modules in the same package.

69-- for modules in the same package.

71−type instance RuleResult GetLocatedImports = IdeResult [(Located ModuleName, Maybe Import)]

70+type instance RuleResult GetLocatedImports = [(Located ModuleName, Maybe Import)]

73-- | This rule is used to report import cycles. It depends on GetDependencyInformation.

72-- | This rule is used to report import cycles. It depends on GetDependencyInformation.

74-- We cannot report the cycles directly from GetDependencyInformation since

73-- We cannot report the cycles directly from GetDependencyInformation since

75-- we can only report diagnostics for the current file.

74-- we can only report diagnostics for the current file.

76−type instance RuleResult ReportImportCycles = IdeResult ()

75+type instance RuleResult ReportImportCycles = ()

79data OfInterest = OfInterest

78data OfInterest = OfInterest

src/Development/IDE/State/Rules.hs+3−3

@@ -58,8 +58,8 @@ toIdeResultNew :: Either [Diagnostic] v -> IdeResult v

58toIdeResultNew = either (, Nothing) (([],) . Just)

60-- Convert to a legacy Ide result but dropping dependencies

61−toIdeResultSilent :: IdeResult v -> Either [Diagnostic] v

61+toIdeResultSilent :: Maybe v -> Either [Diagnostic] v

62−toIdeResultSilent (_, val) = maybe (Left []) Right val

62+toIdeResultSilent val = maybe (Left []) Right val

65defineNoFile :: IdeRule k v => (k -> Action v) -> Rules ()

@@ -198,7 +198,7 @@ rawDependencyInformation f = go (Set.singleton f) Map.empty Map.empty

198 Nothing -> pure (RawDependencyInformation modGraph pkgs)

199 Just (f, fs) -> do

200 importsOrErr <- lift $ use GetLocatedImports f

201− case snd importsOrErr of

201+ case importsOrErr of

202 Nothing ->

203 let modGraph' = Map.insert f (Left ModuleParseError) modGraph

204 in go fs modGraph' pkgs

src/Development/IDE/State/Shake.hs+34−18

@@ -6,6 +6,20 @@

6{-# LANGUAGE ConstraintKinds #-}

8-- | A Shake implementation of the compiler service.

9+--

10+-- There are two primary locations where data lives, and both of

11+-- these contain much the same data:

12+--

13+-- * The Shake database (inside 'shakeDb') stores a map of shake keys

14+-- to shake values. In our case, these are all of type 'Q' to 'A'.

15+-- During a single run all the values in the Shake database are consistent

16+-- so are used in conjunction with each other, e.g. in 'uses'.

17+--

18+-- * The 'Values' type stores a map of keys to values. These values are

19+-- always stored as real Haskell values, whereas Shake serialises all 'A' values

20+-- between runs. To deserialise a Shake value, we just consult Values.

21+-- Additionally, Values can be used in an inconsistent way, for example

22+-- useStale.

9module Development.IDE.State.Shake(

23module Development.IDE.State.Shake(

10 IdeState,

24 IdeState,

11 IdeRule, IdeResult,

25 IdeRule, IdeResult,

@@ -73,9 +87,8 @@ getShakeExtras = do

74getShakeExtrasRules :: Rules ShakeExtras

88getShakeExtrasRules :: Rules ShakeExtras

75getShakeExtrasRules = do

89getShakeExtrasRules = do

76− -- We'd like to use binding, but no MonadFail Rules https://github.com/ndmitchell/shake/issues/643

77− x <- getShakeExtraRules @ShakeExtras

90+ Just x <- getShakeExtraRules @ShakeExtras

78− return $ fromMaybe (error "Can't find ShakeExtras, serious error") x

91+ return x

@@ -135,7 +148,7 @@ instance Hashable Key where

135type IdeResult v = ([Diagnostic], Maybe v)

148type IdeResult v = ([Diagnostic], Maybe v)

136

149

137type IdeRule k v =

150type IdeRule k v =

138− ( Shake.RuleResult k ~ IdeResult v

151+ ( Shake.RuleResult k ~ v

139 , Shake.ShakeValue k

152 , Shake.ShakeValue k

140 , Show v

153 , Show v

141 , Typeable v

154 , Typeable v

@@ -184,15 +197,17 @@ setValues :: IdeRule k v

184 -> IO (Maybe [Diagnostic], [Diagnostic]) -- ^ (before, after)

197 -> IO (Maybe [Diagnostic], [Diagnostic]) -- ^ (before, after)

185setValues state key file val = modifyVar state $ \inVal -> do

198setValues state key file val = modifyVar state $ \inVal -> do

186 let k = Key key

199 let k = Key key

187− outVal = Map.insertWith Map.union file (Map.singleton k $ fmap toDyn <$> val) inVal

200+ outVal = Map.insertWith Map.union file (Map.singleton k $ second (fmap toDyn) val) inVal

188 f = concatMap fst . Map.elems

201 f = concatMap fst . Map.elems

189 return (outVal, (f <$> Map.lookup file inVal, f $ outVal Map.! file))

202 return (outVal, (f <$> Map.lookup file inVal, f $ outVal Map.! file))

190

203

191−getValues :: forall k v. IdeRule k v => Var Values -> k -> FilePath -> IO (Maybe (IdeResult v))

204+getValues :: forall k v. IdeRule k v => Var Values -> k -> FilePath -> IO (Maybe (Maybe v))

192−getValues state key file = flip fmap (readVar state) $ \vs -> do

205+getValues state key file = do

206+ vs <- readVar state

207+ return $ do

193− f <- Map.lookup file vs

208+ f <- Map.lookup file vs

194− k <- Map.lookup (Key key) f

209+ v <- Map.lookup (Key key) f

195− pure $ fmap (fromJust . fromDynamic) <$> k

210+ pure $ fmap (fromJust . fromDynamic @v) $ snd v

196

211

197-- | Open a 'IdeState', should be shut using 'shakeShut'.

212-- | Open a 'IdeState', should be shut using 'shakeShut'.

198shakeOpen :: (Event -> IO ()) -- ^ diagnostic handler

213shakeOpen :: (Event -> IO ()) -- ^ diagnostic handler

@@ -235,9 +250,8 @@ shakeRun IdeState{shakeExtras=ShakeExtras{..}, ..} acts = modifyVar shakeAbort $

235useStale

250useStale

236 :: IdeRule k v

251 :: IdeRule k v

237 => IdeState -> k -> FilePath -> IO (Maybe v)

252 => IdeState -> k -> FilePath -> IO (Maybe v)

238−useStale IdeState{shakeExtras=ShakeExtras{state}} k fp = do

253+useStale IdeState{shakeExtras=ShakeExtras{state}} k fp =

239− v <- getValues state k fp

254+ join <$> getValues state k fp

240− return $ maybe Nothing snd v

241

255

242

256

243getAllDiagnostics :: IdeState -> IO [Diagnostic]

257getAllDiagnostics :: IdeState -> IO [Diagnostic]

@@ -262,7 +276,7 @@ define

262define op = defineEarlyCutoff $ \k v -> (Nothing,) <$> op k v

276define op = defineEarlyCutoff $ \k v -> (Nothing,) <$> op k v

263

277

264use :: IdeRule k v

278use :: IdeRule k v

265− => k -> FilePath -> Action (IdeResult v)

279+ => k -> FilePath -> Action (Maybe v)

266use key file = head <$> uses key [file]

280use key file = head <$> uses key [file]

267

281

268use_ :: IdeRule k v => k -> FilePath -> Action v

282use_ :: IdeRule k v => k -> FilePath -> Action v

@@ -271,7 +285,7 @@ use_ key file = head <$> uses_ key [file]

271uses_ :: IdeRule k v => k -> [FilePath] -> Action [v]

285uses_ :: IdeRule k v => k -> [FilePath] -> Action [v]

272uses_ key files = do

286uses_ key files = do

273 res <- uses key files

287 res <- uses key files

274− case mapM snd res of

288+ case sequence res of

275 Nothing -> liftIO $ throwIO BadDependency

289 Nothing -> liftIO $ throwIO BadDependency

276 Just v -> return v

290 Just v -> return v

277

291

@@ -307,17 +321,19 @@ instance Show k => Show (Q k) where

307

321

308-- | Invariant: the 'v' must be in normal form (fully evaluated).

322-- | Invariant: the 'v' must be in normal form (fully evaluated).

309-- Otherwise we keep repeatedly 'rnf'ing values taken from the Shake database

323-- Otherwise we keep repeatedly 'rnf'ing values taken from the Shake database

310−data A v = A v (Maybe BS.ByteString)

324+data A v = A (Maybe v) (Maybe BS.ByteString)

311 deriving Show

325 deriving Show

312

326

313instance NFData (A v) where rnf (A v x) = v `seq` rnf x

327instance NFData (A v) where rnf (A v x) = v `seq` rnf x

314

328

329+-- In the Shake database we only store one type of key/result pairs,

330+-- namely Q (question) / A (answer).

315type instance RuleResult (Q k) = A (RuleResult k)

331type instance RuleResult (Q k) = A (RuleResult k)

316

332

317

333

318-- | Compute the value

334-- | Compute the value

319uses :: IdeRule k v

335uses :: IdeRule k v

320− => k -> [FilePath] -> Action [IdeResult v]

336+ => k -> [FilePath] -> Action [Maybe v]

321uses key files = map (\(A value _) -> value) <$> apply (map (Q . (key,)) files)

337uses key files = map (\(A value _) -> value) <$> apply (map (Q . (key,)) files)

322

338

323defineEarlyCutoff

339defineEarlyCutoff

@@ -353,7 +369,7 @@ defineEarlyCutoff op = addBuiltinRule noLint noIdentity $ \(Q (key, file)) old m

353 return $ RunResult

369 return $ RunResult

354 (if eq then ChangedRecomputeSame else ChangedRecomputeDiff)

370 (if eq then ChangedRecomputeSame else ChangedRecomputeDiff)

355 (wrap bs)

371 (wrap bs)

356− $ A res bs

372+ $ A (snd res) bs

357 where

373 where

358 wrap = maybe BS.empty (BS.cons '_')

374 wrap = maybe BS.empty (BS.cons '_')

359 unwrap x = if BS.null x then Nothing else Just $ BS.tail x

375 unwrap x = if BS.null x then Nothing else Just $ BS.tail x