POptiPNG; Parallel OptiPNG, it invoke OptiPNG with parallel and manage processes.

POptiPNG.fs

open System
open System.Diagnostics
open System.IO
open System.Reflection
open System.Threading

let count = Environment.ProcessorCount
let optipng = "\"" + Path.Combine(Path.GetDirectoryName(Assembly.GetEntryAssembly().Location), "optipng") + "\""
let prefix = "-silent -o5 "
let cmdLen = 32768 - 1(* \0 *) - String.length optipng - 1(* SP *) - String.length prefix

let split count seq =
    let arr = [| for i in 1..count -> new ResizeArray<_>() |]
    seq |> Seq.iteri (fun i v -> arr.[i % count].Add(v))
    arr |> Array.map (fun list -> list.ToArray())

let makeProcess dir files =
    let len = Array.length files - 1
    let rec makeArguments len =
        let result = String.concat " " files.[0..len]
        if String.length result < cmdLen then
            result, files.[len + 1..]
        else
            makeArguments (len - 1)
    let arg, rest = makeArguments len
    let si = new ProcessStartInfo(optipng, prefix + arg, UseShellExecute = false, CreateNoWindow = true, WorkingDirectory = dir)
    let p = new Process(StartInfo = si)
    p, rest

let rec makeProcesses dir (files : seq<_>) =
    let processes, rest = files |> split count
                                |> Array.map (makeProcess dir)
                                |> Array.unzip
    match Array.concat rest with
    | [||] -> processes
    | rest -> makeProcesses dir rest |> Array.append processes

let getFiles dir =
    (new DirectoryInfo(dir)).EnumerateFiles("*.png") |> Seq.sortBy (fun f -> -f.Length)
                                                     |> Seq.map (fun f -> f.Name)

[<EntryPoint>]
let main argv =
    let sw = Stopwatch.StartNew()
    let processes = argv |> Seq.map (fun dir -> getFiles dir |> makeProcesses dir)
                         |> Array.concat
    Console.CancelKeyPress.Add(fun _ -> processes |> Seq.iter (fun p -> try p.Kill() with _ -> ()))
    use complete = new CountdownEvent(Array.length processes)
    use semaphore = new SemaphoreSlim(count)
    processes |> Seq.iter (fun p -> semaphore.Wait()
                                    p.Exited.Add(fun _ -> semaphore.Release() |> ignore
                                                          complete.Signal() |> ignore)
                                    p.EnableRaisingEvents <- true
                                    p.Start() |> ignore)
    complete.Wait()
    sw.Stop()
    printfn "time: %d" (sw.ElapsedMilliseconds / 1000L)
    0