git.iko.soy/ghcide
on 163bbc9 help sign in
ghcide/src/Development/IDE/Core/Service.hs
143 lines 5.1 kB history raw
1-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
4{-# LANGUAGE TypeFamilies #-}
5{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE FlexibleInstances #-}
8-- | A Shake implementation of the compiler service, built
9-- using the "Shaker" abstraction layer for in-memory use.
10--
11module Development.IDE.Core.Service(
12 Env(..),
13 getServiceEnv,
14 IdeState, initialise, shutdown,
15 runAction, runActions,
16 runActionSync, runActionsSync,
17 setFilesOfInterest, modifyFilesOfInterest,
18 writeProfile,
19 getDiagnostics, unsafeClearDiagnostics,
20 logDebug, logSeriousError
21 ) where
23import Control.Concurrent.Extra
24import Control.Monad.Except
25import Development.IDE.Types.Options (IdeOptions(..))
26import Development.IDE.Core.FileStore
27import qualified Development.IDE.Types.Logger as Logger
28import Data.Set (Set)
29import qualified Data.Set as Set
30import qualified Data.Text as T
31import Data.Tuple.Extra
32import Development.IDE.Types.Diagnostics(FileDiagnostic)
33import Development.IDE.Types.Location (NormalizedFilePath)
34import Development.Shake hiding (Diagnostic, Env, newCache)
35import qualified Language.Haskell.LSP.Messages as LSP
37import UniqSupply
39import Development.IDE.Core.Shake
42-- | Environment threaded through the Shake actions.
43data Env = Env
44 { envOptions :: IdeOptions
45 -- ^ Compiler options.
46 , envOfInterestVar :: Var (Set NormalizedFilePath)
47 -- ^ The files of interest.
48 , envUniqSupplyVar :: Var UniqSupply
49 -- ^ The unique supply of names used by the compiler.
50 }
51instance IsIdeGlobal Env
54mkEnv :: IdeOptions -> IO Env
55mkEnv options = do
56 ofInterestVar <- newVar Set.empty
57 uniqSupplyVar <- mkSplitUniqSupply 'a' >>= newVar
58 return Env
59 { envOptions = options
60 , envOfInterestVar = ofInterestVar
61 , envUniqSupplyVar = uniqSupplyVar
62 }
64getDiagnostics :: IdeState -> IO [FileDiagnostic]
65getDiagnostics = getAllDiagnostics
67unsafeClearDiagnostics :: IdeState -> IO ()
68unsafeClearDiagnostics = unsafeClearAllDiagnostics
71------------------------------------------------------------
72-- Exposed API
74-- | Initialise the Compiler Service.
75initialise :: Rules ()
76 -> (LSP.FromServerMessage -> IO ())
77 -> Logger.Handle
78 -> IdeOptions
79 -> VFSHandle
80 -> IO IdeState
81initialise mainRule toDiags logger options vfs =
82 shakeOpen
83 toDiags
84 logger
85 (setProfiling options $
86 shakeOptions { shakeThreads = optThreads options
87 , shakeFiles = "/dev/null"
88 }) $ do
89 addIdeGlobal =<< liftIO (mkEnv options)
90 fileStoreRules vfs
91 mainRule
93writeProfile :: IdeState -> FilePath -> IO ()
94writeProfile = shakeProfile
96setProfiling :: IdeOptions -> ShakeOptions -> ShakeOptions
97setProfiling opts shakeOpts =
98 maybe shakeOpts (\p -> shakeOpts { shakeReport = [p], shakeTimings = True }) (optShakeProfiling opts)
100-- | Shutdown the Compiler Service.
101shutdown :: IdeState -> IO ()
102shutdown = shakeShut
104-- | Run a single action using the supplied service. See `runActions`
105-- for more details.
106runAction :: IdeState -> Action a -> IO a
107runAction service action = head <$> runActions service [action]
109-- | Run a list of actions in parallel using the supplied service.
110-- This will return as soon as the results of the actions are
111-- available. There might still be other rules running at this point,
112-- e.g., the ofInterestRule.
113runActions :: IdeState -> [Action a] -> IO [a]
114runActions x acts = do
115 var <- newBarrier
116 _ <- shakeRun x acts (signalBarrier var)
117 waitBarrier var
119-- | This is a synchronous variant of `runAction`. See
120-- `runActionsSync` of more details.
121runActionSync :: IdeState -> Action a -> IO a
122runActionSync s a = head <$> runActionsSync s [a]
124-- | `runActionsSync` is similar to `runActions` but it will
125-- wait for all rules (so in particular the `ofInterestRule`) to
126-- finish running. This is mainly useful in tests, where you want
127-- to wait for all rules to fire so you can check diagnostics.
128runActionsSync :: IdeState -> [Action a] -> IO [a]
129runActionsSync s acts = join $ shakeRun s acts (const $ pure ())
131-- | Set the files-of-interest which will be built and kept-up-to-date.
132setFilesOfInterest :: IdeState -> Set NormalizedFilePath -> IO ()
133setFilesOfInterest state files = modifyFilesOfInterest state (const files)
135modifyFilesOfInterest :: IdeState -> (Set NormalizedFilePath -> Set NormalizedFilePath) -> IO ()
136modifyFilesOfInterest state f = do
137 Env{..} <- getIdeGlobalState state
138 files <- modifyVar envOfInterestVar $ pure . dupe . f
139 logDebug state $ "Set files of interest to: " <> T.pack (show $ Set.toList files)
140 void $ shakeRun state [] (const $ pure ())
142getServiceEnv :: Action Env
143getServiceEnv = getIdeGlobalAction