hiedb-plugin (empty) → 0.1.0

raw patch · 5 files changed

+195/−0 lines, 5 filesdep +basedep +directorydep +filepath

Dependencies added: base, directory, filepath, ghc, hiedb, stm

Files

• CHANGELOG.md +5/−0
• LICENSE +20/−0
• README.md +15/−0
• hiedb-plugin.cabal +49/−0
• src/Plugin/HieDb.hs +106/−0

@@ -0,0 +1,5 @@+# Revision history for hiedb-plugin++## 0.1.0.0 -- 2024-04-02++* Initial release

@@ -0,0 +1,20 @@+Copyright (c) 2024 Joseph Sumabat++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,15 @@+# hiedb-plugin++A GHC plugin which automatically re-indexes recompiled hie files into an [hiedb](https://github.com/wz1000/hiedb) SQLite database.++To use this plugin:++- add the `hiedb-plugin` package as a build dependency of your package++- add `ghc-options: -plugin-package hiedb-plugin -fplugin Plugin.Hiedb` to your package++Properties:+- Requires `-hiedir` to be set.+- Will index to `.hiedb`. Will likely be configurable in the futrue+- Currently skips type indexing for performance reasons. Will likely be+  configurable in the future

@@ -0,0 +1,49 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack++name:               hiedb-plugin+version:            0.1.0+synopsis:           See README on Github for more information+description:        Automatically index in hiedb on recompiliation+license:            MIT+license-file:       LICENSE+author:             Joseph Sumabat+maintainer:         josephrsumabat@gmail.com+category:           Development+homepage:           https://github.com/josephsumabat/hiedb-plugin#readme+bug-reports:        https://github.com/josephsumabat/hiedb-plugin/issues+build-type:         Simple+extra-source-files:+      CHANGELOG.md+      README.md++source-repository head+    type: git+    location: https://github.com/josephsumabat/hiedb-plugin++library+    exposed-modules:+          Plugin.HieDb+    other-modules:+          Paths_hiedb_plugin+    build-depends:+          base >=4.17.0 && <4.20+        , directory >=1.3.7 && <1.4+        , filepath >=1.4.1 && <1.5+        , ghc >=9.6.0 && <9.10+        , hiedb >=0.6.0.0 && <0.7.0.0+        , stm >=2.5.1.0 && <2.6.0.0+    hs-source-dirs:+          src+    default-extensions:+          FlexibleContexts+          LambdaCase+          NoFieldSelectors+          OverloadedRecordDot+          OverloadedStrings+          ScopedTypeVariables+    ghc-options: -Wall -fwrite-ide-info+    default-language: Haskell2010

@@ -0,0 +1,106 @@+{-# LANGUAGE GADTs #-}++module Plugin.HieDb (plugin) where++import Control.Concurrent.STM+import Control.Exception+import Control.Monad+import Data.IORef+import GHC+import GHC.Driver.Hooks+import GHC.Driver.Pipeline+import GHC.Driver.Pipeline.Phases+import GHC.Plugins as Plugins+import GHC.Types.Name.Cache+import HieDb.Create+import HieDb.Types+import System.Directory (doesPathExist, makeAbsolute)+import System.FilePath+import qualified System.IO.Unsafe as Unsafe++plugin :: Plugin+plugin =+  defaultPlugin+    { pluginRecompile = Plugins.purePlugin+    , driverPlugin = driver+    }++driver :: [CommandLineOption] -> HscEnv -> IO HscEnv+driver _ hscEnv = do+  initializeHiedb+  pure+    hscEnv+      { hsc_hooks =+          (hsc_hooks hscEnv)+            { runPhaseHook = Just phaseHook+            }+      }+ where+  initializeHiedb = liftIO $ withHieDb defaultHiedbFile initConn++  -- We index using a phase hook instead of typeCheckResultAction since+  -- the hie file can be written after that plugin phase+  phaseHook =+    PhaseHook $ \phase -> do+      case phase of+        T_HscPostTc _ modSummary _ _ _ -> do+          let dynFlags = hsc_dflags hscEnv+              hieDirectory = hieDir dynFlags+          _ <-+            liftIO $+              mapM+                (addModuleToDb defaultHiedbFile $ ms_mod modSummary)+                hieDirectory+          runPhase phase+        _ -> runPhase phase++addModuleToDb :: FilePath -> Module -> FilePath -> IO ()+addModuleToDb hiedbFile mod' hieBaseDir = do+  let+    -- Note: For performance reasons we intentionally skip the type+    -- indexing phase+    -- TODO: pass this in as a user defined option+    skipOptions = defaultSkipOptions{skipTypes = True}+    modToPath = moduleNameSlashes . moduleName++  let hieFile = hieBaseDir </> modToPath mod' -<.> ".hie"++  absoluteHieFile <- makeAbsolute hieFile+  hieExists <- doesPathExist absoluteHieFile+  when hieExists $ do+    _ <- withDbLock $ do+      nc <- newIORef =<< initNameCache 'a' []+      _ <-+        withHieDb+          hiedbFile+          (\conn -> runDbM nc $ addRefsFrom conn (Just ".") skipOptions absoluteHieFile)+          -- TODO: report this and maybe make configurable in future versions+          `catch` (\(_ :: SomeException) -> pure False)+      pure ()+    pure ()+ where+  acquireDbLock =+    liftIO $ atomically $ takeTMVar dbLock+  releaseDbLock =+    liftIO $ atomically $ putTMVar dbLock ()+  -- Safely use a db lock - ensure the lock is released if an exception occurs+  withDbLock :: IO () -> IO ()+  withDbLock fn = do+    bracket_+      acquireDbLock+      releaseDbLock+      fn++defaultHiedbFile :: String+defaultHiedbFile = ".hiedb"++-----------------------------------------------------+-- Since we cant pass state along through the phases we use unsafePerformIO+-- to define global mutable state+-----------------------------------------------------++-- | We need to ensure only one thread writes to the db at once since sqlite+-- only maintains one WAL file and will throw an error on concurrent writes+dbLock :: TMVar ()+dbLock = Unsafe.unsafePerformIO $ newTMVarIO ()+{-# NOINLINE dbLock #-}