Parser combinators in f-sharp

Farse.fs

open System

module Farse = 
    type 'a Cont   = 'a * string
    type 'a Result = 'a Cont list
    type 'a Parser = Parser of (string -> Cont<'a> list)

    let parseWith = function
      | Parser p -> p
      
    let just v =
      Parser <| fun src -> [(v, src)]

    let zero () =
      Parser <| fun src -> []

    let extend f p =
      Parser <| fun src -> f (parseWith p src)

    let map f =
      extend <| List.map (fun (v, s) -> f v, s)

    let join =
      extend <| List.collect (fun (v, s) -> (parseWith v) s)
      
    let chain m f = 
      join <| map f m

    let concat a b =
      Parser <| fun src ->
        let left = parseWith a src
        let right = parseWith b src
        List.append left right

    let exactly (s:string)  =
      Parser <| fun (src:string) ->
        let l = Math.Min(src.Length, s.Length)
        if src.[0..l-1] = s then
          [(s, src.[l..])]
        else
          []
    
    type ParserBuilder() =
      member x.Bind(m, f) = chain m f
      member x.Return(v)  = just v
      member x.Zero()     = zero ()
     
    let parser = ParserBuilder()

    let rec any = function
      | []    -> zero ()
      | x::xs -> concat x (any xs)

    let rec seq ls =
      parser {
        match ls with
        | []    -> return []
        | x::xs ->
            let! first = x
            let! rest  = seq xs
            return first :: rest
        }

    "(foo) bar"
    |> parseWith (seq [exactly "("; exactly "foo"; exactly ")"])
    |> printf "%A"