packages feed

hsinspect 0.0.5 → 0.0.6

raw patch · 4 files changed

+33/−96 lines, 4 filesdep +ghcflags

Dependencies added: ghcflags

Files

hsinspect.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name:          hsinspect-version:       0.0.5+version:       0.0.6 synopsis:      Inspect Haskell source files. license:       GPL-3.0-or-later license-file:  LICENSE@@ -18,6 +18,11 @@  -- https://www.haskell.org/cabal/users-guide/cabal-projectindex.html +flag ghcflags+  description: Generate .ghc.flags files during compilation+  manual:      True+  default:     False+ common deps   build-depends:     , base        >=4.11 && <5@@ -29,13 +34,14 @@    ghc-options:      -Wall -Werror=missing-home-modules   default-language: Haskell2010+  if flag(ghcflags)+    ghc-options: -fplugin GhcFlags.Plugin+    build-depends: ghcflags  executable hsinspect   import:         deps   hs-source-dirs: exe-  build-depends:-    , hsinspect-+  build-depends:  hsinspect   main-is:        Main.hs   ghc-options:    -threaded @@ -48,7 +54,6 @@     HsInspect.Imports     HsInspect.Modules     HsInspect.Packages-    HsInspect.Plugin     HsInspect.Search     HsInspect.Sexp     HsInspect.Util
library/HsInspect/Modules.hs view
@@ -20,6 +20,7 @@  modules :: GHC.GhcMonad m => [String] -> m [Hit] modules homeModules = do+  -- TODO where is base?   dflags <- GHC.getSessionDynFlags   let Just dbs = GHC.pkgDatabase dflags       loaded = Set.fromList . explicitPackages $ GHC.pkgState dflags
− library/HsInspect/Plugin.hs 
@@ -1,74 +0,0 @@--- | A ghc plugin that creates a .ghc.flags file populated with the flags that---   were last used to invoke ghc for some modules, for consumption by---   hsinspect.------   https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/extending_ghc.html#compiler-plugins-module HsInspect.Plugin-  ( plugin,-  )-where--import qualified Config as GHC-import Control.Monad (when)-import Control.Monad.IO.Class (liftIO)-import Data.Foldable (traverse_)-import Data.List (stripPrefix)-import qualified GHC-import qualified GhcPlugins as GHC-import System.Directory (doesDirectoryExist)-import System.Environment-import System.IO.Error (catchIOError)--plugin :: GHC.Plugin-plugin =-  GHC.defaultPlugin-    { GHC.installCoreToDos = install,-      GHC.pluginRecompile = GHC.purePlugin-    }--install :: [GHC.CommandLineOption] -> [GHC.CoreToDo] -> GHC.CoreM [GHC.CoreToDo]-install _ core = do-  dflags <- GHC.getDynFlags-  args <- liftIO $ getArgs--  -- downstream tools shouldn't use this plugin, or all hell will break loose-  let ghcFlags = unwords $ replace ["-fplugin", "HsInspect.Plugin"] [] args--      -- TODO this currently only supports ghc being called with directories and-      -- home modules, we should also support calling with explicit file names.-      paths = GHC.importPaths dflags--      -- TODO we might want to filter out some include directories, e.g. build tool-      -- autogen folders.-      writeGhcFlags path =-        whenM (doesDirectoryExist path)-          $ writeFile (path <> "/.ghc.flags") ghcFlags--      enable = case GHC.hscTarget dflags of-        GHC.HscInterpreted -> False-        GHC.HscNothing -> False-        _ -> True--  when enable $ liftIO . ignoreIOExceptions $ do-    traverse_ writeGhcFlags paths-    writeFile ".ghc.version" GHC.cProjectVersion--  pure core---- from Data.List.Extra-replace :: Eq a => [a] -> [a] -> [a] -> [a]-replace [] _ _ = error "Extra.replace, first argument cannot be empty"-replace from to xs | Just xs' <- stripPrefix from xs = to ++ replace from to xs'-replace from to (x : xs) = x : replace from to xs-replace _ _ [] = []---- from Control.Monad.Extra-whenM :: Monad m => m Bool -> m () -> m ()-whenM b t = ifM b t (return ())--ifM :: Monad m => m Bool -> m a -> m a -> m a-ifM b t f = do b' <- b; if b' then t else f---- from System.Directory.Internal-ignoreIOExceptions :: IO () -> IO ()-ignoreIOExceptions io = io `catchIOError` (\_ -> pure ())
library/HsInspect/Search.hs view
@@ -15,6 +15,7 @@ import Control.Monad import Control.Monad.IO.Class import Data.List (isSuffixOf)+import Data.Set (Set) import qualified Data.Set as Set import qualified GHC import GHC.PackageDb@@ -22,47 +23,51 @@ import HsInspect.Util import HscTypes (ModIface (..)) import Json+import qualified Name as GHC import PackageConfig import Packages (explicitPackages) import TcRnMonad (initTcRnIf)  search :: GHC.GhcMonad m => String -> m [Hit]-search query = do-  liftIO . putStrLn . show $ "SEARCH: " <> query+search _query = do   -- TODO support home modules+  -- TODO where is base?   dflags <- GHC.getSessionDynFlags    -- TODO this logic is used in Packages / Modules, share   let Just ((snd =<<) -> allPkgs) = GHC.pkgDatabase dflags       explicit = Set.fromList . explicitPackages $ GHC.pkgState dflags       pkgs = filter (\(packageConfigId -> pid) -> Set.member pid explicit) allPkgs-  symbols <- join <$> traverse getSymbols pkgs-  pure $ Hit <$> symbols+  join <$> traverse getSymbols pkgs   -- ^ TODO filter and rank the symbols by the search  -- TODO Maybe haddock-html-getSymbols :: GHC.GhcMonad m => PackageConfig -> m [String]+getSymbols :: GHC.GhcMonad m => PackageConfig -> m [Hit] getSymbols pkg = do-  let findHis dir = do-        liftIO . putStrLn . show $ "WALKING: " <> dir-        filter (".hi" `isSuffixOf`) <$> liftIO (walk dir)+  let findHis dir = filter (".hi" `isSuffixOf`) <$> liftIO (walk dir)+      exposed = Set.fromList $ fst <$> exposedModules pkg   his <- join <$> traverse findHis (importDirs pkg)-  join <$> traverse hiToSymbols his+  join <$> traverse (hiToSymbols exposed) his --- TODO filter out hidden modules-hiToSymbols :: GHC.GhcMonad m => FilePath -> m [String]-hiToSymbols hi = do-  liftIO . putStrLn . show $ "PARSING: " <> hi+hiToSymbols :: GHC.GhcMonad m => Set GHC.ModuleName -> FilePath -> m [Hit]+hiToSymbols exposed hi = do   env <- GHC.getSession   iface <-     liftIO $ initTcRnIf 'z' env () ()       $ readBinIface IgnoreHiWay QuietBinIFaceReading hi-  pure [show . length $ mi_exports iface]+  let m = mi_module iface+  pure+    $ if not $ Set.member (GHC.moduleName m) exposed+      then []+      else do+        -- FIXME the Name is not very useful, use loadDecls+        decl <- GHC.getName . snd <$> mi_decls iface+        pure $ Hit m decl -data Hit = Hit String+data Hit = Hit GHC.Module GHC.Name  instance ToSexp Hit where-  toSexp (Hit txt) = toSexp txt+  toSexp (Hit _ name) = toSexp . GHC.getOccString $ name  instance ToJson Hit where-  json (Hit txt) = JSString txt+  json (Hit _ name) = JSString . GHC.getOccString $ name