matchString.fs

open System
open System.Text

type StringIndex =
    struct
        val String: string
        val Index: int
    end

    new(s: string) = { String = s; Index = 0 }
    new(s: string, i: int) = { String = s; Index = i }

    member self.Length = self.String.Length
    member self.EOS = self.Index >= self.Length
    member self.Head = self.String.[self.Index]

let sform (pattern: (StringIndex -> StringIndex option)) (si: StringIndex) =
    pattern si

let (|EOS|_|) (si: StringIndex) =
    if si.EOS then Some(si) else None

let eos = sform (|EOS|_|)

let (|Any|_|) = function
    | EOS(_) -> None
    | si -> Some(StringIndex(si.String, si.Index + 1))

let any = sform (|Any|_|)

let (|Char|_|) (c: char) = function
    | EOS(_) -> None
    | si -> if si.Head = c then Some(StringIndex(si.String, si.Index + 1)) else None

let chr c = sform ((|Char|_|) c)

let (|String|_|) (s: string) = function
    | EOS(_) -> None
    | si ->
        let overlaps (s: string) (si: StringIndex) =
            if (si.Index + s.Length) <= si.Length then
                let mutable i = 0
                while i < s.Length && s.[i] = si.String.[si.Index + i] do
                    i <- i + 1

                i = s.Length
            else
                false

        if overlaps s si then Some(StringIndex(si.String, si.Index + s.Length)) else None

let str s = sform ((|String|_|) s)

let (|NewLine|_|) = function
    | Char('\n') si -> Some(si)
    | String("\r\n") si -> Some(si)
    | _ -> None

let nl = sform (|NewLine|_|)

let (|Start|_|) (si: StringIndex) =
    if si.Index = 0 then Some(si) else None

let start = sform (|Start|_|)

let (|Maybe|_|) s = function
    | String (s) si -> Some(si)
    | si -> Some(si)

let maybe s = sform ((|Maybe|_|) s)

let rec (|AnythingButStar|_|) s = function
    | String (s) _ -> None
    | Any si -> match si with | AnythingButStar (s) ssi -> Some(ssi) | _ -> None
    | EOS si | si -> Some(si)

let anythingBut s = sform ((|AnythingButStar|_|) s)

let matchString patterns s =
    let rec matchPattern p si =
        match p with
        | h :: t -> match h si with | Some(s) -> matchPattern t s | None -> false
        | [] -> true

    StringIndex(s) |> matchPattern patterns

let foo = [
    start;
    chr 'F';
    chr 'o';
    chr 'o';
    eos
]

Console.WriteLine(matchString foo "Foo")

let url = [
    start;
    str "http";
    maybe "s";
    str "://";
    maybe "www.";
    anythingBut " ";
    eos;
]

Console.WriteLine (matchString url "http://www.google.com")