This is how I check my git repos every morning. This is a pretty long example, so it probably needs to be split into three smaller examples (which I'm happy to do if you think it'll make for good content).
#!/usr/bin/env stack
{- stack script --resolver lts-13.26 -}
import Control.Concurrent.Async (mapConcurrently)
import Control.Monad (filterM, join)
import GHC.IO.Exception (ExitCode(ExitSuccess))
import System.Directory (doesDirectoryExist, getHomeDirectory, listDirectory)
import System.Process (CreateProcess(cwd), createProcess, shell, waitForProcess)
-- config, relative to user home directory
dirs :: [FilePath]
dirs = ["abs/aur", "friedbrice", "lumihq"]
-- Concat paths without fear
(+/) :: FilePath -> FilePath -> FilePath
(+/) "" "" = ""
(+/) parent child = case (last parent, head child) of
('/', '/') -> parent ++ tail child
('/', _) -> parent ++ child
(_, '/') -> parent ++ child
_ -> parent ++ "/" ++ child
fetchRepo :: FilePath -> CreateProcess
fetchRepo dir = (shell "git fetch --prune --all") { cwd = Just dir }
listRepos :: FilePath -> IO [FilePath]
listRepos parentdir = do
files <- listDirectory parentdir
let paths = (parentdir +/) <$> files
filterM (doesDirectoryExist . (+/ ".git")) paths
concurrentlyRetryForever :: [CreateProcess] -> IO ()
concurrentlyRetryForever procs = do
handles <- mapConcurrently createProcess procs
codes <- traverse (waitForProcess . \(_,_,_,h) -> h) $ handles
let failures = [ p | (p, c) <- zip procs codes, c /= ExitSuccess ]
if null failures then pure () else concurrentlyRetryForever failures
main :: IO ()
main = do
home <- getHomeDirectory
let fullPaths = (home +/) <$> dirs
repos <- join <$> traverse listRepos fullPaths
concurrentlyRetryForever (fetchRepo <$> repos)
This is how I check my git repos every morning. This is a pretty long example, so it probably needs to be split into three smaller examples (which I'm happy to do if you think it'll make for good content).