git remote explorer

alternate git remote explorer.fs

// let devroot = Environment.ExpandEnvironmentVariables("%devroot%")
let debug = true

module Option =
    let ofNullOrEmpty =
        function
        | null -> None
        | "" -> None
        | x -> Some x
    let ofValueString x =
        if String.IsNullOrWhiteSpace x then
            None
        else Some x
        
module String =
    let trim (x:string) =
        Option.ofNullOrEmpty x
        |> Option.map(fun x -> x.Trim())
        |> Option.defaultValue null
    
    let trimStart1 (delim:char) x =
        Option.ofNullOrEmpty x
        |> Option.map(fun x -> x.TrimStart(delim))
        |> Option.defaultValue null
    let startsWith (delim:string) x =
        Option.ofNullOrEmpty x
        |> Option.map(fun x -> x.StartsWith(delim))
        |> Option.defaultValue false
    let isValueString x = String.IsNullOrWhiteSpace x |> not
let (|ValueString|_|) x = if String.isValueString x then Some x else None
module Result =        
    let tryGetError =
        function
        | Ok _ -> None
        | Error e -> Some e
    let swallowErrors (x : Result<_,_> seq) =
        (List.empty, x)
        ||> Seq.fold(fun state item ->
            match item with
            | Error _ -> state
            | Ok item -> (item::state)
        )
        
module Async =
    let map f x =
        async {
            let! value = x
            return f value
        }
    let bind f x =
        async {
            let! value = x
            return! f value
        }
        
module Proc =
    open System.Diagnostics
    let runCaptured name args wdOpt =
        async {
        
            let captures = System.Collections.ObjectModel.ObservableCollection()
            let psi =
                ProcessStartInfo(
                    FileName = name,
                    CreateNoWindow = true,
                    UseShellExecute = false,
                    RedirectStandardOutput = true,
                    RedirectStandardError = true
            )
            wdOpt
            |> Option.iter(fun wd ->
                //printfn "Using working directory: '%s'" wd
                psi.WorkingDirectory <- wd
            )
            
            args
            |> List.iter psi.ArgumentList.Add
            
            use p = new Process(StartInfo = psi)
            let capAdd f : DataReceivedEventHandler =
                DataReceivedEventHandler(
                    fun sender (args:DataReceivedEventArgs) ->
                        let value = f args.Data
                        try
                             captures.Add(value)
                        with | :? ArgumentException as aex -> 
                            (captures.Count,aex).Dump("failure to add")
                )
                
            p.OutputDataReceived.AddHandler(capAdd Ok)
            p.ErrorDataReceived.AddHandler(capAdd Error)
            p.Start() |> ignore<bool>
            p.BeginOutputReadLine()
            p.BeginErrorReadLine()
            do! Async.AwaitTask (p.WaitForExitAsync())
            // let things wrap up and resolve on other threads
            do! Async.Sleep 100
            let captures = captures :> IReadOnlyList<Result<string,string>>
            if p.ExitCode <> 0 then
                return Error(sprintf "%s %A -> %i" name args p.ExitCode, captures)
            else return Ok captures
        }
        
    let runOrFail name args wdOpt =
        runCaptured name args wdOpt
        |> Async.map(
            function
            | Ok output ->
                try
                    if debug && output.Count > 0 then
                        output
                        |> Seq.choose Result.tryGetError
                        |> List.ofSeq
                        |> function
                            | [] -> ()
                            | x ->
                                try
                                    if x |> List.exists(String.isValueString) then
                                        x.Dump("Errors")
                                with _ ->
                                    eprintfn "failed inside"
                                    reraise()
                    output
                with _ ->
                    (name,args,wdOpt).Dump("failing runOrFail")
                    output.Count.Dump("fail count")
                    reraise()
            | Error (msg, output) ->
                (name,args,output).Dump(msg)
                failwithf "Did not succeed"
            // ok to swallow errors, a dump and failwith is triggered above in those cases
            >> Result.swallowErrors
       )
// end module

let stripEmpties (items: Result<string,string> seq) =
    items
    |> Seq.choose(
        function
        | Ok (ValueString v) -> Some (Ok v)
        | Ok _ -> None
        | Error (ValueString v) -> Some (Error v)
        | Error _ -> None
    )

let cacheResult key f =
    Util.Cache((fun () -> f key), key= key)
    
cacheResult "c:\\projects\\" (fun target ->
    Directory.GetDirectories(target, ".git", System.IO.EnumerationOptions(RecurseSubdirectories= true))
)
|> Seq.map(fun v ->
    async {
        let dir = Path.GetDirectoryName v 
        //printfn "Searching dir: %s" dir
        let! result = Proc.runCaptured "git" ["remote"; "-v"] (dir |> Some)
        return dir,result
    }
)
|> Async.Parallel
|> Async.RunSynchronously
|> Array.map(function | dir, Ok v -> Ok (dir,v |> stripEmpties) | dir, Error (cmd,e) -> Error ($"{dir} - {cmd}",e |> stripEmpties))
|> Dump
|> ignore

git remote explorer.fs

// from a root path, find all git repos and see what their remotes are

let path = @"C:\projects"

let splitLines (x:string) =
    x.Split([| "\r\n"; "\n";"\r" |], StringSplitOptions.None)
let inline isValueString x = x |> String.IsNullOrWhiteSpace |> not

type ProcessResult = { ExitCode : int; O : string; E : string }

let after (delim:string) (x:string) = x[ x.IndexOf(delim) + delim.Length ..]
let before (delim:string) (x:string) = x[ 0 .. x.IndexOf(delim) - 1]
let guard f (e:IEvent<'Del, 'Args>) = // http://stackoverflow.com/a/2658530/57883
    let e = Event.map id e
    { new IEvent<'Args> with 
        member x.AddHandler(d) = e.AddHandler(d); f() //must call f here!
        member x.RemoveHandler(d) = e.RemoveHandler(d)
        member x.Subscribe(observer) = 
          let rm = e.Subscribe(observer) in f(); rm }
          
//http://stackoverflow.com/questions/3065409/starting-a-process-synchronously-and-streaming-the-output
let runProcessAsync f (fileName:string,args:string) = async {
    let psi = System.Diagnostics.ProcessStartInfo(fileName,args,UseShellExecute=false, RedirectStandardOutput=true, RedirectStandardError=true) |> f
    use p = new System.Diagnostics.Process(StartInfo = psi)
    let output = new System.Text.StringBuilder()
    let error = new System.Text.StringBuilder()
    p.OutputDataReceived.Add(fun args -> output.AppendLine(args.Data) |> ignore)
    p.ErrorDataReceived.Add(fun args -> error.AppendLine(args.Data) |> ignore)
    p.Start() |> ignore
    p.BeginErrorReadLine()
    p.BeginOutputReadLine()
    let! _ =
        p.Exited
        |> guard (fun _ -> p.EnableRaisingEvents <- true)
        |> Async.AwaitEvent
    return {ExitCode= p.ExitCode; O= output.ToString(); E= error.ToString()}
    }
let foldRemote (x:string[]) =
    x
    |> Seq.pairwise
    |> Seq.collect(fun (x,y) ->
        if (x |> before "(") = (y |> before "(") then
            [ x |> before "("]
        else [ x;y ]
    )
let gitRemoteV p =
    ("git", "remote -v")
    |> runProcessAsync (fun psi ->
        psi.WorkingDirectory <- p
        psi.CreateNoWindow <- true
        psi
    )
IO.Directory.GetDirectories(path)
|> Seq.filter(fun d ->
    let gd = Path.Combine(d, ".git")
    Directory.Exists gd
)
|> Seq.map(fun p ->
    let result = gitRemoteV p |> Async.RunSynchronously
    p, result
)
|> Seq.map(fun (p, result) ->
    let relP = p |> after path
    if result.ExitCode = 0 && String.IsNullOrWhiteSpace result.E then
        relP, result.O |> splitLines |> Array.filter isValueString |> foldRemote |> List.ofSeq, box result.E // beforeOrSelf "(fetch)" |> trim}
    else relP, result.O |> splitLines |> Array.filter isValueString |> List.ofSeq, Util.Highlight result.E
)
|> Dump
|> ignore