Commit 67f48520 authored by Nicolas Lenz's avatar Nicolas Lenz
Browse files

Improve output

parent 892240b8
Pipeline #133 passed with stage
in 1 minute and 38 seconds
......@@ -4,7 +4,6 @@ import ClassyPrelude
import Path
import System.Process
import System.Exit
import Data.Text as T (init)
-- | Checks whether a folder is a repo of any supported VCS.
isRepo :: Path a Dir -> IO Bool
......@@ -13,8 +12,6 @@ isRepo path = readCreateProcessWithExitCode ((proc "git" ["rev-parse", "--git-di
_ -> return False
pull :: Path a Dir -> IO Bool
pull path = do
putStrLn $ T.init (pack (toFilePath path)) <> "> Starting pull"
readCreateProcessWithExitCode ((proc "git" ["pull"]) {cwd = Just $ toFilePath path}) "" >>= \case
(ExitSuccess, _, _) -> return True
_ -> return False
pull path = readCreateProcessWithExitCode ((proc "git" ["pull"]) {cwd = Just $ toFilePath path}) "" >>= \case
(ExitSuccess, _, _) -> return True
_ -> return False
......@@ -9,10 +9,15 @@ import Command
main :: IO ()
main = do
repos <- recurseDir [reldir|.|]
putStrLn $ tshow (length repos) <> " repositories found:"
mapM_ putStrLn (pack . toFilePath <$> repos)
putStrLn ""
results <- mapConcurrently (mapToSndM Command.pull) repos
case results of
case filter ((== False) . snd) results of
[] -> putStrLn "Success!"
_ -> putStrLn $ "Failures happend in: " <> intercalate ", " (map (pack . toFilePath . fst) . filter ((== False) . snd) $ results)
failed
| length failed == length repos -> putStrLn "All operations failed."
| otherwise -> putStrLn $ "Failures happend in: " <> intercalate ", " (map (pack . toFilePath . fst) failed)
-- | Applies a monadic function to a value, return a monadic pair containing the input in the first slot and the result in the second.
mapToSndM :: (Monad m) => (a -> m b) -> a -> m (a, b)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment