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 +12/−1
- README.md +12/−75
- cabal-hoogle.cabal +65/−47
- src/Hoogle/Cabal.hs +3/−125
- src/Hoogle/Cabal/CmdOptions.hs +0/−59
- src/Hoogle/Cabal/Command.hs +71/−0
- src/Hoogle/Cabal/Command/ActAsSetup.hs +43/−0
- src/Hoogle/Cabal/Command/Common.hs +131/−0
- src/Hoogle/Cabal/Command/Generate.hs +179/−0
- src/Hoogle/Cabal/Command/Run.hs +45/−0
- src/Hoogle/Cabal/Command/Version.hs +23/−0
- src/Hoogle/Cabal/Logger.hs +34/−0
- test/IntegrationTest.hs +2/−2
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" ]