Commit e3b96c30 authored by Nicolas Lenz's avatar Nicolas Lenz
Browse files

Better output, recurse arbitrarily deep

parent cf64ad6f
Pipeline #130 passed with stage
in 1 minute and 29 seconds
......@@ -4,8 +4,17 @@ import ClassyPrelude
import Path
import System.Process
import System.Exit
import Data.Text as T (init)
pull :: Path Abs Dir -> IO Bool
pull path = readCreateProcessWithExitCode ((proc "git" ["pull"]) {cwd = Just $ fromAbsDir path}) "" >>= \case
-- | Checks whether a folder is a repo of any supported VCS.
isRepo :: Path a Dir -> IO Bool
isRepo path = readCreateProcessWithExitCode ((proc "git" ["rev-parse", "--git-dir"]) {cwd = Just $ toFilePath path}) "" >>= \case
(ExitSuccess, _, _) -> return True
_ -> 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
import ClassyPrelude
{-# LANGUAGE LambdaCase, QuasiQuotes #-}
import ClassyPrelude hiding ((</>))
import Path
import Path.IO
-- import Control.Concurrent.Async
import Command
main :: IO ()
main = do
current <- getCurrentDir
(dirs, _) <- listDir current
results <- mapConcurrently Command.pull dirs
putStrLn $ tshow results
repos <- recurseDir [reldir|.|]
results <- mapConcurrently (mapToSndM Command.pull) repos
case results of
[] -> putStrLn "Success!"
_ -> putStrLn $ "Failures happend in: " <> intercalate ", " (map (pack . toFilePath . fst) . filter ((== False) . snd) $ results)
-- | 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)
mapToSndM f x = f x >>= \y -> return (x, y)
-- | Recurses through a directory tree and returns all repos in the tree.
recurseDir :: Path b Dir -> IO [Path b Dir]
recurseDir path = isRepo path >>= \case
True -> return [path]
False -> do
(dirs, _) <- listDirRel path
concat <$> mapM (recurseDir . (path </>)) dirs
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