fixups

haskell · Apr 30, 2022 · f39347a · f39347a
1 parent 80b640a
commit f39347a
Show file tree

Hide file tree

Showing 3 changed files with 15 additions and 26 deletions.
diff --git a/ghcide/src/Development/IDE/Core/Service.hs b/ghcide/src/Development/IDE/Core/Service.hs
@@ -38,7 +38,6 @@ import           Control.Monad
 import qualified Development.IDE.Core.FileExists as FileExists
 import qualified Development.IDE.Core.OfInterest as OfInterest
 import           Development.IDE.Core.Shake      hiding (Log)
-import           Development.IDE.Core.Shake
 import qualified Development.IDE.Core.Shake      as Shake
 import           Development.IDE.Types.Shake     (WithHieDb)
 import           System.Environment              (lookupEnv)

diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs
@@ -155,21 +155,6 @@ import qualified Focus
 import           GHC.Fingerprint
 import           Language.LSP.Types.Capabilities
 import           OpenTelemetry.Eventlog
-
-import           Control.Exception.Extra                hiding (bracket_)
-import           Data.Aeson                             (toJSON)
-import qualified Data.ByteString.Char8                  as BS8
-import           Data.Coerce                            (coerce)
-import           Data.Default
-import           Data.Foldable                          (for_, toList)
-import           Data.HashSet                           (HashSet)
-import qualified Data.HashSet                           as HSet
-import           Data.IORef.Extra                       (atomicModifyIORef'_,
-                                                         atomicModifyIORef_)
-import           Data.String                            (fromString)
-import           Data.Text                              (pack)
-import           Debug.Trace.Flags                      (userTracingEnabled)
-import qualified Development.IDE.Types.Exports          as ExportsMap
 import           HieDb.Types
 import           Ide.Plugin.Config
 import qualified Ide.PluginUtils                        as HLS
@@ -178,10 +163,8 @@ import           Language.LSP.Diagnostics
 import qualified Language.LSP.Server                    as LSP
 import           Language.LSP.Types
 import qualified Language.LSP.Types                     as LSP
-import           Language.LSP.Types.Capabilities
 import           Language.LSP.VFS
 import qualified "list-t" ListT
-import           OpenTelemetry.Eventlog
 import qualified StmContainers.Map                      as STM
 import           System.FilePath                        hiding (makeRelative)
 import           System.IO.Unsafe (unsafePerformIO)
@@ -641,10 +624,10 @@ shakeOpen recorder lspEnv defaultConfig logger debouncer
 
     checkParents <- optCheckParents
     for_ metrics $ \store -> do
-        let readValuesCounter = fromIntegral . countRelevantKeys checkParents . HMap.keys <$> readVar (state shakeExtras)
-            readDirtyKeys = fromIntegral . countRelevantKeys checkParents . HSet.toList <$> readIORef (dirtyKeys shakeExtras)
+        let readValuesCounter = fromIntegral . countRelevantKeys checkParents <$> getStateKeys shakeExtras
+            readDirtyKeys = fromIntegral . countRelevantKeys checkParents . HSet.toList <$> readTVarIO(dirtyKeys shakeExtras)
             readIndexPending = fromIntegral . HMap.size <$> readTVarIO (indexPending $ hiedbWriter shakeExtras)
-            readExportsMap = fromIntegral . HMap.size . getExportsMap <$> readVar (exportsMap shakeExtras)
+            readExportsMap = fromIntegral . HMap.size . getExportsMap <$> readTVarIO (exportsMap shakeExtras)
             readDatabaseCount = fromIntegral . countRelevantKeys checkParents . map fst <$> shakeGetDatabaseKeys shakeDb
             readDatabaseStep =  fromIntegral <$> shakeGetBuildStep shakeDb
 
@@ -666,7 +649,7 @@ startTelemetry db extras@ShakeExtras{..}
     IdeOptions{optCheckParents} <- getIdeOptionsIO extras
     checkParents <- optCheckParents
     regularly 1 $ do
-        observe countKeys . countRelevantKeys checkParents . map fst =<< (atomically . ListT.toList . STM.listT) state
+        observe countKeys . countRelevantKeys checkParents =<< getStateKeys extras
         readTVarIO dirtyKeys >>= observe countDirty . countRelevantKeys checkParents . HSet.toList
         shakeGetBuildStep db >>= observe countBuilds
 
@@ -675,6 +658,8 @@ startTelemetry db extras@ShakeExtras{..}
         regularly :: Seconds -> IO () -> IO (Async ())
         regularly delay act = async $ forever (act >> sleep delay)
 
+getStateKeys :: ShakeExtras -> IO [Key]
+getStateKeys = (fmap.fmap) fst . atomically . ListT.toList . STM.listT . state
 
 -- | Must be called in the 'Initialized' handler and only once
 shakeSessionInit :: Recorder (WithPriority Log) -> IdeState -> IO ()

diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs
@@ -11,12 +11,14 @@ module Development.IDE.Main
 ,testing
 ,Log(..)
 ) where
-import           Control.Concurrent.Extra              (withNumCapabilities)
+import           Control.Concurrent.Async              (async, waitCatch)
+import           Control.Concurrent.Extra              (killThread, withNumCapabilities)
 import           Control.Concurrent.STM.Stats          (atomically,
                                                         dumpSTMStats)
 import           Control.Exception.Safe                (SomeException, catchAny,
-                                                        displayException)
-import           Control.Monad.Extra                   (concatMapM, unless,
+                                                        displayException,
+                                                        onException)
+import           Control.Monad.Extra                   (concatMapM, join, unless,
                                                         when)
 import qualified Data.Aeson.Encode.Pretty              as A
 import           Data.Default                          (Default (def))
@@ -34,7 +36,8 @@ import           Data.Typeable                         (typeOf)
 import           Development.IDE                       (Action, GhcVersion (..),
                                                         Priority (Debug, Error), Rules,
                                                         ghcVersion,
-                                                        hDuplicateTo')
+                                                        hDuplicateTo',
+                                                        logInfo)
 import           Development.IDE.Core.Debouncer        (Debouncer,
                                                         newAsyncDebouncer)
 import           Development.IDE.Core.FileStore        (isWatchSupported)
@@ -479,6 +482,8 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
                     }
             ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig rules Nothing logger debouncer options hiedb hieChan Nothing
             shakeSessionInit (cmapWithPrio LogShake recorder) ide
+            registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing)
+            c ide
 
 expandFiles :: [FilePath] -> IO [FilePath]
 expandFiles = concatMapM $ \x -> do