binNMUs: add capability for JSON output format (d619cc2e) · Commits · Debian Haskell Group / tools

AcquireFile.hs→binnmus/AcquireFile.hs

+0 −0

File moved.

binnmus/binNMUs.cabal

+3 −0

Original line number	Diff line number	Diff line
		@@ -16,6 +16,8 @@ executable binNMUs
		main-is: binNMUs.hs
		other-modules: AcquireFile
		build-depends: base >=4.10 && <5
		, aeson
		, aeson-pretty
		, bytestring
		, containers
		, debian
		@@ -25,6 +27,7 @@ executable binNMUs
		, lzma
		, optparse-applicative
		, parallel
		, postgresql-simple
		, process
		, regex-pcre
		, split

binnmus/binNMUs.hs

+63 −16

Original line number	Diff line number	Diff line
		@@ -35,6 +35,8 @@ import Control.Seq
		import GHC.Generics (Generic)
		import Control.DeepSeq
		import Data.Foldable (for_)
		import qualified Data.Aeson as A
		import Data.Aeson.Encode.Pretty (encodePretty)


		import Database.PostgreSQL.Simple hiding (Binary)
		@@ -87,6 +89,22 @@ data Reason
		type BinNMU = (Binary, [Reason])
		type CBinNMU = (Status, ((SourceName, Version), Arch, [Reason]))

		data JBinNMU = JBinNMU
		{ _pkg :: String
		, _ver :: String
		, _arches :: [String]
		, _suite :: String
		, _reason :: String
		} deriving Generic

		customOptions = A.defaultOptions
		{ A.fieldLabelModifier = drop 1
		}

		instance A.ToJSON JBinNMU where
		toJSON = A.genericToJSON customOptions
		toEncoding = A.genericToEncoding customOptions

		data Binary = Binary
		{ bPkgName :: String
		, bSourceName :: SourceName
		@@ -102,7 +120,8 @@ instance NFData Binary
		-- The main action

		run :: Conf -> IO ()
		run conf = do
		run conf = case outputFormat conf of
		WannaBuild -> do
		printHeader conf
		when (not (sql conf) && distribution conf /= "sid") $ do
		putCLn $ "When reading data via HTTP, only sid is supported"
		@@ -116,7 +135,14 @@ run conf = do
		let cBinNMUs = concat cBinNMUss
		doPresentProblems conf cBinNMUs
		presentBinNMUs conf cBinNMUs

		JSON -> do
		when (not (sql conf) && distribution conf /= "sid") $ do
		exitFailure
		rms <- fetchWnppDump conf
		cBinNMUss <- mapM (getNMUs conf rms) (arches conf)
		let cBinNMUs = concat cBinNMUss
		json = encodePretty (finalizeBinNMUs conf cBinNMUs)
		BL.putStr $ json

		printHeader :: Conf -> IO ()
		printHeader conf = do
		@@ -197,6 +223,17 @@ presentBinNMUs conf cBinNMUs = do
		]
		putStrLn ""

		finalizeBinNMUs :: Conf -> [CBinNMU] -> [JBinNMU]
		finalizeBinNMUs conf cBinNMUs =
		let needed = filter (actStatus . fst) cBinNMUs
		binNMUs = map snd needed
		grouped = sortBy (compare `on` (^. _1)) $ groupNMUs conf binNMUs
		in concatMap transformNMUs grouped
		where
		transformNMUs :: ([(SourceName, Version)], [Arch], [Reason]) -> [JBinNMU]
		transformNMUs (svs, as, rs) = map (\(s,v) -> transformNMU s v as (distribution conf) (rstr rs)) svs
		rstr = intercalate ", " . map formatReason
		transformNMU = JBinNMU

		groupNMUs :: (Ord a, Ord b, Ord c) => Conf -> [(a, b, c)] -> [([a], [b], c)]
		groupNMUs conf =
		@@ -547,6 +584,8 @@ fetchWnppDump conf = do
		wnppRegex = makeRegex "^(.*): RM"


		data OutputFormat = WannaBuild \| JSON
		deriving (Bounded, Enum, Eq, Read, Show)

		-- Option parsing
		data Conf = Conf
		@@ -561,9 +600,10 @@ data Conf = Conf
		, sql :: Bool
		, groupPkgs :: Bool
		, presentProblems :: Bool
		, outputFormat :: OutputFormat
		}

		mkConf :: String -> [Arch] -> String -> Maybe Int -> Bool -> Bool -> Bool -> Bool -> Bool -> Conf
		mkConf :: String -> [Arch] -> String -> Maybe Int -> Bool -> Bool -> Bool -> Bool -> Bool -> OutputFormat -> Conf
		mkConf d a r p =
		Conf d a (makeRegex ("^"++r++"$")) (makeRegex r) r p

		@@ -625,6 +665,13 @@ conf = mkConf
		long "present-problems" <>
		help "list all problems (changed dependencies etc.)"
		)
		<*> option auto (
		long "output-format" <>
		help "output as WannaBuild or JSON" <>
		metavar "FORMAT" <>
		showDefault <>
		value WannaBuild
		)

		haskellRegex :: String
		haskellRegex = "libghc-(.*)-dev-([0-9.]+)-([0-9a-f]{5})"