stackage-query 0.1.3 → 0.2.0
raw patch · 5 files changed
+151/−188 lines, 5 filesdep +bytestringdep +http-directorydep +simple-cmd
Dependencies added: bytestring, http-directory, simple-cmd, simple-cmd-args, unix
Files
- ChangeLog.md +5/−0
- Main.hs +104/−182
- README.md +26/−0
- Stackage/Types.hs +5/−1
- stackage-query.cabal +11/−5
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for stackage-query +## 0.2.0 -- 2019-05-08+- download yaml files directly from github instead of huge git repos+ (http-directory looks in stackage.org and then curl downloads raw github yaml)+- use simple-cmd-args+ ## 0.1.3 -- 2018-11-15 - bundle Stackage.Types from old stackage-types package - updates to build with Cabal-2 etc
Main.hs view
@@ -1,23 +1,26 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} +#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))+#else+import Control.Exception (bracket)+#endif import Control.Monad+import qualified Data.ByteString.Char8 as B import Data.Char (isDigit) import Data.List import qualified Data.Map.Strict (assocs, keys, lookup) import Data.Maybe-#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,11,1))-#else-import Data.Monoid-#endif+import Data.Semigroup ((<>)) import qualified Data.Set as Set import qualified Data.Text as T import Data.Version import Options.Applicative import System.Directory-import System.Exit import System.FilePath-import System.Process (rawSystem, readProcess)+import System.IO (hPutStrLn, stderr)+import System.Posix.IO (stdInput)+import System.Posix.Terminal (queryTerminal) import Text.ParserCombinators.ReadP (readP_to_S) import Stackage.Types hiding (unPackageName)@@ -25,21 +28,21 @@ import Data.Yaml hiding (Parser) import Distribution.Package (PackageName, unPackageName) import Distribution.Text (disp)--import Paths_stackage_query (version)+import Network.HTTP.Directory (httpManager, httpRedirect) -newtype Args = Args Command+import SimpleCmd (cmd_)+import SimpleCmdArgs -newtype ConsumerOption = ConsumerOption {threshold :: Int}+import Paths_stackage_query (version) data Snapshot = LatestNightly | LatestLTS | NightlySnap String | LtsSnap String | LtsMajor String instance Show Snapshot where show LatestNightly = "nightly" show LatestLTS = "lts"- show (NightlySnap date) = "nightly-" ++ date- show (LtsSnap ver) = "lts-" ++ ver- show (LtsMajor ver) = "lts-" ++ ver+ show (NightlySnap date) = "nightly-" <> date+ show (LtsSnap ver) = "lts-" <> ver+ show (LtsMajor ver) = "lts-" <> ver instance Read Snapshot where readsPrec _ "nightly" = [(LatestNightly,"")]@@ -61,124 +64,59 @@ show LTS = "lts-haskell" show Nightly = "stackage-nightly" -instance Read Project where- readsPrec _ "lts" = [(LTS,"")]- readsPrec _ "nightly" = [(Nightly,"")]- readsPrec _ _ = []- type Pkg = String -data Command = Config Snapshot- | Ghc Snapshot- | Core Snapshot- | Tools Snapshot (Maybe Pkg)- | Packages Snapshot- | Consumers ConsumerOption Snapshot- | Package Snapshot Pkg- | Users Snapshot Pkg- | Github Snapshot Pkg- | Constraints Snapshot Pkg- | Dependencies Snapshot Pkg- | Executables Snapshot Pkg- | Modules Snapshot Pkg- | Latest Project--consumeParser :: Parser ConsumerOption-consumeParser = ConsumerOption <$> option auto- (long "minimum" <> short 'm' <> metavar "THRESHOLD" <> value 5 <> help "Show packages with at least THRESHOLD consumers (default 5)")+consumeParser :: Parser Int+consumeParser =+ optionalWith auto 'm' "minimum" "THRESHOLD" "Show packages with at least THRESHOLD consumers (default 5)" 5 -parsePkg :: Pkg -> Parser Pkg-parsePkg lbl = strArgument $ metavar lbl+parsePkg :: Parser Pkg+parsePkg = strArg "PKG" parseSnap :: Parser Snapshot parseSnap = argument auto $ metavar "SNAP" -parseProject :: Parser Project-parseProject = argument auto $ metavar "PROJECT"--commandParser :: Parser Command-commandParser =- subparser $- command "package" (info (Package <$> parseSnap <*> parsePkg "PKG")- (progDesc "Show version of PKG in SNAP"))- <>- command "users" (info (Users <$> parseSnap <*> parsePkg "PKG")- (progDesc "Revdeps for PKG in SNAP"))- <>- command "github" (info (Github <$> parseSnap <*> parsePkg "PKG")- (progDesc "Stackage owners for PKG in SNAP"))- <>- command "constraints" (info (Constraints <$> parseSnap <*> parsePkg "PKG")- (progDesc "Stackage constraints for PKG in SNAP"))- <>- command "dependencies" (info (Dependencies <$> parseSnap <*> parsePkg "PKG")- (progDesc "Dependencies for PKG in SNAP"))- <>- command "executables" (info (Executables <$> parseSnap <*> parsePkg "PKG")- (progDesc "Executables of PKG in SNAP"))- <>- command "modules" (info (Modules <$> parseSnap <*> parsePkg "PKG")- (progDesc "Modules of PKG in SNAP"))- <>- command "latest" (info (Latest <$> parseProject)- (progDesc "Latest snap for PROJECT (nightly or lts)"))- <>- command "ghc" (info (Ghc <$> parseSnap)- (progDesc "GHC version for SNAP"))- <>- command "core" (info (Core <$> parseSnap)- (progDesc "GHC core libraries for SNAP"))- <>- command "tools" (info (Tools <$> parseSnap <*> optional (parsePkg "PKG"))- (progDesc "Tools for SNAP"))- <>- command "packages" (info (Packages <$> parseSnap)- (progDesc "All packages in SNAP"))- <>- command "consumers" (info (Consumers <$> consumeParser <*> parseSnap)- (progDesc "No of users of packages in SNAP"))- <>- command "config" (info (Config <$> parseSnap)- (progDesc "Download cabal.config file for SNAP"))--argsParser :: Parser Args-argsParser = Args <$> commandParser- main :: IO ()-main = do- cmd <- customExecParser (prefs showHelpOnEmpty)- (info (helper <*> versionOption <*> argsParser) $ progDesc "Stackage query tool")- run cmd- where- run (Args cmd) =- case cmd of- Config s -> stackageConfig s- Ghc s -> buildplanGHC s- Core s -> buildplanCore s- Tools s mpkg -> buildplanTools s mpkg- Packages s -> buildplanPackages s- Consumers opts s -> buildplanConsumers opts s- Package s pkg -> buildplanPackage s pkg- Users s pkgs -> buildplanUsers s pkgs- Github s pkg -> buildplanGithub s pkg- Constraints s pkg -> buildplanConstraints s pkg- Dependencies s pkg -> buildplanDependencies s pkg- Executables s pkg -> buildplanExecutables s pkg- Modules s pkg -> buildplanModules s pkg- Latest prj -> buildplanLatest prj-- versionOption =- infoOption- (showVersion version)- (long "version" <> help "Show version")+main =+ simpleCmdArgs (Just version) "Stackage query tool" "" $+ subcommands+ [ Subcommand "package" "Show version of PKG in SNAP" $+ buildplanPackage <$> parseSnap <*> parsePkg+ , Subcommand "users" "Revdeps for PKG in SNAP" $+ buildplanUsers <$> parseSnap <*> parsePkg+ , Subcommand "github" "Stackage owners for PKG in SNAP" $+ buildplanGithub <$> parseSnap <*> parsePkg+ , Subcommand "constraints" "Stackage constraints for PKG in SNAP" $+ buildplanConstraints <$> parseSnap <*> parsePkg+ , Subcommand "dependencies" "Dependencies for PKG in SNAP" $+ buildplanDependencies <$> parseSnap <*> parsePkg+ , Subcommand "executables" "Executables of PKG in SNAP" $+ buildplanExecutables <$> parseSnap <*> parsePkg+ , Subcommand "modules" "Modules of PKG in SNAP" $+ buildplanModules <$> parseSnap <*> parsePkg+ , Subcommand "latest" "Latest snap for PROJECT (nightly or lts)" $+ buildplanLatest <$> parseSnap+ , Subcommand "ghc" "GHC version for SNAP" $+ buildplanGHC <$> parseSnap+ , Subcommand "core" "GHC core libraries for SNAP" $+ buildplanCore <$> parseSnap+ , Subcommand "tools" "Tools for SNAP" $+ buildplanTools <$> parseSnap <*> optional parsePkg+ , Subcommand "packages" "All packages in SNAP" $+ buildplanPackages <$> parseSnap+ , Subcommand "consumers" "No of users of packages in SNAP" $+ buildplanConsumers <$> consumeParser <*> parseSnap+ , Subcommand "config" "Download cabal.config file for SNAP" $+ stackageConfig <$> parseSnap+ ] topurl :: String topurl = "https://www.stackage.org/" stackageConfig :: Snapshot -> IO () stackageConfig snap = do- let url = topurl ++ show snap </> "cabal.config"- system_ "curl" ["-L", "-O", url]+ let url = topurl </> show snap </> "cabal.config"+ cmd_ "curl" ["-L", "-O", url] getConfigDir :: IO FilePath getConfigDir = do@@ -192,19 +130,18 @@ configDir <- getConfigDir let projectDir = configDir </> show project haveProj <- doesDirectoryExist projectDir- unless haveProj $ cloneProject configDir project+ unless haveProj $ createDirectoryIfMissing False projectDir return projectDir -findBuildPlanYaml :: Snapshot -> IO FilePath-findBuildPlanYaml snap = do- dir <- getProjectDir $ snapProject snap- updateProject False dir- findSnap dir snap- getBuildPlan :: Snapshot -> IO BuildPlan getBuildPlan snap = do- ebp <- findBuildPlanYaml snap >>= decodeFileEither+ ebp <- findBuildPlanYaml >>= decodeFileEither either (error . prettyPrintParseException) return ebp+ where+ findBuildPlanYaml :: IO FilePath+ findBuildPlanYaml = do+ dir <- getProjectDir $ snapProject snap+ findSnap dir snap snapProject :: Snapshot -> Project snapProject LatestLTS = LTS@@ -216,15 +153,32 @@ findSnap dir snap = do fs <- sortProject . filter (show snap `isPrefixOf`) <$> getDirectoryContents dir if null fs- then error $ "Snap " ++ show snap ++ " not found"- else return (dir </> last fs)+ then downloadLatest+ else return $ dir </> last fs where sortProject :: [String] -> [String] sortProject = if snapProject snap == Nightly then sort- else map ((\v -> "lts-" ++ v ++ ".yaml") . showVersion) . sort . map (readVersion . takeBaseName . removePrefix "lts-")+ else map ((\v -> "lts-" <> v <.> "yaml") . showVersion) . sort . map (readVersion . takeBaseName . removePrefix "lts-") + downloadLatest :: IO FilePath+ downloadLatest = do+ latest <- latestSnap snap+ downloadSnap latest+ return $ dir </> show latest <.> "yaml"++ downloadSnap :: Snapshot -> IO ()+ downloadSnap snp = do+ let proj = snapProject snp+ withCurrentDirectory dir $ do+ tty <- queryTerminal stdInput+ let silent = if tty then ["-#"] else ["-s", "-S"]+ yaml = show snp <.> "yaml"+ url = "https://raw.githubusercontent.com/commercialhaskell" </> show proj </> "master" </> yaml+ hPutStrLn stderr $ "Downloading " <> yaml+ cmd_ "curl" $ silent ++ ["-O", url]+ readVersion :: String -> Version readVersion s = let vp = readP_to_S parseVersion s in@@ -233,48 +187,7 @@ (ver,"") -> ver _ -> giveup where- giveup = error $ "readVersion: failed to parse " ++ s--system :: String -> [String] -> IO String-system c args = removeTrailingNewline <$> readProcess c args ""- where- removeTrailingNewline :: String -> String- removeTrailingNewline "" = ""- removeTrailingNewline cs =- if last cs == '\n'- then init cs- else cs--system_ :: String -> [String] -> IO ()-system_ c args = do- ret <- rawSystem c args- case ret of- ExitSuccess -> return ()- ExitFailure n -> error $ "\"" ++ unwords (c:args) ++ "\" failed with exit code " ++ show n--git :: FilePath -> String -> [String] -> IO String-git dir cmd args =- system "git" $ ["-C", dir] ++ cmd:args--git_ :: FilePath -> String -> [String] -> IO ()-git_ dir cmd args =- system_ "git" $ ["-C", dir] ++ cmd:args--cloneProject :: FilePath -> Project -> IO ()-cloneProject dir proj = do- let url = "git://github.com/fpco" </> show proj- putStrLn $ "Cloning " ++ url- git_ dir "clone" [url]--updateProject :: Bool -> FilePath -> IO ()-updateProject verbose dir = do- msg <- shortLog- _ <- git dir "pull" ["-q"]- msg' <- shortLog- when (verbose && msg /= msg') $ putStrLn $ msg ++ " -> " ++ msg'- where- shortLog =- removePrefix "Checking in " . unwords . tail . words <$> git dir "log" ["--oneline", "-1"]+ giveup = error $ "readVersion: failed to parse " <> s buildplanGHC :: Snapshot -> IO () buildplanGHC snap = do@@ -283,7 +196,7 @@ putStrLn $ (showVersion . siGhcVersion) si showPkgVer :: (PackageName, Version) -> String-showPkgVer (p,v) = unPackageName p ++ " " ++ showVersion v+showPkgVer (p,v) = unPackageName p <> " " <> showVersion v buildplanCore :: Snapshot -> IO () buildplanCore snap = do@@ -301,16 +214,16 @@ bp <- getBuildPlan snap traverse_ (putStrLn . showPkgVer) $ Data.Map.Strict.assocs $ ppVersion <$> bpPackages bp -buildplanConsumers :: ConsumerOption -> Snapshot -> IO ()-buildplanConsumers opts snap = do+buildplanConsumers :: Int -> Snapshot -> IO ()+buildplanConsumers threshold snap = do bp <- getBuildPlan snap traverse_ putPkgConsumption $ Data.Map.Strict.assocs $ ppUsers <$> bpPackages bp where putPkgConsumption :: (PackageName, Set.Set PackageName) -> IO () putPkgConsumption (p, users) = do let n = length users- when (n >= threshold opts) $- putStrLn $ show n ++ " " ++ unPackageName p+ when (n >= threshold) $+ putStrLn $ show n <> " " <> unPackageName p evalPackageBuildPlan :: Snapshot -> Pkg -> (PackagePlan -> String) -> IO () evalPackageBuildPlan snap pkg expr = do@@ -330,14 +243,15 @@ buildplanGithub snap pkg = evalPackageBuildPlan snap pkg (unwords . Set.elems . Set.map T.unpack . ppGithubPings) -projectToSnap :: Project -> Snapshot-projectToSnap Nightly = LatestNightly-projectToSnap LTS = LatestLTS+latestSnap :: Snapshot -> IO Snapshot+latestSnap snap = do+ mgr <- httpManager+ latest <- httpRedirect mgr $ topurl </> show snap+ return $ maybe snap (read . B.unpack . B.tail) latest -buildplanLatest :: Project -> IO ()-buildplanLatest prj = do- latest <- findBuildPlanYaml (projectToSnap prj)- putStrLn $ takeBaseName latest+buildplanLatest :: Snapshot -> IO ()+buildplanLatest =+ latestSnap >=> print buildplanConstraints :: Snapshot -> Pkg -> IO () buildplanConstraints snap pkg =@@ -359,3 +273,11 @@ buildplanModules snap pkg = evalPackageBuildPlan snap pkg (unlines . map T.unpack . Set.toList. sdModules . ppDesc) +#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))+#else+withCurrentDirectory :: FilePath -> IO a -> IO a+withCurrentDirectory dir action =+ bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do+ setCurrentDirectory dir+ action+#endif
+ README.md view
@@ -0,0 +1,26 @@+[](https://travis-ci.org/juhp/stackage-query)+[](http://hackage.haskell.org/package/stackage-query)+[](http://stackage.org/lts/package/stackage-query)+[](http://stackage.org/nightly/package/stackage-query)++# Stackage-Query++Small tool that queries package metadata from Stackage snapshots+using the yaml files from stackage-nightly and lts-haskell.++Example usage:++```+$ stackage package lts pandoc+2.5+$ stackage core lts-12+<list of ghc library versions>+$ stackage packages lts-13.20 | wc -l+2322+$ stackage consumers lts-12 --minimum 500+867 text+$ stackage users nightly pandoc+pandoc pandoc-citeproc pandoc-csv2table pandoc-pyplot+$ stackage latest nightly+nightly-2019-05-07+```
Stackage/Types.hs view
@@ -30,7 +30,7 @@ , intersectVersionRanges ) where -import Control.Applicative ((<$>), (<*>), (<|>))+import Control.Applicative ((<|>)) import Control.Arrow ((&&&)) import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow, throwM)@@ -42,6 +42,10 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (fromMaybe)+#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))+#else+import Data.Monoid (Monoid)+#endif import Data.Semigroup (Semigroup, (<>)) import Data.Set (Set) import qualified Data.Set as Set
stackage-query.cabal view
@@ -1,7 +1,7 @@ name: stackage-query-version: 0.1.3-synopsis: Stackage package query-description: Tool to query package metadata in Stackage+version: 0.2.0+synopsis: Tool for querying Stackage+description: A commandline tool to query metadata of Stackage packages license: MIT license-file: LICENSE homepage: https://github.com/juhp/stackage-query@@ -11,9 +11,10 @@ copyright: 2017 Jens Petersen <juhpetersen@gmail.com> category: Distribution build-type: Simple-extra-source-files: ChangeLog.md+extra-source-files: ChangeLog.md, README.md cabal-version: >=1.10-tested-with: GHC == 7.10.3, GHC == 8.0.2+tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4,+ GHC == 8.6.5 source-repository head type: git@@ -24,17 +25,22 @@ build-depends: base >= 4.7 && < 5, Cabal >= 1.22, aeson,+ bytestring, containers, directory, exceptions >= 0.6, hashable,+ http-directory >= 0.1.2, filepath, optparse-applicative >= 0.13, process, safe, semigroups,+ simple-cmd,+ simple-cmd-args >= 0.1.1, text, time,+ unix, unordered-containers, vector, yaml