Open friedbrice opened 5 years ago
Cool. I'll look into path and path-io and see if i can clean this up.
How's this?
List Git repositories:
{-# LANGUAGE QuasiQuotes #-}
module ListRepos (listRepos, paths) where
import Control.Monad (filterM, join)
import Data.Foldable (traverse_)
import Path (Path, Abs, Rel, Dir, reldir, (</>))
import Path.IO (doesDirExist, getHomeDir, listDir)
paths :: [Path Rel Dir]
paths = [ [reldir|abs/aur|]
, [reldir|friedbrice|]
, [reldir|lumi-tech|]
]
isGitRepo :: Path Abs Dir -> IO Bool
isGitRepo dir = doesDirExist (dir </> [reldir|.git|])
listRepos :: Path Abs Dir -> IO [Path Abs Dir]
listRepos parentdir = do
(subdirs, _) <- listDir parentdir
filterM isGitRepo subdirs
main :: IO ()
main = do
home <- getHomeDir
let fullPaths = map (home </>) paths
repos <- fmap join (traverse listRepos fullPaths)
traverse_ print repos
Concurrently fetch Git repositories:
module FetchRepos where
import Control.Concurrent.Async (mapConcurrently)
import Control.Monad (join)
import Path (Path, Abs, Dir, toFilePath, (</>))
import Path.IO (getHomeDir)
import System.Exit (ExitCode(ExitSuccess))
import System.Process ( CreateProcess(cwd)
, createProcess
, shell
, waitForProcess
)
import ListRepos (listRepos, paths)
fetchRepo :: Path Abs Dir -> CreateProcess
fetchRepo dir =
(shell "git fetch --prune --all")
{ cwd = Just (toFilePath dir) }
concurrentlyRetryForever :: [CreateProcess] -> IO ()
concurrentlyRetryForever procs = do
handles <- mapConcurrently createProcess procs
exitCodes <-
traverse (waitForProcess . \(_,_,_,h) -> h) handles
let failures = [ proc
| (proc, exitCode) <- zip procs exitCodes
, exitCode /= ExitSuccess
]
if (null failures) then pure ()
else concurrentlyRetryForever failures
main :: IO ()
main = do
home <- getHomeDir
let fullPaths = map (home </>) paths
repos <- fmap join (traverse listRepos fullPaths)
concurrentlyRetryForever (map 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).