One-module F# parser combinator library

Parser.fs

module Parser =

    type private StringTail = private | ST of int * string with
        static member Create (content: string): StringTail = ST (0, content)
        member this.Length: int =
            match this with
            | ST (pos, content) -> content.Length - pos

        member this.Item
            with get(index) =
                match this with
                | ST (pos, content) -> content.[pos + index]
        member this.StartsWith (target: string): bool =
            match this with
            | ST (pos, content) ->
                this.Length >= target.Length &&
                seq {
                    for i in [0 .. target.Length - 1] do
                        yield target.[i] = this.[i]
                }
                |> Seq.forall id
        member this.SubString (startIndex: int, length: int) =
            match this with
            | ST (pos, content) -> content.Substring(startIndex + pos, length)
        member this.Tail =
            match this with
            | ST (pos, content) -> ST (pos + 1, content)
        member this.Skip (num: int) =
            match this with
            | ST (pos, content) -> ST (pos + num, content)
        member this.IsEmpty =
            match this with
            | ST (pos, content) -> pos = content.Length


    type Parser<'A> = private | Parser of (StringTail -> ('A * StringTail) seq)

    let char (c: char): Parser<char> =
        fun (input: StringTail) ->
            if input.Length = 0 then
                Seq.empty
            else
                if input.[0] = c then
                    (c, input.Tail)
                    |> Seq.singleton
                else
                    Seq.empty
        |> Parser

    let token (s: string): Parser<string> =
        fun (input: StringTail) ->
            if input.Length >= s.Length && input.StartsWith s then
                (s, input.Skip s.Length)
                |> Seq.singleton
            else
                Seq.empty
        |> Parser

    let (<|>) (Parser p1) (Parser p2) =
        fun (input: StringTail) ->
            Seq.append (p1 input) (p2 input)
        |> Parser

    let constant x =
        fun (s: StringTail) ->
            (x, s)
            |> Seq.singleton
        |> Parser

    let (<%>) f (Parser p) =
        fun (input: StringTail) ->
            p input
            |> Seq.map (fun (value,rest) -> f value, rest)
        |> Parser

    let fmap = (<%>)

    let (<*>) (Parser f: Parser<'A -> 'B>) (Parser x: Parser<'A>): Parser<'B> =
        fun (input: StringTail) ->
            f input
            |> Seq.collect (fun (f,rest) ->
                x rest
                |> Seq.map (fun (x,rest') -> f x, rest')
            )
        |> Parser

    let any (Parser p: Parser<'A>): Parser<'A list>=
        let rec parse (input: StringTail): ('A list * StringTail) seq =
            let result = p input
            result
            |> Seq.isEmpty
            |> function
                | true -> ([], input) |> Seq.singleton
                | false ->
                    result
                    |> Seq.collect (fun (value,rest) ->
                        let subres = parse rest
                        subres
                        |> Seq.map (fun (values,rest) -> (value :: values, rest))
                    )
        Parser parse

    let some (p: Parser<'A>): Parser<'A list> =
       (fun h t -> h :: t) <%> p <*> any p

    let ( *> ) (Parser l) (Parser r) =
        fun (input: StringTail) ->
            l input
            |> Seq.collect (fun (_, rest) ->
                r rest
            )
        |> Parser

    let ( <* ) (Parser l) (Parser r) =
        fun (input: StringTail) ->
            l input
            |> Seq.collect (fun (x, rest) ->
                r rest
                |> Seq.map (fun (_,rest) -> x, rest)
            )
        |> Parser

    let (>>=) (Parser l: Parser<'a>) (f : 'a -> Parser<'b>): Parser<'b> =
        fun (input: StringTail) ->
            l input
            |> Seq.collect (fun (x, rest) ->
                match f x with
                | Parser p -> p rest
            )
        |> Parser

    open System

    let whitespace: Parser<string> =
        (List.toArray<char> >> String) <%> any (char ' ' <|> char '\t' <|> char '\r' <|> char '\n')

    let runParser (Parser parse) (input: string) =
        input
        |> StringTail.Create
        |> parse
        |> Seq.tryFind (fun (_,rest) -> rest.IsEmpty)
        |> Option.map (fun (x,_) -> x)

    type ParserBuilder() =
        member __.Bind (x, f) = x >>= f
        member __.Return x = constant x
        member __.Combine (l, r) = l <|> r

    let parser = ParserBuilder()