koji-tool 0.8.1 → 0.8.2
raw patch · 8 files changed
+68/−85 lines, 8 filesdep +formattingdep −format-numbers
Dependencies added: formatting
Dependencies removed: format-numbers
Files
- ChangeLog.md +3/−0
- TODO +0/−3
- koji-tool.cabal +2/−2
- src/BuildlogSizes.hs +4/−8
- src/Builds.hs +0/−3
- src/Main.hs +2/−1
- src/Progress.hs +54/−59
- src/Tasks.hs +3/−9
ChangeLog.md view
@@ -1,5 +1,8 @@ # Version history of koji-tool +# 0.8.2 (2022-03-28)+- use the formatting library for rendering aligned output+ # 0.8.1 (2022-03-21) - query results ordered by taskid or buildid for speed - 'builds', 'tasks': argument is now a package otherwise use --pattern (replaces --package)
TODO view
@@ -1,6 +1,3 @@-# general ideas-- use formatting or fmt (instead of format-numbers)- # install - autodetect nvr - --nodeps
koji-tool.cabal view
@@ -1,5 +1,5 @@ name: koji-tool-version: 0.8.1+version: 0.8.2 synopsis: Koji CLI tool for querying tasks and installing builds description: koji-tool is a CLI interface to Koji with commands to query@@ -45,7 +45,7 @@ directory, extra, filepath,- format-numbers,+ formatting >= 7, Glob, http-conduit, http-directory >= 0.1.9,
src/BuildlogSizes.hs view
@@ -24,12 +24,13 @@ import Distribution.Koji (fedoraKojiHub) import Distribution.Koji.API --(listBuilds) +import Formatting+ #if !MIN_VERSION_http_directory(0,1,5) import Network.HTTP.Client (Manager) #endif import Network.HTTP.Directory -import Data.Text.Format.Numbers import SimpleCmdArgs import Common (commonBuildQueryOptions)@@ -93,13 +94,8 @@ doGetBuildlogSize buildlog arch = do exists <- httpExists' buildlog msize <- if exists then httpFileSize' buildlog else return Nothing- whenJust msize $ \ size -> do- let kb = kiloBytes size- putStrLn $ arch ++ replicate (16 - length arch - length kb) ' ' ++ kb--kiloBytes :: Integer -> String-kiloBytes size =- T.unpack $ prettyI (Just ',') (fromInteger size `div` 1000) <> "kB"+ whenJust msize $ \ size ->+ fprintLn (right 8 ' ' % lpadded 7 ' ' commas % "kB") arch (size `div` 1000) #if !MIN_VERSION_http_directory(0,1,9) infixr 5 +/+
src/Builds.hs view
@@ -204,9 +204,6 @@ _ -> error' $! "unknown task state: " ++ s #endif -data LastLog = WholeBuild | BuildTail | RootLog- deriving Eq- getBuildState :: Struct -> Maybe BuildState getBuildState st = readBuildState <$> lookup "state" st
src/Main.hs view
@@ -88,7 +88,8 @@ , Subcommand "progress" "Track running Koji tasks by buildlog size" $ progressCmd- <$> optionalWith auto 'i' "interval" "MINUTES" "Polling interval between updates (default 2 min)" 2+ <$> switchWith 'D' "debug" "Pretty-print raw XML result"+ <*> optionalWith auto 'i' "interval" "MINUTES" "Polling interval between updates (default 2 min)" 2 <*> switchWith 'm' "modules" "Track module builds" <*> many (TaskId <$> argumentWith auto "TASKID")
src/Progress.hs view
@@ -13,6 +13,8 @@ #endif import Control.Monad +import Formatting+ #if !MIN_VERSION_http_directory(0,1,5) import Network.HTTP.Client (Manager) #endif@@ -21,6 +23,7 @@ import Control.Concurrent (threadDelay) import Data.Fixed+import Data.Int (Int64) import Data.List.Extra import Data.Maybe #if !MIN_VERSION_base(4,11,0)@@ -28,8 +31,6 @@ #endif import Data.Text (Text) import qualified Data.Text as T-import qualified Data.Text.IO as T-import Data.Text.Format.Numbers import Distribution.Koji @@ -37,8 +38,8 @@ import System.FilePath (takeBaseName, (</>)) -progressCmd :: Int -> Bool -> [TaskID] -> IO ()-progressCmd waitdelay modules tids = do+progressCmd :: Bool -> Int -> Bool -> [TaskID] -> IO ()+progressCmd debug waitdelay modules tids = do when (waitdelay < 1) $ error' "minimum interval is 1 min" when (modules && not (null tids)) $ error' "cannot combine --modules with tasks" tasks <-@@ -47,7 +48,7 @@ else return tids when (null tasks) $ error' "no build tasks found" btasks <- mapM kojiTaskinfoRecursive tasks- loopBuildTasks waitdelay btasks+ loopBuildTasks debug waitdelay btasks kojiTaskinfoRecursive :: TaskID -> IO BuildTask kojiTaskinfoRecursive tid = do@@ -76,14 +77,14 @@ type TaskInfoSize = (Struct,Maybe Int) type TaskInfoSizes = (Struct,(Maybe Int,Maybe Int)) -loopBuildTasks :: Int -> [BuildTask] -> IO ()-loopBuildTasks _ [] = return ()-loopBuildTasks waitdelay bts = do+loopBuildTasks :: Bool -> Int -> [BuildTask] -> IO ()+loopBuildTasks _ _ [] = return ()+loopBuildTasks debug waitdelay bts = do curs <- filter tasksOpen <$> mapM runProgress bts unless (null curs) $ do threadDelayMinutes waitdelay news <- mapM updateBuildTask curs- loopBuildTasks waitdelay news+ loopBuildTasks debug waitdelay news where threadDelayMinutes :: Int -> IO () threadDelayMinutes m =@@ -92,26 +93,28 @@ runProgress :: BuildTask -> IO BuildTask runProgress (tid,tasks) =- if null tasks then do- state <- kojiGetTaskState fedoraKojiHub tid- if state `elem` map Just openTaskStates then do- threadDelayMinutes waitdelay- kojiTaskinfoRecursive tid- else return (tid,[])- else do- putStrLn ""- let request = lookupStruct "request" $ fst (head tasks) :: Maybe [Value]- nvr = case request of- Just (srpm:_) ->- (takeBaseName . takeBaseName) $- maybeVal "failed to read src rpm" getString srpm- _ -> error "No src rpm found"- logMsg $ nvr ++ " (" ++ displayID tid ++ ")"- sizes <- mapM buildlogSize tasks- printLogSizes waitdelay sizes- let news = map (\(t,(s,_)) -> (t,s)) sizes- open = filter (\ (t,_) -> getTaskState t `elem` map Just openTaskStates) news- return (tid, open)+ case tasks of+ [] -> do+ state <- kojiGetTaskState fedoraKojiHub tid+ if state `elem` map Just openTaskStates then do+ threadDelayMinutes waitdelay+ kojiTaskinfoRecursive tid+ else return (tid,[])+ ((task,_):_) -> do+ putStrLn ""+ when debug $ print task+ let request = lookupStruct "request" task :: Maybe [Value]+ when debug $ print request+ let mnvr = case request of+ Just (srpm:_) ->+ takeBaseName . takeBaseName <$> getString srpm+ _ -> Nothing+ logMsg $ fromMaybe "<unknown>" mnvr ++ " (" ++ displayID tid ++ ")"+ sizes <- mapM buildlogSize tasks+ printLogSizes waitdelay sizes+ let news = map (\(t,(s,_)) -> (t,s)) sizes+ open = filter (\ (t,_) -> getTaskState t `elem` map Just openTaskStates) news+ return (tid, open) tasksOpen :: BuildTask -> Bool tasksOpen (_,ts) = not (null ts)@@ -142,49 +145,41 @@ let few = dropWhile (== '0') $ takeEnd 4 tid in if null few then "0" else few -data TaskOutput = TaskOut {_outArch :: Text, outSize :: Text, outSpeed :: Text, _outState :: Text, _method :: Text}+data TaskOutput = TaskOut {_outArch :: Text, moutSize :: Maybe Int, moutSpeed :: Maybe Int, _outState :: Text, _method :: Text} printLogSizes :: Int -> [TaskInfoSizes] -> IO () printLogSizes waitdelay tss =- mapM_ (T.putStrLn . taskOutList) $ (formatSize . map logSize) tss+ let (mxsi, mxsp, taskoutputs) = (formatSize . map taskOutput) tss+ in mapM_ (printTaskOut mxsi mxsp) taskoutputs where- taskOutList :: TaskOutput -> Text- taskOutList (TaskOut a si sp st mth) = T.unwords [a, si, sp, st, mth]+ printTaskOut :: Int64 -> Int64 -> TaskOutput -> IO ()+ printTaskOut mxsi mxsp (TaskOut a msi msp st mth) =+ fprintLn (rpadded 8 ' ' stext % lpadded mxsi ' ' (optioned commas) % "kB" % " " % optioned ("[" % lpadded mxsp ' ' commas % " B/min]") % " " % stext % " " % stext) a ((`div` 1000) <$> msi) ((`div` waitdelay) <$> msp) st (abridgeMethod mth) - formatSize :: [TaskOutput] -> [TaskOutput]+ formatSize :: [TaskOutput] -> (Int64, Int64,[TaskOutput]) formatSize ts =- let maxsi = maximum $ 6 : map (T.length . outSize) ts- -- "198,689"- maxsp = maximum $ 7 : map (T.length . outSpeed) ts- in map (justifyBytes maxsi maxsp) ts+ let maxsi = maximum $ 0 : mapMaybe moutSize ts+ -- was "198,689"+ maxsp = maximum $ 0 : mapMaybe moutSpeed ts+ in (decimalLength maxsi, decimalLength maxsp, ts)+ where+ decimalLength = fromIntegral . length . show - justifyBytes :: Int -> Int -> TaskOutput -> TaskOutput- justifyBytes maxsi maxsp (TaskOut a si sp st mth) =- TaskOut- (a <> T.replicate (7 - T.length a) " ")- (T.replicate (maxsi - T.length si) " " <> si <> "kB")- (case sp of- "" -> ""- _ -> "[" <> T.replicate (maxsp - T.length sp) " " <> sp <> " B/min" <> "]")- st- (case mth of- "buildArch" -> ""- "buildSRPMFromSCM" -> "SRPM"- _ -> mth)+ abridgeMethod :: Text -> Text+ abridgeMethod mth =+ case mth of+ "buildArch" -> ""+ "buildSRPMFromSCM" -> "SRPM"+ _ -> mth - logSize :: TaskInfoSizes -> TaskOutput- logSize (task, (size,old)) =+ taskOutput :: TaskInfoSizes -> TaskOutput+ taskOutput (task, (size,old)) = let method = maybeVal "method not found" (lookupStruct "method") task :: Text arch = maybeVal "arch not found" (lookupStruct "arch") task :: Text diff = (-) <$> size <*> old state = maybeVal "No state found" getTaskState task state' = if state == TaskOpen then "" else T.pack (show state)- in TaskOut arch (maybe "" kiloBytes size) (maybe "" speed diff) state' method- where- kiloBytes s = prettyI (Just ',') (s `div` 1000)-- speed :: Int -> Text- speed s = prettyI (Just ',') (s `div` waitdelay)+ in TaskOut arch size diff state' method kojiListBuildTasks :: Maybe String -> IO [TaskID] kojiListBuildTasks muser = do
src/Tasks.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, OverloadedStrings #-} -- SPDX-License-Identifier: BSD-3-Clause @@ -22,14 +22,12 @@ import Data.Monoid ((<>)) #endif import Data.RPM.NVR-import qualified Data.Text as T-import qualified Data.Text.IO as T-import Data.Text.Format.Numbers import Data.Time.Clock import Data.Time.Format import Data.Time.LocalTime import Distribution.Koji import Distribution.Koji.API+import Formatting hiding (now) import Network.HTTP.Directory import Network.HTTP.Simple import SimpleCmd@@ -313,9 +311,7 @@ putStr $ buildlog ++ " " msize <- httpFileSize' buildlog whenJust msize $ \size -> do- putChar '('- (T.putStr . kiloBytes) size- putStrLn ")"+ fprintLn ("(" % commas % "kB)") (size `div` 1000) -- FIXME check if short build.log ends with srpm lastlog <- if size < 1500@@ -325,8 +321,6 @@ else return BuildTail when tail' $ displayLog taskid lastlog- where- kiloBytes s = prettyI (Just ',') (fromInteger s `div` 1000) <> T.pack "kB" kojiMethods :: [String] kojiMethods =