How to work with files/how to work with processes/how to do things concurrently

[friedbrice]

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)

[chris-martin]

Whoops, looks like this one got opened twice. Closing and resuming discussion on #22.