parser.fs

module Parsing = 

  //type Char = string
  //type Str = string
  type Remaining = string
  type Result<'a> = Success of 'a * Remaining
                    | Failure

  type Parser<'a> = string -> Result<'a>
  
  (*  
  type ParserBuilder() = 
    member this.Bind ((x : Parser<'a>), (rest : Remaining -> Parser<'a>)) =
      match x with
      | Success (x, r) -> rest r
      | Failure -> fun (inp : Str) -> Failure

    member this.Return (x : 'a) = fun (inp : Remaining) -> Success (x, inp)

  let parseX = ParserBuilder()
  *)

  let ret (v : 'a) : Parser<'a> = fun (inp : string) -> Success (v, inp)
  let failure      : Parser<'a> = fun (inp : string) -> Failure

  let parse (p : Parser<'a>) (inp : string) : Result<'a> = p inp
  
  let (|First|) (s:string) =
    if s.Length > 0 
    then s.Substring(0, 1)
    else ""
  
  let (|Rest|) (s:string) = 
    if s.Length > 1
    then s.Substring(1)
    else ""

  let (|First2|) (s:string) =
    if s.Length > 1
    then s.Substring(0, 2)
    else ""
  
  let (|Rest2|) (s:string) = 
    if s.Length > 2
    then s.Substring(2)
    else ""

  let item : Parser<string> = fun inp -> match inp with
                                         | "" -> Failure
                                         | First f & Rest r -> Success (f, r)


  let (>>=) (p : Parser<'a>) (f : 'a -> Parser<'b>) : Parser<'b> = 
    fun inp -> match parse p inp with
               | Failure -> Failure
               | Success (v, out) -> parse (f v) out


  let (+++) p q = fun inp -> match parse p inp with
                             | Failure -> parse q inp
                             | Success (v, out) -> Success (v, out)


  let sat (p : string -> bool) : Parser<string> = 
    item >>= fun x ->
    if p x then ret x else failure

  (*
  let eof : Parser<string> = 
    sat (fun x -> x.Length = 0)

  let sat2 (p : Char -> bool) : Parser<string> = 
    parseX {
      let! x = item
      return (if p x then x else "")
    }
  *)

  let isDigit (x:string) : bool =
    if not (x.Length = 1)
    then false
    else
      let digits = ['0'..'9']
      List.exists (fun ch -> ch = x.ToCharArray().[0]) digits

  let digit = sat isDigit

  let char (x:string)    : Parser<string> = sat (fun y -> y = x)
  let rec str (x:string) : Parser<string> =
    match x with 
    | "" -> failure
    | First x & Rest xs -> char x >>= fun _ -> 
                           str xs >>= fun _ -> 
                           ret (x+xs)


  let comma = char ","

  let quote = char "\""

  let quoteComma = quote >>= fun _ -> 
                   comma >>= fun _ -> 
                   ret ""

  let twoQuote = quote >>= fun x -> 
                 quote >>= fun y -> 
                 ret (x+y)

  let rec many p = many1 p +++ ret ""
  and many1 p =  p >>= fun v ->
            many p >>= fun vs ->
            ret (v + vs)

  let notQuote =
    sat (fun x -> not (x = "\""))

  let notComma =
    sat (fun x -> not (x = ","))

  let tilEndUqField = 
    notComma >>= fun x ->
    ret x

  let uqField = 
    tilEndUqField >>= fun data ->
    ret data

  let rest =
    many (sat (fun _ -> true))
    (*
  let quoteComma (x:string) : Parser<Str> =
    match x with 
    | "" -> ret ""
    | First f & Rest r when f = "\"" -> 
        match r with
        | First f2 & Rest r2 when f2 =
    //| First2 f & Rest2 r -> if f = "\"," then ret f else ret
    *)

  let qField = 
    quote >>= fun _ ->
    (many notQuote) >>= fun inside ->
    ret inside

  // q,"we,r","we,""ee"",,y"
  // q
  // we,r
  // we,"ee",,y


  //let csv (st:string) : Parser<string list> =