packages feed

cabal-hoogle 0.1.0.0 → 3.10.0.0

raw patch · 13 files changed

+620/−309 lines, 13 filesdep +Cabal-syntaxdep +cabal-installdep +co-log-coredep ~Cabaldep ~containersdep ~directoryPVP ok

version bump matches the API change (PVP)

Dependencies added: Cabal-syntax, cabal-install, co-log-core, hoogle, lens, time

Dependency ranges changed: Cabal, containers, directory, extra, filepath, regex-tdfa, silently, string-interpolate, tasty, tasty-hunit, text, transformers, typed-process

API changes (from Hackage documentation)

- Hoogle.Cabal.CmdOptions: CmdOptions :: Maybe Text -> Maybe Text -> FilePath -> Command -> CmdOptions
- Hoogle.Cabal.CmdOptions: CommandGenerate :: Command
- Hoogle.Cabal.CmdOptions: CommandRun :: [String] -> Command
- Hoogle.Cabal.CmdOptions: [cmdOptions_builddir] :: CmdOptions -> FilePath
- Hoogle.Cabal.CmdOptions: [cmdOptions_command] :: CmdOptions -> Command
- Hoogle.Cabal.CmdOptions: [cmdOptions_compiler] :: CmdOptions -> Maybe Text
- Hoogle.Cabal.CmdOptions: [cmdOptions_platform] :: CmdOptions -> Maybe Text
- Hoogle.Cabal.CmdOptions: data CmdOptions
- Hoogle.Cabal.CmdOptions: data Command
- Hoogle.Cabal.CmdOptions: instance GHC.Classes.Eq Hoogle.Cabal.CmdOptions.CmdOptions
- Hoogle.Cabal.CmdOptions: instance GHC.Classes.Eq Hoogle.Cabal.CmdOptions.Command
- Hoogle.Cabal.CmdOptions: instance GHC.Show.Show Hoogle.Cabal.CmdOptions.CmdOptions
- Hoogle.Cabal.CmdOptions: instance GHC.Show.Show Hoogle.Cabal.CmdOptions.Command
- Hoogle.Cabal.CmdOptions: readCmdOptions :: IO CmdOptions

Files

CHANGELOG.md view
@@ -1,5 +1,16 @@ # Revision history for cabal-hoogle -## 0.1.0.0 -- 2022-07-22+## 3.10.0.0 -- 2024-02-25++* Switch to Cabal 3.10+* Support GHC 9.4 and 9.6++## 0.2.0 -- 2022-08-22++Powered by `cabal-install` 3.8, the usage is greatly simplified. `cabal-hoogle`+now statically links `cabal-install` and `hoogle`. You no longer need to worry about+`Cabal` minor version mismatch and manual installation of hoogle.++## 0.1.0.0 -- 2022-07-23  * First version. Supports `cabal-hoogle generate` and `cabal-hoogle run`
README.md view
@@ -8,70 +8,34 @@  ## Installation -Compiling from source requires a minimum GHC version of 8.10. Having `cabal-hoogle` installed, you may use it on a wider range of GHC,-as long as the `Cabal` used to build `cabal-hoogle` and `cabal-install` match.--Step 1, run `cabal update` to make sure you are using the latest hackage index--Step 2, check the `Cabal` library version used by your cabal ```-cabal --version-```-It shows my cabal is using `3.6.3.0` of Cabal library. **`cabal-hoogle` requires at least Cabal 3.2**. Update it before continue.-```-cabal-install version 3.6.2.0-compiled using version 3.6.3.0 of the Cabal library -```--Step 3, use `cabal install` to install `cabal-hoogle` from Hackage, specifying the `Cabal` library version you fetched above.-```-cabal install --constraint="Cabal == 3.6.3.0" cabal-hoogle+git clone https://github.com/kokobd/cabal-hoogle.git+cd cabal-hoogle+cabal install exe:cabal-hoogle ```  ## Usage -### Prerequisite--#### Install Hoogle-Make sure `hoogle` is installed in your `$PATH`. You can do this by running `cabal install hoogle`--#### Enable Hoogle for Cabal-Make sure your `~/.cabal/config` has the following entries. (DON'T remove existing entries!) [Check the official docs](https://cabal.readthedocs.io/en/3.6/installing-packages.html) if you don't know where is your cabal's global configuration file +### Generate+Within your project, run:  ```-documentation: True-haddock-  hoogle: True-  html: True-```--Or, run this command in bash:-```-cabal user-config update -a "documentation: True-haddock-  hoogle: True-  html: True"+cabal-hoogle generate ``` -#### Build Project with Cabal--Then, run `cabal build all` on your project, so that cabal will build haddock and-hoogle files for your local packages and dependencies.--> NOTE: Adding `--enable-documentation --haddock-hoogle --haddock-html` to your build command won't work for dependencies as I tried.+This generates a hoogle database for all the local packages and their dependencies. -### Generate+You may specify targets, like below: ```-cabal-hoogle generate+cabal-hoogle generate exe:haskell-language-server hls-code-range-plugin ```--This generates the hoogle database. You will see logs very similar to `stack hoogle --rebuild`+See [Cabal Docs](https://cabal.readthedocs.io/en/3.8/cabal-commands.html#target-forms) for target syntax  ### Run Hoogle  With `cabal-hoogle run --`, extra arguments are passed directly to `hoogle`. -You may start a server like this:+You may start an http server like this: ``` cabal-hoogle run -- server --local --port 9000 ```@@ -83,31 +47,4 @@  ### More Options -Run `cabal-hoogle --help` to see more options. For example if you are using a non-default build dir (not `dist-newstyle`), or you have multiple GHC verisons on the same project.--Below is a complex example:-```-cabal-hoogle --compiler ghc-9.2.3 --platform "x86_64-linux" --builddir mydist generate-```--## FAQ--### Many packages missing documentation--If you see output like this when running `cabal-hoogle generate`-```-Packages missing documentation: ansi-terminal ansi-wl-pprint async base-orphans base16-bytestring base64-bytestring Cabal cabal-hoogle clock colour extra hashable haskell-src-exts haskell-src-meta optparse-applicative primitive regex-base regex-tdfa safe split string-interpolate syb text-conversions th-abstraction th-compat th-expand-syns th-lift th-lift-instances th-orphans th-reify-many transformers-compat typed-process unliftio-core utf8-string vector vector-stream-Found 27 warnings when processing items-```--Probably you haven't built dependencies with hoogle enabled. Check [prerequisites](#prerequisite) more carefully.--### Cabal version mismatch--Make sure to build `cabal-hoogle` with the exact same `Cabal` library as your `cabal-install`. You can use `cabal --version`-to check the version of `Cabal` library. See [Installation](#installation).--### Core libraries missing documentation--If you are on macOS or Windows, and using `ghcup`, your `ghc` probably doesn't come with docs.-See [this](https://gitlab.haskell.org/ghc/ghc/-/issues/20903) and [this](https://github.com/haskell/haskell-language-server/issues/208#issuecomment-1162169087) for details of the upstream issue.+Run `cabal-hoogle --help` to see more options.
cabal-hoogle.cabal view
@@ -1,8 +1,10 @@ cabal-version:      3.0 name:               cabal-hoogle-version:            0.1.0.0-synopsis:           Just like "stack hoogle", but for cabal projects-description:        This tool+version:            3.10.0.0+synopsis:           generate hoogle database for cabal project and dependencies+description:+  Please see the README on GitHub at <https://github.com/kokobd/cabal-hoogle>+ bug-reports:        https://github.com/kokobd/cabal-hoogle/issues license:            BSD-3-Clause author:             kokobd <contact@zelinf.net>@@ -12,55 +14,71 @@ category:           Development build-type:         Simple extra-source-files:-    CHANGELOG.md-    README.md+  CHANGELOG.md+  README.md +source-repository head+  type:     git+  location: https://github.com/kokobd/cabal-hoogle+ library-    build-depends:-        base >= 4.14 && < 5-      , Cabal >= 3.2.0.0 && < 4-      , containers ^>= 0.6.2.1-      , directory ^>= 1.3.6-      , filepath ^>= 1.4.2-      , optparse-applicative ^>= 0.17.0-      , regex-tdfa ^>= 1.3.1-      , string-interpolate ^>= 0.3.1.2-      , text ^>= 1.2.4-      , transformers ^>= 0.5.6-      , typed-process ^>= 0.2.10-      , extra ^>= 1.7.10-    default-language: Haskell2010-    ghc-options: -Wall-    hs-source-dirs: src-    default-extensions:-        OverloadedStrings-        QuasiQuotes-    exposed-modules:-        Hoogle.Cabal-        Hoogle.Cabal.CmdOptions+  build-depends:+    , base                  >=4.14     && <5+    , Cabal                 ^>=3.10+    , cabal-install         ^>=3.10+    , Cabal-syntax          ^>=3.10+    , co-log-core           >=0.2      && <0.4+    , containers            ^>=0.6.2.1+    , directory             ^>=1.3.6+    , extra                 ^>=1.7.10+    , filepath              ^>=1.4.2+    , hoogle                ^>=5.0.18+    , lens                  >=5        && <6+    , optparse-applicative  >=0.16     && <1+    , regex-tdfa            ^>=1.3.1+    , string-interpolate    ^>=0.3.1.2+    , text                  ^>=1.2.4   || ^>=2.0+    , time                  >=1.10     && <2+    , transformers          ^>=0.5.6   || ^>=0.6+    , typed-process         ^>=0.2.10 +  default-language:   Haskell2010+  ghc-options:        -Wall+  hs-source-dirs:     src+  default-extensions:+    OverloadedStrings+    QuasiQuotes++  exposed-modules:    Hoogle.Cabal+  other-modules:+    Hoogle.Cabal.Command+    Hoogle.Cabal.Command.ActAsSetup+    Hoogle.Cabal.Command.Common+    Hoogle.Cabal.Command.Generate+    Hoogle.Cabal.Command.Run+    Hoogle.Cabal.Command.Version+    Hoogle.Cabal.Logger+ executable cabal-hoogle-    main-is: Main.hs-    hs-source-dirs: app-    default-language: Haskell2010-    ghc-options: -threaded -rtsopts-    build-depends:-        base-      , cabal-hoogle+  main-is:          Main.hs+  hs-source-dirs:   app+  default-language: Haskell2010+  ghc-options:      -threaded -rtsopts+  build-depends:+    , base+    , cabal-hoogle  test-suite tests-  type:             exitcode-stdio-1.0-  default-language: Haskell2010-  hs-source-dirs:   test-  main-is:          Main.hs-  other-modules:-    IntegrationTest+  type:               exitcode-stdio-1.0+  default-language:   Haskell2010+  hs-source-dirs:     test+  main-is:            Main.hs+  other-modules:      IntegrationTest   build-depends:-      base+    , base     , cabal-hoogle-    , tasty ^>= 1.4.2.3-    , tasty-hunit ^>= 0.10.0.3-    , silently ^>= 1.2.5.2-  build-tool-depends:-    , tasty-discover:tasty-discover-    , hoogle:hoogle+    , silently      ^>=1.2.5.2+    , tasty         ^>=1.4.2.3+    , tasty-hunit   ^>=0.10.0.3++  build-tool-depends: tasty-discover:tasty-discover
src/Hoogle/Cabal.hs view
@@ -1,131 +1,9 @@-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}  module Hoogle.Cabal (main) where -import Control.Exception (catch, throw)-import Control.Monad (unless)-import Data.Bifunctor (Bifunctor (second))-import qualified Data.List.NonEmpty as NonEmpty-import qualified Data.List.NonEmpty.Extra as NonEmpty-import qualified Data.Map.Strict as Map-import Data.Maybe (catMaybes)-import Data.String.Interpolate (i)-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.IO as T-import Data.Traversable (forM)-import Distribution.InstalledPackageInfo (InstalledPackageInfo (haddockHTMLs, installedUnitId))-import Distribution.Simple.Configure (getPersistBuildConfig)-import Distribution.Simple.PackageIndex (allPackagesByName)-import Distribution.Types.LocalBuildInfo (LocalBuildInfo, installedPkgs, localPkgDescr)-import Distribution.Types.PackageDescription (PackageDescription (package))-import Distribution.Types.PackageId (pkgName)-import Distribution.Types.PackageName (PackageName, unPackageName)-import Hoogle.Cabal.CmdOptions-import System.Directory (createDirectoryIfMissing, createDirectoryLink, listDirectory, makeAbsolute, removeDirectoryLink, removeDirectoryRecursive, withCurrentDirectory)-import System.Exit (exitFailure)-import System.FilePath-import System.IO (stderr)-import System.IO.Error (isDoesNotExistError)-import System.Process.Typed-import Text.Regex.TDFA ((=~))-import Prelude hiding (log)+import Hoogle.Cabal.Command (executeCommand)+import Hoogle.Cabal.Logger (stdoutLogger)  main :: IO ()-main = do-  CmdOptions {..} <- readCmdOptions-  localPackagesDir <- findLocalPackagesBuildDir cmdOptions_compiler cmdOptions_platform cmdOptions_builddir-  let hoogleDir = localPackagesDir </> ".hoogle"-      hoogleLocalPackagesDir = hoogleDir </> "local"-      hoogleDependenciesDir = hoogleDir </> "dependencies"--  case cmdOptions_command of-    CommandGenerate -> do-      catch (removeDirectoryRecursive hoogleDir) $ \(err :: IOError) ->-        if isDoesNotExistError err then pure () else throw err-      createDirectoryIfMissing True hoogleLocalPackagesDir-      createDirectoryIfMissing True hoogleDependenciesDir-      localPackages <- symlinkLocalPackages localPackagesDir hoogleLocalPackagesDir-      let localPkgsName = fmap (pkgName . package . localPkgDescr) localPackages-      dependenciesName <- symlinkDependencies localPackages hoogleDependenciesDir-      let nameStrs = fmap unPackageName (localPkgsName <> dependenciesName)-      withCurrentDirectory hoogleDir $ do-        runProcess_ . proc "hoogle" $-          ["generate", databaseArg, "--local=local", "--local=dependencies"] ++ nameStrs-    CommandRun hoogleArgs -> do-      let hoogleArgs' = case hoogleArgs of-            (x : xs) -> x : databaseArg : xs-            [] -> [databaseArg]-      withCurrentDirectory hoogleDir . runProcess_ . proc "hoogle" $-        hoogleArgs'-  where-    databaseArg = "--database=all.hoo"--findLocalPackagesBuildDir ::-  -- | compiler-  Maybe Text ->-  -- | platform-  Maybe Text ->-  -- | cabal project build dir (often dist-newstyle)-  FilePath ->-  IO FilePath-findLocalPackagesBuildDir compiler platform projectBuildDir = do-  -- directory layout: dist-newstyle/build/x86_64-linux/ghc-9.2.3/$PACKAGE_NAME-  projectBuildDir' <- makeAbsolute projectBuildDir-  platformDir <- enterSubDir (projectBuildDir' </> "build") "platform" (fmap T.unpack platform)-  enterSubDir platformDir "compiler" (fmap T.unpack compiler)--exitOnError :: Text -> IO a-exitOnError log = do-  T.hPutStrLn stderr log-  exitFailure--enterSubDir :: FilePath -> Text -> Maybe FilePath -> IO FilePath-enterSubDir baseDir realm givenSubDir = do-  subDirs <- listDirectory baseDir-  case givenSubDir >>= (\d -> if d `notElem` subDirs then Just d else Nothing) of-    Just wrongSubDir -> exitOnError [i|specified #{realm} #{wrongSubDir} doesn't not exist, make sure to build first|]-    Nothing -> case selectSubDir subDirs givenSubDir of-      Just subDir -> pure $ baseDir </> subDir-      _ -> exitOnError [i|failed to guess #{realm}, please specify one|]-  where-    selectSubDir :: [FilePath] -> Maybe FilePath -> Maybe FilePath-    selectSubDir [exactlyOne] _ = Just exactlyOne-    selectSubDir _ given = given--symlinkLocalPackages :: FilePath -> FilePath -> IO [LocalBuildInfo]-symlinkLocalPackages localPackagesDir destDir = do-  localPackages <- filter (=~ packageNameRegex) <$> listDirectory localPackagesDir-  forM localPackages $ \pkg -> do-    catch (removeDirectoryLink (destDir </> pkg)) $ \(e :: IOError) ->-      if isDoesNotExistError e then pure () else throw e-    createDirectoryLink (localPackagesDir </> pkg) (destDir </> pkg)-    getPersistBuildConfig (localPackagesDir </> pkg)-  where-    packageNameRegex :: String =-      "[[:digit:]]*[[:alpha:]][[:alnum:]]*(-[[:digit:]]*[[:alpha:]][[:alnum:]]*)*-[0-9]+([.][0-9]+)*"--symlinkDependencies :: [LocalBuildInfo] -> FilePath -> IO [PackageName]-symlinkDependencies localPackages hoogleDependenciesDir = do-  let nameToPkgs =-        fmap (NonEmpty.nubOrdOn installedUnitId) . Map.fromListWith (<>) $-          concatMap collectDependenciesForPkg localPackages-  pkgs <- fmap catMaybes . forM (Map.toList nameToPkgs) $ \(name, allPkgs@(pkg NonEmpty.:| pkgs)) -> do-    unless (null pkgs) $-      T.putStrLn [i|Warning: package #{name} has more than 1 version installed, this should not happen. all pkgs: #{fmap installedUnitId allPkgs}|]-    case haddockHTMLs pkg of-      [htmlDir] -> pure $ Just (name, htmlDir)-      htmlDirs -> do-        T.putStrLn [i|Warning: package #{name} doesn't have exactly one haddock html directory, actual: #{htmlDirs}|]-        pure Nothing-  forM pkgs $ \(name, dir) -> do-    createDirectoryLink dir (hoogleDependenciesDir </> unPackageName name)-    pure name-  where-    collectDependenciesForPkg pkg =-      let depsWithName = allPackagesByName (installedPkgs pkg)-       in fmap (second (NonEmpty.:| []))-            . concatMap (\(name, pkgs) -> fmap (name,) pkgs)-            $ depsWithName+main = executeCommand stdoutLogger
− src/Hoogle/Cabal/CmdOptions.hs
@@ -1,59 +0,0 @@-module Hoogle.Cabal.CmdOptions-  ( CmdOptions (..),-    readCmdOptions,-    Command (..),-  )-where--import Data.Text (Text)-import Options.Applicative--data CmdOptions = CmdOptions-  { cmdOptions_compiler :: Maybe Text,-    cmdOptions_platform :: Maybe Text,-    cmdOptions_builddir :: FilePath,-    cmdOptions_command :: Command-  }-  deriving (Show, Eq)--data Command-  = CommandGenerate-  | CommandRun [String]-  deriving (Show, Eq)--parser :: Parser CmdOptions-parser =-  CmdOptions-    <$> (optional . strOption)-      ( long "compiler"-          <> help "compiler name and version, for example 'ghc-9.2.3'"-      )-    <*> (optional . strOption)-      ( long "platform"-          <> help "platform, for example x86_64-linux"-      )-    <*> strOption-      ( long "builddir"-          <> value "dist-newstyle"-          <> help "cabal project build dir"-      )-    <*> hsubparser-      ( command "generate" (info (pure CommandGenerate) (progDesc "generate hoogle database"))-          <> command "run" (info commandRunParser (progDesc "run hoogle, with arbitrary arguments"))-      )--commandRunParser :: Parser Command-commandRunParser = CommandRun <$> (many . strArgument) (metavar "ARGS")--readCmdOptions :: IO CmdOptions-readCmdOptions = execParser parserInfo-  where-    parserInfo =-      info-        (parser <**> helper)-        ( fullDesc-            <> progDesc-              ( "Run hoogle on your local packages and dependencies. "-                  <> "See https://github.com/kokobd/cabal-hoogle for more information"-              )-        )
+ src/Hoogle/Cabal/Command.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE RecordWildCards #-}++module Hoogle.Cabal.Command where++import qualified Hoogle.Cabal.Command.ActAsSetup as ActAsSetup+import Hoogle.Cabal.Command.Common+import qualified Hoogle.Cabal.Command.Generate as Generate+import qualified Hoogle.Cabal.Command.Run as Run+import qualified Hoogle.Cabal.Command.Version as Version+import Hoogle.Cabal.Logger+import Options.Applicative++data CmdOptions = CmdOptions+  { _cmdOptions_global :: GlobalOptions,+    _cmdOptions_command :: Maybe Command+  }+  deriving (Show, Eq)++data Command+  = CommandGenerate Generate.Command+  | CommandRun Run.Command+  | CommandActAsSetup ActAsSetup.Command+  | CommandVersion Version.Command+  deriving (Show, Eq)++data Log+  = LogGenerate Generate.Log+  | LogRun Run.Log++instance Show Log where+  show (LogGenerate l) = show l+  show (LogRun l) = show l++executeCommand :: Logger Log -> IO ()+executeCommand logger = do+  CmdOptions {..} <- readCmdOptions+  if _globalOptions_version _cmdOptions_global+    then Version.action Version.Command+    else case _cmdOptions_command of+      Nothing -> pure ()+      Just cmd' -> case cmd' of+        CommandGenerate cmd -> Generate.action (cmapLogger LogGenerate logger) _cmdOptions_global cmd+        CommandActAsSetup cmd -> ActAsSetup.action cmd+        CommandRun cmd -> Run.action (cmapLogger LogRun logger) _cmdOptions_global cmd+        CommandVersion cmd -> Version.action cmd++parser :: Parser CmdOptions+parser =+  CmdOptions+    <$> globalOptionsParser+    <*> optional+      ( hsubparser+          ( Generate.command CommandGenerate+              <> Run.command CommandRun+              <> Version.command CommandVersion+              <> ActAsSetup.command CommandActAsSetup+          )+      )++readCmdOptions :: IO CmdOptions+readCmdOptions = execParser parserInfo+  where+    parserInfo =+      info+        (parser <**> helper)+        ( fullDesc+            <> progDesc+              ( "Run hoogle on your local packages and dependencies. "+                  <> "See https://github.com/kokobd/cabal-hoogle for more information"+              )+        )
+ src/Hoogle/Cabal/Command/ActAsSetup.hs view
@@ -0,0 +1,43 @@+module Hoogle.Cabal.Command.ActAsSetup+  ( command,+    Command,+    action,+  )+where++import Data.Maybe (fromJust)+import qualified Distribution.Make as Make+import Distribution.Parsec (simpleParsec)+import qualified Distribution.Simple as Simple+import Distribution.Types.BuildType+import qualified Options.Applicative as OptParse++data Command = Command+  { _buildType :: String,+    _args :: [String]+  }+  deriving (Show, Eq)++command :: (Command -> a) -> OptParse.Mod OptParse.CommandFields a+command f =+  OptParse.command+    "act-as-setup"+    (OptParse.info (fmap f commandParser) (OptParse.progDesc "(Internal) Run as-if this was a Setup.hs"))++commandParser :: OptParse.Parser Command+commandParser =+  Command+    <$> OptParse.strOption (OptParse.long "build-type")+    <*> (OptParse.many . OptParse.strArgument) (OptParse.metavar "ARGS")++action :: Command -> IO ()+action (Command buildTypeStr args) =+  let bt = fromJust $ simpleParsec buildTypeStr -- TODO: report error properly+   in case bt of+        Simple -> Simple.defaultMainArgs args+        Configure ->+          Simple.defaultMainWithHooksArgs+            Simple.autoconfUserHooks+            args+        Make -> Make.defaultMainArgs args+        Custom -> error "actAsSetupAction Custom"
+ src/Hoogle/Cabal/Command/Common.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE RecordWildCards #-}++module Hoogle.Cabal.Command.Common+  ( GlobalOptions (..),+    globalOptionsParser,+    hoogleDatabaseArg,+    Context (..),+    readContext,+  )+where++import qualified Data.Map.Strict as Map+import Distribution.Client.CmdBuild (BuildFlags, defaultBuildFlags, selectComponentTarget, selectPackageTargets)+import Distribution.Client.CmdErrorMessages (renderCannotPruneDependencies, reportTargetProblems)+import Distribution.Client.DistDirLayout (distDirectory)+import Distribution.Client.NixStyleOptions+import Distribution.Client.ProjectOrchestration+import Distribution.Client.ScriptUtils+import Distribution.Client.Setup (GlobalFlags, InstallFlags (..), defaultGlobalFlags)+import Distribution.Simple (OptimisationLevel (NoOptimisation))+import Distribution.Simple.Setup (ConfigFlags (..), Flag (..), HaddockFlags (..))+import Distribution.Simple.Utils (die')+import qualified Distribution.Verbosity as Verbosity+import Options.Applicative+import System.FilePath ((</>))++data GlobalOptions = GlobalOptions+  { _globalOptions_builddir :: FilePath,+    _globalOptions_version :: Bool+  }+  deriving (Show, Eq)++globalOptionsParser :: Parser GlobalOptions+globalOptionsParser =+  GlobalOptions+    <$> strOption+      ( long "builddir"+          <> value "dist-newstyle/hoogle"+          <> help "Cabal project build dir"+      )+    <*> switch+      ( long "version"+          <> help "Print version"+      )++hoogleDatabaseArg :: String+hoogleDatabaseArg = "--database=all.hoo"++data Context = Context+  { _context_baseCtx :: ProjectBaseContext,+    _context_buildCtx :: ProjectBuildContext,+    _context_hoogleDir :: FilePath,+    _context_targetStrings :: [String],+    _context_flags :: NixStyleFlags BuildFlags,+    _context_globalFlags :: GlobalFlags+  }++-- | This is copied from the implementation of 'buildAction'+readContext ::+  GlobalOptions ->+  [String] ->+  IO Context+readContext GlobalOptions {..} targetStrings =+  withContextAndSelectors RejectNoTargets Nothing flags targetStrings' globalFlags HaddockCommand $ \targetCtx ctx targetSelectors -> do+    let targetAction = TargetActionBuild++    baseCtx <- case targetCtx of+      ProjectContext -> return ctx+      GlobalContext -> return ctx+      ScriptContext path exemeta -> updateContextAndWriteProjectFile ctx path exemeta++    let verbosity = Verbosity.normal+    buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do+      -- Interpret the targets on the command line as build targets+      -- (as opposed to say repl or haddock targets).+      targets <-+        either (reportTargetProblems verbosity "build") return $+          resolveTargets+            selectPackageTargets+            selectComponentTarget+            elaboratedPlan+            Nothing+            targetSelectors++      let elaboratedPlan' =+            pruneInstallPlanToTargets+              targetAction+              targets+              elaboratedPlan+      elaboratedPlan'' <-+        if buildSettingOnlyDeps (buildSettings baseCtx)+          then+            either (die' verbosity . renderCannotPruneDependencies) return $+              pruneInstallPlanToDependencies+                (Map.keysSet targets)+                elaboratedPlan'+          else return elaboratedPlan'++      return (elaboratedPlan'', targets)+    pure $+      Context+        baseCtx+        buildCtx+        (distDirectory (distDirLayout baseCtx) </> ".hoogle")+        targetStrings'+        flags+        globalFlags+  where+    defaultFlags = defaultNixStyleFlags defaultBuildFlags+    flags =+      defaultFlags+        { configFlags =+            (configFlags defaultFlags)+              { configOptimization = Flag NoOptimisation,+                configDistPref = Flag _globalOptions_builddir+              },+          haddockFlags =+            (haddockFlags defaultFlags)+              { haddockHoogle = Flag True,+                haddockHtml = Flag True,+                haddockLinkedSource = Flag True,+                haddockQuickJump = Flag True+              },+          installFlags =+            (installFlags defaultFlags)+              { installDocumentation = Flag True+              }+        }+    targetStrings' :: [String]+    targetStrings' = if null targetStrings then ["all"] else targetStrings+    globalFlags = defaultGlobalFlags
+ src/Hoogle/Cabal/Command/Generate.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}++module Hoogle.Cabal.Command.Generate+  ( Log,+    command,+    Command,+    action,+  )+where++import Control.Exception (catch, throw)+import Control.Monad (unless)+import Control.Monad.IO.Class+import Control.Monad.Trans.Maybe+import Data.Bifunctor (Bifunctor (second))+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.List.NonEmpty.Extra as NonEmpty+import qualified Data.Map.Strict as Map+import Data.Maybe (catMaybes)+import Data.String.Interpolate (i)+import qualified Data.Text as T+import Data.Traversable (forM)+import Distribution.Client.CmdBuild+  ( buildAction,+  )+import Distribution.Client.DistDirLayout (DistDirLayout (distBuildDirectory))+import qualified Distribution.Client.InstallPlan as InstallPlan+import Distribution.Client.ProjectOrchestration+  ( ProjectBaseContext (distDirLayout),+    ProjectBuildContext (elaboratedPlanToExecute, elaboratedShared, targetsMap),+  )+import Distribution.Client.ProjectPlanning (ElaboratedConfiguredPackage)+import Distribution.Client.ProjectPlanning.Types (elabDistDirParams)+import Distribution.InstalledPackageInfo (InstalledPackageInfo (haddockHTMLs, installedUnitId, pkgRoot))+import Distribution.Simple (UnitId)+import Distribution.Simple.Configure (ConfigStateFileError, tryGetPersistBuildConfig)+import Distribution.Simple.PackageIndex (allPackagesByName)+import Distribution.Types.LocalBuildInfo (LocalBuildInfo)+import qualified Distribution.Types.LocalBuildInfo as LocalBuildInfo+import qualified Distribution.Types.PackageDescription as PackageDescription+import qualified Distribution.Types.PackageId as PackageId+import Distribution.Types.PackageName (PackageName)+import qualified Distribution.Types.PackageName as PackageName+import qualified Hoogle+import Hoogle.Cabal.Command.Common (Context (..), GlobalOptions (..), hoogleDatabaseArg, readContext)+import Hoogle.Cabal.Logger+import qualified Options.Applicative as OptParse+import System.Directory+  ( createDirectoryIfMissing,+    createDirectoryLink,+    removeDirectoryLink,+    removeDirectoryRecursive,+    withCurrentDirectory,+  )+import System.FilePath+import System.IO.Error (isDoesNotExistError)+import Prelude hiding (log)++data Log+  = LogBadInstallPlan UnitId (Maybe (InstallPlan.GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage))+  | LogCanNotReadSetupConfig String ConfigStateFileError+  | LogPkgMoreThan1Version PackageName (NonEmpty UnitId)+  | LogPkgBadHaddockHtml PackageName [FilePath]++instance Show Log where+  show (LogBadInstallPlan unitId Nothing) = "can not find " <> show unitId <> " from install plan"+  show (LogBadInstallPlan unitId (Just (InstallPlan.PreExisting _))) = show unitId <> " is PreExisting"+  show (LogBadInstallPlan unitId (Just (InstallPlan.Configured _))) = show unitId <> " is Configured"+  show (LogBadInstallPlan unitId (Just (InstallPlan.Installed _))) = show unitId <> " is Installed"+  show (LogCanNotReadSetupConfig pkg configStateFileErr) =+    [i|Can not read setup-config file from #{pkg}, error: #{configStateFileErr}|]+  show (LogPkgMoreThan1Version pkgName unitIds) =+    [i|Warning: package #{pkgName} has more than 1 version installed, this should not happen. all pkgs: #{unitIds}|]+  show (LogPkgBadHaddockHtml name htmlDirs) =+    [i|Warning: package #{name} doesn't have exactly one haddock html directory, actual: #{htmlDirs}|]++newtype Command = Command+  { _targets :: [String]+  }+  deriving (Show, Eq)++command :: (Command -> a) -> OptParse.Mod OptParse.CommandFields a+command f =+  OptParse.command "generate" $+    OptParse.info+      (fmap f commandParser)+      (OptParse.progDesc "Generate hoogle database")++commandParser :: OptParse.Parser Command+commandParser =+  Command+    <$> (OptParse.many . OptParse.strArgument) (OptParse.metavar "TARGETS")++action :: Logger Log -> GlobalOptions -> Command -> IO ()+action logger globalOptions (Command targets) = do+  (Context baseCtx buildCtx hoogleDir targetStrings flags globalFlags) <- readContext globalOptions targets+  buildAction flags targetStrings globalFlags+  let targetIds = Map.keys (targetsMap buildCtx)+      installPlan = elaboratedPlanToExecute buildCtx+      hoogleLocalPackagesDir = hoogleDir </> "local"+      hoogleDependenciesDir = hoogleDir </> "dependencies"+  localPackages <- fmap catMaybes . forM targetIds $ \targetId ->+    let handlePkg pkg = pure . Just $ distBuildDirectory (distDirLayout baseCtx) $ elabDistDirParams (elaboratedShared buildCtx) pkg+     in case InstallPlan.lookup installPlan targetId of+          Just (InstallPlan.Installed pkg) -> handlePkg pkg+          Just (InstallPlan.Configured pkg) -> handlePkg pkg+          pkg -> do+            logWith logger Error (LogBadInstallPlan targetId pkg)+            pure Nothing+  catch (removeDirectoryRecursive hoogleDir) $ \(err :: IOError) ->+    if isDoesNotExistError err then pure () else throw err+  createDirectoryIfMissing True hoogleLocalPackagesDir+  createDirectoryIfMissing True hoogleDependenciesDir+  localPackagesBuildInfo <- symlinkLocalPackages logger localPackages hoogleLocalPackagesDir+  let localPkgsName = fmap fst localPackagesBuildInfo+  dependenciesName <- symlinkDependencies logger (fmap snd localPackagesBuildInfo) hoogleDependenciesDir+  let nameStrs = localPkgsName <> fmap PackageName.unPackageName dependenciesName+  withCurrentDirectory hoogleDir $+    Hoogle.hoogle $+      ["generate", hoogleDatabaseArg, "--local=local", "--local=dependencies"] ++ nameStrs++symlinkLocalPackages :: Logger Log -> [FilePath] -> FilePath -> IO [(String, LocalBuildInfo)]+symlinkLocalPackages logger pkgsPath destDir = do+  fmap catMaybes . forM pkgsPath $ \pkgPath -> runMaybeT $ do+    lbiEither <- liftIO $ tryGetPersistBuildConfig pkgPath+    lbi <- MaybeT $ case lbiEither of+      Left configStateFileErr -> do+        logWith logger Error $ LogCanNotReadSetupConfig pkgPath configStateFileErr+        pure Nothing+      Right lbi -> pure $ Just lbi+    let pkgName =+          PackageName.unPackageName+            . PackageId.pkgName+            . PackageDescription.package+            . LocalBuildInfo.localPkgDescr+            $ lbi+    liftIO $ catch (removeDirectoryLink (destDir </> pkgName)) $ \(e :: IOError) ->+      if isDoesNotExistError e then pure () else throw e+    liftIO $ createDirectoryLink pkgPath (destDir </> pkgName)+    pure (pkgName, lbi)++symlinkDependencies :: Logger Log -> [LocalBuildInfo] -> FilePath -> IO [PackageName]+symlinkDependencies logger localPackages hoogleDependenciesDir = do+  let nameToPkgs =+        fmap (NonEmpty.nubOrdOn installedUnitId) . Map.fromListWith (<>) $+          concatMap collectDependenciesForPkg localPackages+  pkgs <- fmap catMaybes . forM (Map.toList nameToPkgs) $ \(name, allPkgs@(pkg NonEmpty.:| pkgs)) -> do+    unless (null pkgs) $+      logWith logger Warning $+        LogPkgMoreThan1Version name (fmap installedUnitId allPkgs)+    case haddockHTMLs' pkg of+      [htmlDir] -> pure $ Just (name, htmlDir)+      htmlDirs -> do+        logWith logger Warning $ LogPkgBadHaddockHtml name htmlDirs+        pure Nothing+  forM pkgs $ \(name, dir) -> do+    createDirectoryLink dir (hoogleDependenciesDir </> PackageName.unPackageName name)+    pure name+  where+    collectDependenciesForPkg :: LocalBuildInfo -> [(PackageName, NonEmpty InstalledPackageInfo)]+    collectDependenciesForPkg pkg =+      let depsWithName = allPackagesByName (LocalBuildInfo.installedPkgs pkg)+       in fmap (second (NonEmpty.:| []))+            . concatMap (\(name, pkgs) -> fmap (name,) pkgs)+            $ depsWithName++haddockHTMLs' :: InstalledPackageInfo -> [FilePath]+haddockHTMLs' pkg =+  fmap+    ( case pkgRoot pkg of+        Nothing -> id+        Just pkgRoot' -> T.unpack . T.replace "${pkgroot}" (T.pack pkgRoot') . T.pack+    )+    . haddockHTMLs+    $ pkg
+ src/Hoogle/Cabal/Command/Run.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE RecordWildCards #-}++module Hoogle.Cabal.Command.Run+  ( Command,+    command,+    action,+    Log+  )+where++import qualified Hoogle+import Hoogle.Cabal.Command.Common (Context (..), GlobalOptions, hoogleDatabaseArg, readContext)+import Hoogle.Cabal.Logger+import qualified Options.Applicative as OptParse+import System.Directory (doesDirectoryExist, withCurrentDirectory)++newtype Command = Command+  { _hoogleArgs :: [String]+  }+  deriving (Show, Eq)++command :: (Command -> a) -> OptParse.Mod OptParse.CommandFields a+command f = OptParse.command "run" (OptParse.info (fmap f commandParser) (OptParse.progDesc "Run hoogle, with arbitrary arguments"))++commandParser :: OptParse.Parser Command+commandParser = Command <$> (OptParse.many . OptParse.strArgument) (OptParse.metavar "ARGS")++data Log = LogHoogleDirDoesNotExist++instance Show Log where+  show LogHoogleDirDoesNotExist = "please run 'cabal-hoogle generate' first"++action :: Logger Log -> GlobalOptions -> Command -> IO ()+action logger globalOptions Command {..} = do+  Context {..} <- readContext globalOptions []+  hoogleDirExists <- doesDirectoryExist _context_hoogleDir+  if not hoogleDirExists+    then logWith logger Error LogHoogleDirDoesNotExist+    else+      withCurrentDirectory _context_hoogleDir . Hoogle.hoogle $+        hoogleArgs'+  where+    hoogleArgs' = case _hoogleArgs of+      (x : xs) -> x : hoogleDatabaseArg : xs+      [] -> [hoogleDatabaseArg]
+ src/Hoogle/Cabal/Command/Version.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE CPP #-}++module Hoogle.Cabal.Command.Version+  ( Command (..),+    command,+    action,+  )+where++import qualified Options.Applicative as OptParse++data Command = Command+  deriving (Show, Eq)++command :: (Command -> a) -> OptParse.Mod OptParse.CommandFields a+command f =+  OptParse.command "version" $+    OptParse.info (pure (f Command)) (OptParse.progDesc "Show version")++action :: Command -> IO ()+action _ = do+  putStrLn $ "cabal-hoogle version " ++ VERSION_cabal_hoogle+  putStrLn $ "compiled using version " ++ VERSION_Cabal ++ " of the Cabal library"
+ src/Hoogle/Cabal/Logger.hs view
@@ -0,0 +1,34 @@+module Hoogle.Cabal.Logger+  ( Logger,+    cmapLogger,+    stdoutLogger,+    logWith,+    module Colog.Core,+  )+where++import Colog.Core+import Data.Time (getCurrentTime)+import Control.Monad.IO.Class++type Logger msg = LogAction IO (WithSeverity msg)++cmapLogger :: (a -> b) -> Logger b -> Logger a+cmapLogger f = cmap (fmap f)++stdoutLogger :: Show msg => Logger msg+stdoutLogger = LogAction $ \msg -> do+  -- cmap showMsg logStringStdout+  now <- getCurrentTime+  putStrLn $ showMsg now msg+  where+    showMsg time (WithSeverity msg severity) =+      "["+        ++ show severity+        ++ "]["+        ++ show time+        ++ "] "+        ++ show msg++logWith :: MonadIO m => Logger msg -> Severity -> msg -> m ()+logWith logger severity msg = liftIO $ unLogAction logger (WithSeverity msg severity)
test/IntegrationTest.hs view
@@ -18,7 +18,7 @@           wantResult `isInfixOf` output @? "actual output: " <> output    pure-    [ testCase' "test dependency doesn't work" ["testCase"] "No results found",+    [ testCase' "test dependency" ["testCase"] "Test.QuickCheck failingTestCase :: Result -> [String]",       testCase' "core library" ["lift"] "Control.Monad.Trans.Class lift",-      testCase' "non-core library" ["runProcess_"] "System.Process.Typed runProcess_"+      testCase' "non-core library" ["progDesc"] "Options.Applicative progDesc :: String -> InfoMod a"     ]