{-# LANGUAGE TypeFamilies #-}
module Development.IDE.Core.OfInterest(
ofInterestRules,
getFilesOfInterest,
getFilesOfInterestUntracked,
addFileOfInterest,
deleteFileOfInterest,
setFilesOfInterest,
kick, FileOfInterestStatus(..),
OfInterestVar(..),
scheduleGarbageCollection,
Log(..)
) where
import Control.Concurrent.Strict
import Control.Monad
import Control.Monad.IO.Class
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Proxy
import Development.IDE.Graph
import Control.Concurrent.STM.Stats (atomically,
modifyTVar')
import Data.Aeson (toJSON)
import qualified Data.ByteString as BS
import Data.Maybe (catMaybes)
import Development.IDE.Core.ProgressReporting
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake hiding (Log)
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.Plugin.Completions.Types
import Development.IDE.Types.Exports
import Development.IDE.Types.Location
import Development.IDE.Types.Options (IdeTesting (..))
import Development.IDE.Types.Shake (toKey)
import GHC.TypeLits (KnownSymbol)
import Ide.Logger (Pretty (pretty),
Priority (..),
Recorder,
WithPriority,
cmapWithPrio,
logWith)
import qualified Language.LSP.Protocol.Message as LSP
import qualified Language.LSP.Server as LSP
data Log = LogShake Shake.Log
deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Log -> ShowS
showsPrec :: Int -> Log -> ShowS
$cshow :: Log -> String
show :: Log -> String
$cshowList :: [Log] -> ShowS
showList :: [Log] -> ShowS
Show
instance Pretty Log where
pretty :: forall ann. Log -> Doc ann
pretty = \case
LogShake Log
msg -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
msg
newtype OfInterestVar = OfInterestVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))
instance IsIdeGlobal OfInterestVar
ofInterestRules :: Recorder (WithPriority Log) -> Rules ()
ofInterestRules :: Recorder (WithPriority Log) -> Rules ()
ofInterestRules Recorder (WithPriority Log)
recorder = do
OfInterestVar -> Rules ()
forall a. IsIdeGlobal a => a -> Rules ()
addIdeGlobal (OfInterestVar -> Rules ())
-> (Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> OfInterestVar)
-> Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> Rules ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> OfInterestVar
OfInterestVar (Var (HashMap NormalizedFilePath FileOfInterestStatus) -> Rules ())
-> Rules (Var (HashMap NormalizedFilePath FileOfInterestStatus))
-> Rules ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Var (HashMap NormalizedFilePath FileOfInterestStatus))
-> Rules (Var (HashMap NormalizedFilePath FileOfInterestStatus))
forall a. IO a -> Rules a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HashMap NormalizedFilePath FileOfInterestStatus
-> IO (Var (HashMap NormalizedFilePath FileOfInterestStatus))
forall a. a -> IO (Var a)
newVar HashMap NormalizedFilePath FileOfInterestStatus
forall k v. HashMap k v
HashMap.empty)
GarbageCollectVar -> Rules ()
forall a. IsIdeGlobal a => a -> Rules ()
addIdeGlobal (GarbageCollectVar -> Rules ())
-> (Var Bool -> GarbageCollectVar) -> Var Bool -> Rules ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var Bool -> GarbageCollectVar
GarbageCollectVar (Var Bool -> Rules ()) -> Rules (Var Bool) -> Rules ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Var Bool) -> Rules (Var Bool)
forall a. IO a -> Rules a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> IO (Var Bool)
forall a. a -> IO (Var a)
newVar Bool
False)
Recorder (WithPriority Log)
-> RuleBody IsFileOfInterest IsFileOfInterestResult -> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log) -> RuleBody k v -> Rules ()
defineEarlyCutoff ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) (RuleBody IsFileOfInterest IsFileOfInterestResult -> Rules ())
-> RuleBody IsFileOfInterest IsFileOfInterestResult -> Rules ()
forall a b. (a -> b) -> a -> b
$ (IsFileOfInterest
-> NormalizedFilePath
-> Action (Maybe ByteString, Maybe IsFileOfInterestResult))
-> RuleBody IsFileOfInterest IsFileOfInterestResult
forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, Maybe v))
-> RuleBody k v
RuleNoDiagnostics ((IsFileOfInterest
-> NormalizedFilePath
-> Action (Maybe ByteString, Maybe IsFileOfInterestResult))
-> RuleBody IsFileOfInterest IsFileOfInterestResult)
-> (IsFileOfInterest
-> NormalizedFilePath
-> Action (Maybe ByteString, Maybe IsFileOfInterestResult))
-> RuleBody IsFileOfInterest IsFileOfInterestResult
forall a b. (a -> b) -> a -> b
$ \IsFileOfInterest
IsFileOfInterest NormalizedFilePath
f -> do
Action ()
alwaysRerun
HashMap NormalizedFilePath FileOfInterestStatus
filesOfInterest <- Action (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterestUntracked
let foi :: IsFileOfInterestResult
foi = IsFileOfInterestResult
-> (FileOfInterestStatus -> IsFileOfInterestResult)
-> Maybe FileOfInterestStatus
-> IsFileOfInterestResult
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IsFileOfInterestResult
NotFOI FileOfInterestStatus -> IsFileOfInterestResult
IsFOI (Maybe FileOfInterestStatus -> IsFileOfInterestResult)
-> Maybe FileOfInterestStatus -> IsFileOfInterestResult
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath
f NormalizedFilePath
-> HashMap NormalizedFilePath FileOfInterestStatus
-> Maybe FileOfInterestStatus
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HashMap.lookup` HashMap NormalizedFilePath FileOfInterestStatus
filesOfInterest
fp :: ByteString
fp = IsFileOfInterestResult -> ByteString
summarize IsFileOfInterestResult
foi
res :: (Maybe ByteString, Maybe IsFileOfInterestResult)
res = (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
fp, IsFileOfInterestResult -> Maybe IsFileOfInterestResult
forall a. a -> Maybe a
Just IsFileOfInterestResult
foi)
(Maybe ByteString, Maybe IsFileOfInterestResult)
-> Action (Maybe ByteString, Maybe IsFileOfInterestResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString, Maybe IsFileOfInterestResult)
res
where
summarize :: IsFileOfInterestResult -> ByteString
summarize IsFileOfInterestResult
NotFOI = Word8 -> ByteString
BS.singleton Word8
0
summarize (IsFOI FileOfInterestStatus
OnDisk) = Word8 -> ByteString
BS.singleton Word8
1
summarize (IsFOI (Modified Bool
False)) = Word8 -> ByteString
BS.singleton Word8
2
summarize (IsFOI (Modified Bool
True)) = Word8 -> ByteString
BS.singleton Word8
3
newtype GarbageCollectVar = GarbageCollectVar (Var Bool)
instance IsIdeGlobal GarbageCollectVar
getFilesOfInterest :: IdeState -> IO( HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterest :: IdeState -> IO (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterest IdeState
state = do
OfInterestVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var <- IdeState -> IO OfInterestVar
forall a. IsIdeGlobal a => IdeState -> IO a
getIdeGlobalState IdeState
state
Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> IO (HashMap NormalizedFilePath FileOfInterestStatus)
forall a. Var a -> IO a
readVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var
setFilesOfInterest :: IdeState -> HashMap NormalizedFilePath FileOfInterestStatus -> IO ()
setFilesOfInterest :: IdeState
-> HashMap NormalizedFilePath FileOfInterestStatus -> IO ()
setFilesOfInterest IdeState
state HashMap NormalizedFilePath FileOfInterestStatus
files = do
OfInterestVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var <- IdeState -> IO OfInterestVar
forall a. IsIdeGlobal a => IdeState -> IO a
getIdeGlobalState IdeState
state
Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> HashMap NormalizedFilePath FileOfInterestStatus -> IO ()
forall a. Var a -> a -> IO ()
writeVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var HashMap NormalizedFilePath FileOfInterestStatus
files
getFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterestUntracked = do
OfInterestVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var <- Action OfInterestVar
forall a. (HasCallStack, IsIdeGlobal a) => Action a
getIdeGlobalAction
IO (HashMap NormalizedFilePath FileOfInterestStatus)
-> Action (HashMap NormalizedFilePath FileOfInterestStatus)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap NormalizedFilePath FileOfInterestStatus)
-> Action (HashMap NormalizedFilePath FileOfInterestStatus))
-> IO (HashMap NormalizedFilePath FileOfInterestStatus)
-> Action (HashMap NormalizedFilePath FileOfInterestStatus)
forall a b. (a -> b) -> a -> b
$ Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> IO (HashMap NormalizedFilePath FileOfInterestStatus)
forall a. Var a -> IO a
readVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var
addFileOfInterest :: IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO [Key]
addFileOfInterest :: IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO [Key]
addFileOfInterest IdeState
state NormalizedFilePath
f FileOfInterestStatus
v = do
OfInterestVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var <- IdeState -> IO OfInterestVar
forall a. IsIdeGlobal a => IdeState -> IO a
getIdeGlobalState IdeState
state
(Maybe FileOfInterestStatus
prev, HashMap NormalizedFilePath FileOfInterestStatus
files) <- Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> (HashMap NormalizedFilePath FileOfInterestStatus
-> IO
(HashMap NormalizedFilePath FileOfInterestStatus,
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)))
-> IO
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)
forall a b. Var a -> (a -> IO (a, b)) -> IO b
modifyVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var ((HashMap NormalizedFilePath FileOfInterestStatus
-> IO
(HashMap NormalizedFilePath FileOfInterestStatus,
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)))
-> IO
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus))
-> (HashMap NormalizedFilePath FileOfInterestStatus
-> IO
(HashMap NormalizedFilePath FileOfInterestStatus,
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)))
-> IO
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)
forall a b. (a -> b) -> a -> b
$ \HashMap NormalizedFilePath FileOfInterestStatus
dict -> do
let (Maybe FileOfInterestStatus
prev, HashMap NormalizedFilePath FileOfInterestStatus
new) = (Maybe FileOfInterestStatus
-> (Maybe FileOfInterestStatus, Maybe FileOfInterestStatus))
-> NormalizedFilePath
-> HashMap NormalizedFilePath FileOfInterestStatus
-> (Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)
forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HashMap.alterF (, FileOfInterestStatus -> Maybe FileOfInterestStatus
forall a. a -> Maybe a
Just FileOfInterestStatus
v) NormalizedFilePath
f HashMap NormalizedFilePath FileOfInterestStatus
dict
(HashMap NormalizedFilePath FileOfInterestStatus,
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus))
-> IO
(HashMap NormalizedFilePath FileOfInterestStatus,
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap NormalizedFilePath FileOfInterestStatus
new, (Maybe FileOfInterestStatus
prev, HashMap NormalizedFilePath FileOfInterestStatus
new))
if Maybe FileOfInterestStatus
prev Maybe FileOfInterestStatus -> Maybe FileOfInterestStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= FileOfInterestStatus -> Maybe FileOfInterestStatus
forall a. a -> Maybe a
Just FileOfInterestStatus
v
then do
Recorder (WithPriority Log) -> Priority -> Log -> IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith (IdeState -> Recorder (WithPriority Log)
ideLogger IdeState
state) Priority
Debug (Log -> IO ()) -> Log -> IO ()
forall a b. (a -> b) -> a -> b
$
[(NormalizedFilePath, FileOfInterestStatus)] -> Log
LogSetFilesOfInterest (HashMap NormalizedFilePath FileOfInterestStatus
-> [(NormalizedFilePath, FileOfInterestStatus)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap NormalizedFilePath FileOfInterestStatus
files)
[Key] -> IO [Key]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [IsFileOfInterest -> NormalizedFilePath -> Key
forall k. ShakeValue k => k -> NormalizedFilePath -> Key
toKey IsFileOfInterest
IsFileOfInterest NormalizedFilePath
f]
else [Key] -> IO [Key]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO [Key]
deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO [Key]
deleteFileOfInterest IdeState
state NormalizedFilePath
f = do
OfInterestVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var <- IdeState -> IO OfInterestVar
forall a. IsIdeGlobal a => IdeState -> IO a
getIdeGlobalState IdeState
state
HashMap NormalizedFilePath FileOfInterestStatus
files <- Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> (HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus)
-> IO (HashMap NormalizedFilePath FileOfInterestStatus)
forall a. Var a -> (a -> a) -> IO a
modifyVar' Var (HashMap NormalizedFilePath FileOfInterestStatus)
var ((HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus)
-> IO (HashMap NormalizedFilePath FileOfInterestStatus))
-> (HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus)
-> IO (HashMap NormalizedFilePath FileOfInterestStatus)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath
-> HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete NormalizedFilePath
f
Recorder (WithPriority Log) -> Priority -> Log -> IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith (IdeState -> Recorder (WithPriority Log)
ideLogger IdeState
state) Priority
Debug (Log -> IO ()) -> Log -> IO ()
forall a b. (a -> b) -> a -> b
$
[(NormalizedFilePath, FileOfInterestStatus)] -> Log
LogSetFilesOfInterest (HashMap NormalizedFilePath FileOfInterestStatus
-> [(NormalizedFilePath, FileOfInterestStatus)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap NormalizedFilePath FileOfInterestStatus
files)
[Key] -> IO [Key]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [IsFileOfInterest -> NormalizedFilePath -> Key
forall k. ShakeValue k => k -> NormalizedFilePath -> Key
toKey IsFileOfInterest
IsFileOfInterest NormalizedFilePath
f]
scheduleGarbageCollection :: IdeState -> IO ()
scheduleGarbageCollection :: IdeState -> IO ()
scheduleGarbageCollection IdeState
state = do
GarbageCollectVar Var Bool
var <- IdeState -> IO GarbageCollectVar
forall a. IsIdeGlobal a => IdeState -> IO a
getIdeGlobalState IdeState
state
Var Bool -> Bool -> IO ()
forall a. Var a -> a -> IO ()
writeVar Var Bool
var Bool
True
kick :: Action ()
kick :: Action ()
kick = do
[NormalizedFilePath]
files <- HashMap NormalizedFilePath FileOfInterestStatus
-> [NormalizedFilePath]
forall k v. HashMap k v -> [k]
HashMap.keys (HashMap NormalizedFilePath FileOfInterestStatus
-> [NormalizedFilePath])
-> Action (HashMap NormalizedFilePath FileOfInterestStatus)
-> Action [NormalizedFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterestUntracked
ShakeExtras{TVar ExportsMap
exportsMap :: TVar ExportsMap
$sel:exportsMap:ShakeExtras :: ShakeExtras -> TVar ExportsMap
exportsMap, $sel:ideTesting:ShakeExtras :: ShakeExtras -> IdeTesting
ideTesting = IdeTesting Bool
testing, Maybe (LanguageContextEnv Config)
lspEnv :: Maybe (LanguageContextEnv Config)
$sel:lspEnv:ShakeExtras :: ShakeExtras -> Maybe (LanguageContextEnv Config)
lspEnv, ProgressReporting
progress :: ProgressReporting
$sel:progress:ShakeExtras :: ShakeExtras -> ProgressReporting
progress} <- Action ShakeExtras
getShakeExtras
let signal :: KnownSymbol s => Proxy s -> Action ()
signal :: forall (s :: Symbol). KnownSymbol s => Proxy s -> Action ()
signal Proxy s
msg = Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
testing (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$
Maybe (LanguageContextEnv Config) -> LspT Config IO () -> IO ()
forall (m :: * -> *) c.
Applicative m =>
Maybe (LanguageContextEnv c) -> LspT c m () -> m ()
mRunLspT Maybe (LanguageContextEnv Config)
lspEnv (LspT Config IO () -> IO ()) -> LspT Config IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
SServerMethod ('Method_CustomMethod s)
-> MessageParams ('Method_CustomMethod s) -> LspT Config IO ()
forall (m :: Method 'ServerToClient 'Notification) (f :: * -> *)
config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification (Proxy s -> SServerMethod ('Method_CustomMethod s)
forall {f :: MessageDirection} {t :: MessageKind} (s :: Symbol).
KnownSymbol s =>
Proxy s -> SMethod ('Method_CustomMethod s)
LSP.SMethod_CustomMethod Proxy s
msg) (MessageParams ('Method_CustomMethod s) -> LspT Config IO ())
-> MessageParams ('Method_CustomMethod s) -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$
[String] -> Value
forall a. ToJSON a => a -> Value
toJSON ([String] -> Value) -> [String] -> Value
forall a b. (a -> b) -> a -> b
$ (NormalizedFilePath -> String) -> [NormalizedFilePath] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map NormalizedFilePath -> String
fromNormalizedFilePath [NormalizedFilePath]
files
Proxy "kick/start" -> Action ()
forall (s :: Symbol). KnownSymbol s => Proxy s -> Action ()
signal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @"kick/start")
IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ ProgressReporting -> ProgressEvent -> IO ()
progressUpdate ProgressReporting
progress ProgressEvent
KickStarted
[Maybe ModGuts]
results <- GenerateCore -> [NormalizedFilePath] -> Action [Maybe ModGuts]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f (Maybe v))
uses GenerateCore
GenerateCore [NormalizedFilePath]
files
Action [Maybe ModGuts]
-> Action [Maybe HieAstResult] -> Action [Maybe ModGuts]
forall a b. Action a -> Action b -> Action a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* GetHieAst -> [NormalizedFilePath] -> Action [Maybe HieAstResult]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f (Maybe v))
uses GetHieAst
GetHieAst [NormalizedFilePath]
files
Action [Maybe ModGuts]
-> Action [Maybe CachedCompletions] -> Action [Maybe ModGuts]
forall a b. Action a -> Action b -> Action a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* NonLocalCompletions
-> [NormalizedFilePath] -> Action [Maybe CachedCompletions]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f (Maybe v))
uses NonLocalCompletions
NonLocalCompletions [NormalizedFilePath]
files
let mguts :: [ModGuts]
mguts = [Maybe ModGuts] -> [ModGuts]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ModGuts]
results
Action () -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar ExportsMap -> (ExportsMap -> ExportsMap) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar ExportsMap
exportsMap ([ModGuts] -> ExportsMap -> ExportsMap
updateExportsMapMg [ModGuts]
mguts)
IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ ProgressReporting -> ProgressEvent -> IO ()
progressUpdate ProgressReporting
progress ProgressEvent
KickCompleted
GarbageCollectVar Var Bool
var <- Action GarbageCollectVar
forall a. (HasCallStack, IsIdeGlobal a) => Action a
getIdeGlobalAction
Bool
garbageCollectionScheduled <- IO Bool -> Action Bool
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Action Bool) -> IO Bool -> Action Bool
forall a b. (a -> b) -> a -> b
$ Var Bool -> IO Bool
forall a. Var a -> IO a
readVar Var Bool
var
Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
garbageCollectionScheduled (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
Action [Key] -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Action [Key]
garbageCollectDirtyKeys
IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Var Bool -> Bool -> IO ()
forall a. Var a -> a -> IO ()
writeVar Var Bool
var Bool
False
Proxy "kick/done" -> Action ()
forall (s :: Symbol). KnownSymbol s => Proxy s -> Action ()
signal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @"kick/done")