Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
printf-style function for calling external programs with typesafe commandline formatting. Based on Mauricio Scheffer's "Abusing PrintfFormat in F#", which used the same technique for typesafe SQL queries.
// Demo:
// let files = sh "ls -a /Users/david" |> lines
// let install = sh "cp -r %s /Applications"
// install "/Volumes/Awareness/"
module Campari.Shell
open System
open System.IO
open System.Data
open System.Diagnostics
open System.Text.RegularExpressions
open Microsoft.FSharp.Reflection
open Campari.Util
type Verbosity = Verbose | Quiet
let private PrintfFormatProc (worker: string -> obj list -> 'd) (query: PrintfFormat<'a, _, _, 'd>) : 'a =
if not (FSharpType.IsFunction typeof<'a>) then
unbox (worker query.Value [])
let rec getFlattenedFunctionElements (functionType: Type) =
let domain, range = FSharpType.GetFunctionElements functionType
if not (FSharpType.IsFunction range)
then domain :: [range]
else domain :: getFlattenedFunctionElements(range)
let types = getFlattenedFunctionElements typeof<'a>
let rec proc (types: Type list) (values: obj list) (a: obj) : obj =
let values = a::values
match types with
| [x; _] ->
let result = worker query.Value (List.rev values)
box result
| x :: y :: z :: xs ->
let cont = proc (y :: z :: xs) values
let ft = FSharpType.MakeFunctionType(y, z)
let cont = FSharpValue.MakeFunction(ft, cont)
box cont
| _ -> failwith "shouldn't happen"
let handler = proc types []
unbox (FSharpValue.MakeFunction(typeof<'a>, handler))
let private shellProcessor (before: Process -> _) (after: Process -> 'a) (command: string) (values: obj list) =
let format s =
let i = ref -1
let eval match' =
incr i
// TODO; want to do:
// sprintf match'.Value values.[!i]
Regex.Replace(s, "%.", eval)
let command = format command
// Now that we have a formatted command, we need to split
// the executable from the arguments
// TODO split this more intelligently
let exe :: args = words command
let p = new Process ()
p.StartInfo.FileName <- exe
p.StartInfo.Arguments <- unwords args
p.StartInfo.UseShellExecute <- false
before p
after p
let shell verbosity a =
let verbose = verbosity = Verbose
let out = new Text.StringBuilder()
let setup (p: Process) =
if verbose then printfn "%s %s" p.StartInfo.FileName p.StartInfo.Arguments
p.StartInfo.RedirectStandardOutput <- true
p.OutputDataReceived.Add <| fun args ->
if args.Data <> null then
out.AppendLine args.Data
if verbose then Console.WriteLine args.Data
let capture (p: Process) =
PrintfFormatProc (shellProcessor setup capture) a
let sh a = shell Verbose a
let sh' a = shell Quiet a
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.