f# - 需要有关异步和 fsi 的帮助

Question

我想编写一些运行一系列 F# 脚本 (.fsx) 的代码。问题是我可以拥有数百个脚本，如果我这样做:

let shellExecute program args =
    let startInfo = new ProcessStartInfo()
    do startInfo.FileName        <- program
    do startInfo.Arguments       <- args
    do startInfo.UseShellExecute <- true
    do startInfo.WindowStyle     <- ProcessWindowStyle.Hidden

    //do printfn "%s" startInfo.Arguments 
    let proc = Process.Start(startInfo)
    ()

scripts
|> Seq.iter (shellExecute "fsi")

它可能会给我的 2GB 系统带来太大压力。无论如何，我想按 n 批处理运行脚本，这似乎也是一个很好的学习练习 Async (我想这是要走的路)。

我已经开始为此编写一些代码，但不幸的是它不起作用:

open System.Diagnostics

let p = shellExecute "fsi" @"C:\Users\Stringer\foo.fsx"

async {
    let! exit = Async.AwaitEvent p.Exited
    do printfn "process has exited"
}
|> Async.StartImmediate

foo.fsx 只是一个 hello world 脚本。
解决这个问题的最惯用的方法是什么？

我还想弄清楚是否可以为每个执行脚本检索返回码，如果不可行，请找到另一种方法。谢谢!

编辑:

非常感谢您的见解和链接!我学到了很多东西。
我只想添加一些代码以使用 Async.Parallel 并行运行批处理正如托马斯建议的那样。如果我的 cut 有更好的实现，请发表评论功能。

module Seq =
  /// Returns a sequence of sequences of N elements from the source sequence.
  /// If the length of the source sequence is not a multiple
  /// of N, last element of the returned sequence will have a length
  /// included between 1 and N-1.
  let cut (count : int) (source : seq<´T>) = 
    let rec aux s length = seq {
      if (length < count) then yield s
      else
        yield Seq.take count s
        if (length <> count) then
          yield! aux (Seq.skip count s) (length - count)
      }
    aux source (Seq.length source)

let batchCount = 2
let filesPerBatch =
  let q = (scripts.Length / batchCount)
  q + if scripts.Length % batchCount = 0 then 0 else 1

let batchs =
  scripts
  |> Seq.cut filesPerBatch
  |> Seq.map Seq.toList
  |> Seq.map loop

Async.RunSynchronously (Async.Parallel batchs) |> ignore

编辑2:

所以我在让 Tomas 的保护代码工作时遇到了一些麻烦。我猜 f函数必须在 AddHandler 中调用方法，否则我们将永远失去事件......这是代码:

module Event =
  let guard f (e:IEvent<´Del, ´Args>) = 
    let e = Event.map id e
    { new IEvent<´Args> with 
        member this.AddHandler(d) = e.AddHandler(d); f() //must call f here!
        member this.RemoveHandler(d) = e.RemoveHandler(d); f()
        member this.Subscribe(observer) = 
          let rm = e.Subscribe(observer) in f(); rm }

有趣的事情(正如 Tomas 提到的)是它看起来像 Exited进程终止时，事件存储在某处，即使进程尚未以 EnableRaisingEvents 开始设置为真。
当此属性最终设置为 true 时，将触发该事件。

由于我不确定这是不是官方规范(也有点偏执)，我找到了另一种解决方案，即在 guard 中启动进程。函数，所以我们确保代码在任何情况下都可以工作:

let createStartInfo program args =
  new ProcessStartInfo
    (FileName = program, Arguments = args, UseShellExecute = false,
     WindowStyle = ProcessWindowStyle.Normal, 
     RedirectStandardOutput = true)

let createProcess info =
  let p = new Process()
  do p.StartInfo           <- info
  do p.EnableRaisingEvents <- true
  p

let rec loop scripts = async { 
  match scripts with 
  | [] -> printfn "FINISHED"
  | script::scripts ->
    let args = sprintf "\"%s\"" script
    let p = createStartInfo "notepad" args |> createProcess
    let! exit =
      p.Exited 
      |> Event.guard (fun () -> p.Start() |> ignore)
      |> Async.AwaitEvent
    let output = p.StandardOutput.ReadToEnd()
    do printfn "\nPROCESSED: %s, CODE: %d, OUTPUT: %A"script p.ExitCode output
    return! loop scripts 
  }

请注意，我已将 fsi.exe 替换为 notepad.exe，因此我可以在调试器中逐步重播不同的场景，并自己明确控制进程的退出。

Answer 1

我做了一些实验，这是处理我帖子下方评论和乔尔回答中讨论的问题的一种方法(我认为目前不起作用，但可以修复)。

我认为 Process 的规范是它可以触发Exited我们设置 EnableRaisingEvents 之后的事件属性(property)给 true (即使在我们设置属性之前该过程已经完成，也会触发事件)。为了正确处理这种情况，我们需要在将处理程序附加到 Exited 后启用事件的引发。事件。

这是一个问题，因为如果我们使用 AwaitEvent它将阻止工作流，直到事件触发。调用 AwaitEvent 后我们无能为力从工作流程中(如果我们在调用 AwaitEvent 之前设置属性，那么我们会进行比赛......)。 Vladimir's approach是正确的，但我认为有一种更简单的方法可以解决这个问题。

我将创建一个函数 Event.guard接受一个事件并返回一个事件，这允许我们指定一些函数，将在处理程序附加到事件后执行。这意味着如果我们在这个函数内部做一些操作(进而触发事件)，事件就会被处理。

要将它用于这里讨论的问题，我们需要将我原来的解决方案更改如下。首先，shellExecute函数不能设置EnableRaisingEvents属性(property)(否则，我们可能会失去事件!)。其次，等待代码应该是这样的:

let rec loop scripts = async { 
  match scripts with 
  | [] -> printf "FINISHED"
  | script::scripts ->
    let p = shellExecute fsi script 
    let! exit = 
      p.Exited 
        |> Event.guard (fun () -> p.EnableRaisingEvents <- true)
        |> Async.AwaitEvent
    let output = p.StandardOutput.ReadToEnd()
    return! loop scripts  } 

注意 Event.guard 的使用功能。粗略地说，在工作流将处理程序附加到 p.Exited 之后事件，提供的 lambda 函数将运行(并将启用事件的引发)。但是，我们已经将处理程序附加到事件，所以如果这会立即导致事件，我们很好!

实现(对于 Event 和 Observable )如下所示:

module Event =
  let guard f (e:IEvent<'Del, 'Args>) = 
    let e = Event.map id e
    { new IEvent<'Args> with 
        member x.AddHandler(d) = e.AddHandler(d)
        member x.RemoveHandler(d) = e.RemoveHandler(d); f()
        member x.Subscribe(observer) = 
          let rm = e.Subscribe(observer) in f(); rm }

module Observable =
  let guard f (e:IObservable<'Args>) = 
    { new IObservable<'Args> with 
        member x.Subscribe(observer) = 
          let rm = e.Subscribe(observer) in f(); rm }

好的是这段代码非常简单。