diff --git a/flake.lock b/flake.lock new file mode 100644 index 00000000..9fec6564 --- /dev/null +++ b/flake.lock @@ -0,0 +1,95 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1731533236, + "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "hdeps": { + "inputs": { + "flake-utils": [ + "flake-utils" + ], + "nixpkgs": "nixpkgs" + }, + "locked": { + "lastModified": 1765585071, + "narHash": "sha256-xfmgF1NUMKbr5Bia//ztU0yZaSKlf379xZC5MWtrvlc=", + "owner": "LightAndLight", + "repo": "hdeps", + "rev": "132878c7ac2bfa749b962424e6001159cef20f7f", + "type": "github" + }, + "original": { + "owner": "LightAndLight", + "repo": "hdeps", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1756159630, + "narHash": "sha256-ohMvsjtSVdT/bruXf5ClBh8ZYXRmD4krmjKrXhEvwMg=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "84c256e42600cb0fdf25763b48d28df2f25a0c8b", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "nixpkgs_2": { + "locked": { + "lastModified": 1768569498, + "narHash": "sha256-bB6Nt99Cj8Nu5nIUq0GLmpiErIT5KFshMQJGMZwgqUo=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "be5afa0fcb31f0a96bf9ecba05a516c66fcd8114", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "hdeps": "hdeps", + "nixpkgs": "nixpkgs_2" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 00000000..d79cba0d --- /dev/null +++ b/flake.nix @@ -0,0 +1,38 @@ +{ + inputs = { + flake-utils.url = "github:numtide/flake-utils"; + hdeps = { + url = "github:LightAndLight/hdeps"; + inputs.flake-utils.follows = "flake-utils"; + }; + }; + outputs = { self, nixpkgs, flake-utils, hdeps }: + { + overlays.default = final: prev: { + haskellPackages = + (prev.haskellPackages.extend (import ./nix/generated/overlay.nix)).extend (hfinal: hprev: { + hoogle = prev.haskell.lib.dontHaddock (hprev.callPackage ./hoogle.nix {}); + }); + }; + } // + flake-utils.lib.eachDefaultSystem (system: + let + pkgs = import nixpkgs { inherit system; }; + in { + devShell = pkgs.mkShell { + buildInputs = with pkgs; [ + # C + clang-tools clang gdb + + # Haskell + ghc cabal-install haskell-language-server + + # Project + just haskellPackages.fourmolu cabal2nix hdeps.packages.${system}.default haskellPackages.implicit-hie + + zlib + ]; + }; + } + ); +} diff --git a/hoogle.cabal b/hoogle.cabal index 9890961c..5ba673ea 100644 --- a/hoogle.cabal +++ b/hoogle.cabal @@ -1,7 +1,7 @@ cabal-version: 1.18 build-type: Simple name: hoogle -version: 5.0.19.0 +version: 5.0.20.0 license: BSD3 license-file: LICENSE category: Development diff --git a/hoogle.nix b/hoogle.nix new file mode 100644 index 00000000..5198372f --- /dev/null +++ b/hoogle.nix @@ -0,0 +1,34 @@ +{ mkDerivation, aeson, ansi-terminal, base, binary, blaze-html +, blaze-markup, bytestring, Cabal-syntax, cmdargs, conduit +, conduit-extra, containers, crypton-connection, data-default-class +, deepseq, directory, extra, filepath, ghc-lib-parser +, hackage-revdeps, hashable, haskell-src-exts, http-conduit +, http-types, js-flot, js-jquery, lib, mmap, old-locale +, process-extras, QuickCheck, resourcet, safe, storable-tuple, tar +, template-haskell, temporary, text, time, transformers, uniplate +, utf8-string, vector, wai, wai-logger, warp, warp-tls, zlib +}: +mkDerivation { + pname = "hoogle"; + version = "5.0.20.0"; + src = ./.; + isLibrary = true; + isExecutable = true; + enableSeparateDataOutput = true; + libraryHaskellDepends = [ + aeson ansi-terminal base binary blaze-html blaze-markup bytestring + Cabal-syntax cmdargs conduit conduit-extra containers + crypton-connection data-default-class deepseq directory extra + filepath ghc-lib-parser hackage-revdeps hashable haskell-src-exts + http-conduit http-types js-flot js-jquery mmap old-locale + process-extras QuickCheck resourcet safe storable-tuple tar + template-haskell temporary text time transformers uniplate + utf8-string vector wai wai-logger warp warp-tls zlib + ]; + executableHaskellDepends = [ base ]; + testFlags = [ "--no-net" ]; + homepage = "https://hoogle.haskell.org/"; + description = "Haskell API Search"; + license = lib.licenses.bsd3; + mainProgram = "hoogle"; +} diff --git a/nix/generated/hackage-revdeps/default.nix b/nix/generated/hackage-revdeps/default.nix new file mode 100644 index 00000000..ae212592 --- /dev/null +++ b/nix/generated/hackage-revdeps/default.nix @@ -0,0 +1,21 @@ +{ mkDerivation, alfred-margaret, ansi-terminal, base, bytestring +, Cabal, cabal-install, Cabal-syntax, callPackage, containers +, filepath, lib, optparse-applicative, tar, text, time, zlib +}: +mkDerivation { + pname = "hackage-revdeps"; + version = "0.3"; + src = callPackage ./src.nix {}; + isLibrary = true; + isExecutable = true; + libraryHaskellDepends = [ + alfred-margaret base bytestring Cabal-syntax containers filepath + tar text time zlib + ]; + executableHaskellDepends = [ + ansi-terminal base Cabal cabal-install Cabal-syntax containers + filepath optparse-applicative time + ]; + description = "List Hackage reverse dependencies"; + license = lib.licenses.bsd3; +} diff --git a/nix/generated/hackage-revdeps/src.nix b/nix/generated/hackage-revdeps/src.nix new file mode 100644 index 00000000..393ca241 --- /dev/null +++ b/nix/generated/hackage-revdeps/src.nix @@ -0,0 +1,5 @@ +{ fetchzip }: +fetchzip { + url = "https://hackage.haskell.org/package/hackage-revdeps/hackage-revdeps-0.3.tar.gz"; + sha256 = "1v4b7nb36hcz0wvi3qvrchzp09h26pbfky80m4m8yp4mnmg9wzrg"; +} diff --git a/nix/generated/overlay.nix b/nix/generated/overlay.nix new file mode 100644 index 00000000..d30c4afd --- /dev/null +++ b/nix/generated/overlay.nix @@ -0,0 +1,3 @@ +self: super: { + hackage-revdeps = self.callPackage ./hackage-revdeps {}; +} diff --git a/nix/hdeps.json b/nix/hdeps.json new file mode 100644 index 00000000..ed83b83d --- /dev/null +++ b/nix/hdeps.json @@ -0,0 +1,6 @@ +{ + "hackage-revdeps": { + "type": "hackage", + "version": "0.3" + } +} diff --git a/src/Input/Cabal.hs b/src/Input/Cabal.hs index 6180fe06..e011e5bc 100644 --- a/src/Input/Cabal.hs +++ b/src/Input/Cabal.hs @@ -11,6 +11,7 @@ module Input.Cabal( import Input.Settings import Data.List.Extra +import Data.Map (Map) import System.FilePath import Control.DeepSeq import Control.Exception.Extra @@ -20,7 +21,6 @@ import General.Str import System.Exit import qualified System.Process.ByteString as BS import qualified Data.ByteString.UTF8 as UTF8 -import System.Directory import Data.Maybe import Data.Tuple.Extra import qualified Data.Map.Strict as Map @@ -30,14 +30,20 @@ import Control.Applicative import Prelude import Distribution.Compat.Lens (toListOf) +import qualified Distribution.InstalledPackageInfo as IPI +import Distribution.Package (packageId, UnitId, pkgName) import qualified Distribution.PackageDescription as PD import qualified Distribution.PackageDescription.Configuration as PD import qualified Distribution.PackageDescription.Parsec as PD import qualified Distribution.Pretty +import Distribution.Text (display) import qualified Distribution.Types.BuildInfo.Lens as Lens -import Distribution.Types.PackageName (mkPackageName, unPackageName) -import Distribution.Types.Version (versionNumbers) -import Distribution.Utils.ShortText (fromShortText) +import Distribution.Types.LibraryVisibility (LibraryVisibility(..)) +import Distribution.Types.PackageDescription (license') +import Distribution.Types.PackageId (pkgVersion) +import Distribution.Types.PackageName (unPackageName) +import Distribution.Types.Version (Version, versionNumbers) +import Distribution.Utils.ShortText (ShortText, fromShortText) import Hackage.RevDeps (lastVersionsOfPackages) import qualified Distribution.SPDX as SPDX @@ -72,6 +78,7 @@ instance NFData Package where -- | Given a set of packages, return the popularity of each package, along with any warnings -- about packages imported but not found. + packagePopularity :: Map.Map PkgName Package -> ([String], Map.Map PkgName Int) packagePopularity cbl = mp `seq` (errs, mp) where @@ -89,7 +96,6 @@ packagePopularity cbl = mp `seq` (errs, mp) -- | Run 'ghc-pkg' and get a list of packages which are installed. readGhcPkg :: Settings -> IO (Map.Map PkgName Package) readGhcPkg settings = do - topdir <- findExecutable "ghc-pkg" (exit, stdout, stderr) <- -- From GHC 9.0.1, the `haddock-html` field in `*.conf` files for GHC boot -- libraries has used `${pkgroot}`, which can be expanded in the output. @@ -111,14 +117,60 @@ readGhcPkg settings = do BS.readProcessWithExitCode "ghc-pkg" ["dump", "--expand-pkgroot"] mempty when (exit /= ExitSuccess) $ errorIO $ "Error when reading from ghc-pkg, " ++ show exit ++ "\n" ++ UTF8.toString stderr - let g (stripPrefix "$topdir" -> Just x) | Just t <- topdir = takeDirectory t ++ x - -- ^ Backwards compatibility with GHC < 9.0 - g x = x - let fixer p = p{packageLibrary = True, packageDocs = g <$> packageDocs p} - let f ((stripPrefix "name: " -> Just x):xs) = Just (mkPackageName $ trimStart x, fixer $ readCabal settings $ bstrPack $ unlines xs) - f _ = Nothing - pure $ Map.fromList $ mapMaybe f $ splitOn ["---"] $ lines $ filter (/= '\r') $ UTF8.toString stdout + installedPackages <- parsePackages stdout + + pure $ + Map.fromList + [ ( pkgName $ packageId installedPackage + , fromInstalledPackage settings installedPackages installedPackage + ) + | (_unitId, installedPackage) <- Map.toList installedPackages + ] + where + parsePackages :: UTF8.ByteString -> IO (Map UnitId IPI.InstalledPackageInfo) + parsePackages input = + Map.fromList . fmap ((,) <$> IPI.installedUnitId <*> id) . catMaybes <$> + traverse + (\input -> + case IPI.parseInstalledPackageInfo . bstrPack $ unlines input of + Left errors -> do + mapM_ (\msg -> putStrLn $ "error (parsing ghc-pkg output): " ++ msg) errors + pure Nothing + Right (warnings, package) -> do + mapM_ (\msg -> putStrLn $ "warning (parsing ghc-pkg output): " ++ msg) warnings + pure $ Just package + ) + (splitOn ["---"] . lines . filter (/= '\r') $ UTF8.toString input) + +fromInstalledPackage :: + Settings -> + Map UnitId IPI.InstalledPackageInfo -> + IPI.InstalledPackageInfo -> + Package +fromInstalledPackage settings installedPackages ipi = Package{..} + where + pkgId = packageId ipi + + packageDepends = + fmap + (\unitId -> + maybe + (error $ display unitId ++ " missing from installed packages") (pkgName . packageId) + (Map.lookup unitId installedPackages) + ) + (IPI.depends ipi) + packageVersion = mkPackageVersion $ pkgVersion pkgId + packageSynopsis = strPack $ fromShortText $ IPI.synopsis ipi + packageLibrary = IPI.libVisibility ipi == LibraryVisibilityPublic + packageDocs = listToMaybe $ IPI.haddockHTMLs ipi + + packageLicenses = mkPackageLicenses . license' $ IPI.license ipi + packageCategories = mkPackageCategories $ IPI.category ipi + packageAuthor = fromShortText $ IPI.author ipi + packageMaintainer = fromShortText $ IPI.maintainer ipi + + packageTags = mkPackageTags settings packageLicenses packageCategories [packageAuthor, packageMaintainer] -- | Given a tarball of Cabal files, parse the latest version of each package. parseCabalTarball :: Settings -> FilePath -> IO (Map.Map PkgName Package) @@ -143,38 +195,59 @@ readCabal settings src = case PD.parseGenericPackageDescriptionMaybe src of Just gpd -> readCabal' settings gpd readCabal' :: Settings -> PD.GenericPackageDescription -> Package -readCabal' Settings{..} gpd = Package{..} +readCabal' settings gpd = Package{..} where pd = PD.flattenPackageDescription gpd pkgId = PD.package pd packageDepends = nubOrd $ foldMap (map (\(PD.Dependency pkg _ _) -> pkg) . PD.targetBuildDepends) $ toListOf Lens.traverseBuildInfos gpd - packageVersion = strPack $ intercalate "." $ map show $ versionNumbers $ PD.pkgVersion pkgId + packageVersion = mkPackageVersion $ PD.pkgVersion pkgId packageSynopsis = strPack $ fromShortText $ PD.synopsis pd packageLibrary = PD.hasPublicLib pd packageDocs = Nothing - unpackLicenseExpression (SPDX.EOr x y) = unpackLicenseExpression x ++ unpackLicenseExpression y - unpackLicenseExpression x = [x] + packageLicenses = mkPackageLicenses $ PD.license pd + packageCategories = mkPackageCategories $ PD.category pd + packageAuthor = fromShortText $ PD.author pd + packageMaintainer = fromShortText $ PD.maintainer pd - packageLicenses = case PD.license pd of + packageTags = mkPackageTags settings packageLicenses packageCategories [packageAuthor, packageMaintainer] + +mkPackageVersion :: Version -> Str +mkPackageVersion = strPack . intercalate "." . map show . versionNumbers + +mkPackageLicenses :: SPDX.License -> [String] +mkPackageLicenses license = + case license of SPDX.NONE -> [] SPDX.License licExpr -> map (show . Distribution.Pretty.pretty) $ unpackLicenseExpression licExpr - packageCategories = - filter (not . null) $ split (`elem` " ,") $ - fromShortText $ PD.category pd - packageAuthor = fromShortText $ PD.author pd - packageMaintainer = fromShortText $ PD.maintainer pd - - packageTags = map (both strPack) $ nubOrd $ concat - [ map ("license",) packageLicenses - , map ("category",) packageCategories - , map ("author",) (concatMap cleanup [packageAuthor, packageMaintainer]) - ] + where + unpackLicenseExpression (SPDX.EOr x y) = unpackLicenseExpression x ++ unpackLicenseExpression y + unpackLicenseExpression x = [x] - -- split on things like "," "&" "and", then throw away email addresses, replace spaces with "-" and rename - cleanup = - filter (/= "") . - map (renameTag . intercalate "-" . filter ('@' `notElem`) . words . takeWhile (`notElem` "<(")) . - concatMap (map unwords . split (== "and") . words) . split (`elem` ",&") +mkPackageCategories :: ShortText -> [String] +mkPackageCategories = filter (not . null) . split (`elem` " ,") . fromShortText + +mkPackageTags :: + Settings -> + -- | Licenses + [String] -> + -- | Categories + [String] -> + -- | Authors + [String] -> + [(Str, Str)] +mkPackageTags settings licenses categories authors = + map (both strPack) $ nubOrd $ concat + [ map ("license",) licenses + , map ("category",) categories + , map ("author",) (concatMap (cleanup settings) authors) + ] + +-- split on things like "," "&" "and", then throw away email addresses, replace spaces with "-" and rename +cleanup :: Settings -> String -> [String] +cleanup Settings{..} = + filter (/= "") . + map (renameTag . intercalate "-" . filter ('@' `notElem`) . words . takeWhile (`notElem` "<(")) . + concatMap (map unwords . split (== "and") . words) . split (`elem` ",&")