on eddf78a help sign in
98 lines 3.5 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 getIdeOptions,
13 IdeState, initialise, shutdown,
14 runAction,
15 runActionSync,
16 writeProfile,
17 getDiagnostics, unsafeClearDiagnostics,
18 ideLogger
19 ) where
21import Control.Concurrent.Extra
22import Control.Concurrent.Async
23import Control.Monad.Except
24import Development.IDE.Types.Options (IdeOptions(..))
25import Development.IDE.Core.FileStore
26import Development.IDE.Core.OfInterest
27import Development.IDE.Types.Logger
28import Development.Shake hiding (Diagnostic, Env, newCache)
29import Data.Either.Extra
30import qualified Language.Haskell.LSP.Messages as LSP
32import Development.IDE.Core.Shake
36newtype GlobalIdeOptions = GlobalIdeOptions IdeOptions
37instance IsIdeGlobal GlobalIdeOptions
39------------------------------------------------------------
40-- Exposed API
42-- | Initialise the Compiler Service.
43initialise :: Rules ()
44 -> (LSP.FromServerMessage -> IO ())
45 -> Logger
46 -> IdeOptions
47 -> VFSHandle
48 -> IO IdeState
49initialise mainRule toDiags logger options vfs =
50 shakeOpen
51 toDiags
52 logger
53 (setProfiling options $
54 shakeOptions { shakeThreads = optThreads options
55 , shakeFiles = "/dev/null"
56 }) $ do
57 addIdeGlobal $ GlobalIdeOptions options
58 fileStoreRules vfs
59 ofInterestRules
60 mainRule
62writeProfile :: IdeState -> FilePath -> IO ()
63writeProfile = shakeProfile
65setProfiling :: IdeOptions -> ShakeOptions -> ShakeOptions
66setProfiling opts shakeOpts =
67 maybe shakeOpts (\p -> shakeOpts { shakeReport = [p], shakeTimings = True }) (optShakeProfiling opts)
69-- | Shutdown the Compiler Service.
70shutdown :: IdeState -> IO ()
71shutdown = shakeShut
73-- This will return as soon as the result of the action is
74-- available. There might still be other rules running at this point,
75-- e.g., the ofInterestRule.
76runAction :: IdeState -> Action a -> IO a
77runAction ide action = do
78 bar <- newBarrier
79 res <- shakeRun ide [do v <- action; liftIO $ signalBarrier bar v; return v]
80 -- shakeRun might throw an exception (either through action or a default rule),
81 -- in which case action may not complete successfully, and signalBarrier might not be called.
82 -- Therefore we wait for either res (which propagates the exception) or the barrier.
83 -- Importantly, if the barrier does finish, cancelling res only kills waiting for the result,
84 -- it doesn't kill the actual work
85 fmap fromEither $ race (head <$> res) $ waitBarrier bar
88-- | `runActionSync` is similar to `runAction` but it will
89-- wait for all rules (so in particular the `ofInterestRule`) to
90-- finish running. This is mainly useful in tests, where you want
91-- to wait for all rules to fire so you can check diagnostics.
92runActionSync :: IdeState -> Action a -> IO a
93runActionSync s act = fmap head $ join $ shakeRun s [act]
95getIdeOptions :: Action IdeOptions
96getIdeOptions = do
97 GlobalIdeOptions x <- getIdeGlobalAction
98 return x