parsing

open rust.rust_operators
open sm'_operators

//// test

open testing

fparsec

//// test

#r "nuget:FParsec"

///! _

()

Installing Packages

• FParsec

Installing Packages

• FParsec.

Installing Packages

• FParsec..

Installing Packages

• FParsec...

Installing Packages

• FParsec....

Installed Packages

• FParsec, 1.1.1

//// test

nominal position_ = $'FParsec.Position'
nominal parser_error_ = $'FParsec.Error.ParserError'

nominal reply_ t = $'FParsec.Reply<`t>'

nominal char_stream_ t = $'FParsec.CharStream<`t>'

// nominal parser t u = char_stream u -> reply t
nominal parser_ t u = $'FParsec.Primitives.Parser<`t, `u>'

inl p_char_ forall t. (x : char) : parser_ char t =
    x |> $'FParsec.CharParsers.pchar'

inl p_string_ forall t. (x : string) : parser_ string t =
    x |> $'FParsec.CharParsers.pstring'

inl (>>.$) forall t u v. (a : parser_ t v) (b : parser_ u v) : parser_ u v =
    b |> $'FParsec.Primitives.(>>.)' a

inl (.>>$) forall t u v. (a : parser_ t v) (b : parser_ u v) : parser_ t v =
    b |> $'FParsec.Primitives.(.>>)' a

inl (.>>.$) forall t u v. (a : parser_ t v) (b : parser_ u v) : parser_ (pair t u) v =
    b |> $'FParsec.Primitives.(.>>.)' a

inl (>>%$) forall t u v. (a : parser_ t v) (b : u) : parser_ u v =
    b |> $'FParsec.Primitives.(>>%)' a

inl (>>=$) forall t u v. (a : parser_ t v) (b : t -> parser_ u v) : parser_ u v =
    b |> $'FParsec.Primitives.(>>=)' a

inl (|>>$) forall t u v. (a : parser_ t v) (b : t -> u) : parser_ u v =
    inl b = fun x => x |> b
    b |> $'FParsec.Primitives.(|>>)' a

inl any_char_ () : parser_ char _ =
    $'FParsec.CharParsers.anyChar'

inl any_string_ () : parser_ string _ =
    $'FParsec.CharParsers.anyString'

inl any_string__ (n : i32) : parser_ string _ =
    n |> $'FParsec.CharParsers.anyString'

inl eof_ () : parser_ () _ =
    $'FParsec.CharParsers.eof'

inl spaces_ () : parser_ () () =
    $'FParsec.CharParsers.spaces'

inl spaces1_ () : parser_ () () =
    $'FParsec.CharParsers.spaces1'

inl (<|>$) forall t u. (a : parser_ t u) (b : parser_ t u) : parser_ t u =
    b |> $'FParsec.Primitives.(<|>)' a

inl many_satisfy_ forall t. (x : char -> bool) : parser_ string t =
    x |> $'FParsec.CharParsers.manySatisfy'

inl satisfy_ forall t. (x : char -> bool) : parser_ char t =
    x |> $'FParsec.CharParsers.satisfy'

inl none_of_ (x : list char) : parser_ char () =
    x
    |> listm'.box
    |> listm'.to_array'
    |> $'FParsec.CharParsers.noneOf'

inl any_of_ (x : list char) : parser_ char () =
    x
    |> listm'.box
    |> listm'.to_array'
    |> $'FParsec.CharParsers.anyOf'

inl skip_any_of_ (x : list char) : parser_ () () =
    x
    |> listm'.box
    |> listm'.to_array'
    |> $'FParsec.CharParsers.skipAnyOf'

inl between_ forall t u v x. (a : parser_ t x) (b : parser_ u x) (c : parser_ v x) : parser_ v x =
    c |> $'FParsec.Primitives.between' a b

inl many_chars_ forall t. (x : parser_ char t) : parser_ string t =
    x |> $'FParsec.CharParsers.manyChars'

inl many1_chars_ forall t. (x : parser_ char t) : parser_ string t =
    x |> $'FParsec.CharParsers.many1Chars'

inl many_strings_ forall t. (x : parser_ string t) : parser_ string t =
    x |> $'FParsec.CharParsers.manyStrings'

inl skip_any_string_ forall t. (n : i32) : parser_ () t =
    n |> $'FParsec.CharParsers.skipAnyString'

inl many1_strings_ forall t. (x : parser_ string t) : parser_ string t =
    x |> $'FParsec.CharParsers.many1Strings'

inl opt_ forall t u. (a : parser_ t u) : parser_ (optionm'.option' t) u =
    a |> $'FParsec.Primitives.opt'

inl choice_ forall t u. (a : list (parser_ t u)) : parser_ t u =
    a
    |> listm'.box
    |> seq.of_list'
    |> $'FParsec.Primitives.choice'

inl delay_ forall t u. (fn : () -> parser_ t u) : parser_ t u =
    fn |> $'FParsec.Primitives.parse.Delay'

inl peek_ forall t u. (a : parser_ t u) : parser_ char u =
    $'!a.Peek ()'

inl not_followed_by_ forall t u. (a : parser_ t u) : parser_ () u =
    a |> $'FParsec.Primitives.notFollowedBy'

inl sep_by_ forall t u v. (a : parser_ t v) (b : parser_ u v) : parser_ (listm'.list' t) v =
    b |> $'FParsec.Primitives.sepBy' a

inl sep_by1_ forall t u v. (a : parser_ t v) (b : parser_ u v) : parser_ (listm'.list' t) v =
    b |> $'FParsec.Primitives.sepBy1' a

inl sep_end_by_ forall t u v. (a : parser_ t v) (b : parser_ u v) : parser_ (listm'.list' t) v =
    b |> $'FParsec.Primitives.sepEndBy' a

inl many_ forall t u. (a : parser_ t u) : parser_ (listm'.list' t) u =
    a |> $'FParsec.Primitives.many'

inl many1_ forall t u. (a : parser_ t u) : parser_ (listm'.list' t) u =
    a |> $'FParsec.Primitives.many1'

inl many1_satisfy_ forall t. (x : char -> bool) : parser_ string t =
    x |> $'FParsec.CharParsers.many1Satisfy'

nominal parser_result'_ t u = $'FParsec.CharParsers.ParserResult<`t, `u>'

inl run_ forall t. (parser : parser_ t ()) (x : string) : parser_result'_ t () =
    x |> $'FParsec.CharParsers.run' parser

union parser_result_ t u =
    | Success : t * u * position_
    | Failure : string * parser_error_ * u

inl parser_result_ forall t u. = function
    | Success (a, b, c) => $'`(parser_result'_ t u).Success (!a, !b, !c)' : parser_result'_ t u
    | Failure (a, b, c) => $'`(parser_result'_ t u).Failure (!a, !b, !c)' : parser_result'_ t u

inl parser_result'_ forall t u. (x : parser_result'_ t u) : parser_result_ t u =
    $'let mutable _!x = None '
    $'match !x with'
    $'| FParsec.CharParsers.Success (a, b, c) -> (' : ()
    $'(fun () ->'
    $'(fun () ->'
    (Success ((dyn $'a'), dyn $'b', dyn $'c') : _ t u) |> emit_unit
    $')'
    $'|> fun x -> x ()'
    $') () ) | FParsec.CharParsers.Failure (a, b, c) -> (' : ()
    $'(fun () ->'
    $'(fun () ->'
    (Failure ((dyn $'a'), dyn $'b', dyn $'c') : _ t u) |> emit_unit
    $')'
    $'|> fun x -> x ()'
    $') () )' : ()
    $'|> fun x -> _!x <- Some x'
    $'match _!x with Some x -> x | None -> failwith "??? / _!x=None"'

inl parse_ parser input : result _ _ =
    match input |> run_ parser |> parser_result'_ with
    | Success (result, b, c) => Ok (result, c)
    | Failure (error_msg, b, c) => Error (error_msg, b)

//// test

inl split_args (args : string) : result (array_base (string * position_)) (string * parser_error_) =
    inl esc = [ '\\'; '`' ]
    inl quotes = [ '"' ]
    inl special = esc ++ quotes
    inl p_esc_char c =
        p_char_ c >>.$ any_char_ () |>>$ fun c' => $'$"{!c}{!c'}"'
    inl p_word = special |> none_of_ |>>$ sm'.obj_to_string
    inl p_plain = special ++ [ ' ' ] |> none_of_ |> many1_chars_
    inl p_text = p_word |> many1_strings_
    inl p_esc = esc |> listm.map p_esc_char |> choice_
    inl p_quoted = (p_word <|>$ p_esc) |> many_ |>>$ (seq.of_list' >> sm'.concat "")
    inl p_quoted_all = p_quoted |> between_ (p_char_ '"') (p_char_ '"')
    inl p_esc_root = p_esc |>>$ (fun _ => "") >>.$ (p_word |> many_) |>>$ (seq.of_list' >> sm'.concat "")
    inl p_content = p_plain <|>$ p_quoted_all <|>$ p_esc_root
    inl p_args = spaces1_ () |> sep_by_ p_content
    args
    |> parse_ p_args
    |> resultm.map fun (a', b') =>
        (
            (
                a'
                |> listm'.to_array'
                |> a
                |> am.map fun x => x, b'
                |> fun (a x : _ i32 _) => x
            )
        )

[
    "a b c",
    ;[ "a"; "b"; "c" ]

    "e f \"g h\" i",
    ;[ "e"; "f"; "g h"; "i" ]

    "\"j k\" \"l\" \"m\"",
    ;[ "j k"; "l"; "m" ]

    "s -t \"u \`\"v\`\" w\"",
    ;[ "s"; "-t"; "u \`\"v\`\" w" ]

    "n -o \"p \\\"q\\\" r\"",
    ;[ "n"; "-o"; "p \\\"q\\\" r" ]

    "r -s \"t \\\"u\\\"\"",
    ;[ "r"; "-s"; "t \\\"u\\\"" ]

    $'$"x -y \\\"$z -a \'(b=\\\\\\"c-id=)[a-fA-F0-9]{{8}}\', {{ \`$_[1] + \`$d++ }}\\\""',
    ;[ "x"; "-y"; "$z -a '(b=\\\"c-id=)[a-fA-F0-9]{8}', { `$_[1] + `$d++ }" ]

    "e -f \"$g -h '(i=`\"j-id=)[a-fA-F0-9]{8}', { `$_[1] + `$k++ }\"",
    ;[ "e"; "-f"; "$g -h '(i=`\"j-id=)[a-fA-F0-9]{8}', { `$_[1] + `$k++ }" ]

    $'$"--l \\\\\\"\'\'\' m \'\'\'\\\\\\" "',
    ;[ "--l"; "''' m '''" ]

    $'$"n --o --p q --r \\\"s:/t u/v.w\\\" --x \\\"y:/z.a\\\" --b c.d \\\"\\\\e{{f-g}}\\\" h.i \\\"j (k)\\\""',
    ;[ "n"; "--o"; "--p"; "q"; "--r"; "s:/t u/v.w"; "--x"; "y:/z.a"; "--b"; "c.d"; "\\e{f-g}"; "h.i"; "j (k)" ]

    $'\@$"l ""m n:\\o.p"""',
    ;[ "l"; "m n:\\o.p" ]
]
|> listm.rev
|> listm.map fun input, expected =>
    input
    |> split_args
    |> fun x =>
        try
            fun () =>
                ($'$"\ninput: {!input}"' : string)
                |> console.write_line
                x
                |> resultm.get
                |> am'.map_base fst
                |> _assert_eq' expected
                false
            fun ex =>
                ($'$"error / expected: %A{!expected} / ex: %A{!ex}"' : string)
                |> console.write_line
                Some true
        |> optionm.value
|> listm'.filter id
|> function
    | [] => ()
    | x => failwith $'$"{!x}"'

input: a b c
__assert_eq' / actual: [|"a"; "b"; "c"|] / expected: [|"a"; "b"; "c"|]

input: e f "g h" i
__assert_eq' / actual: [|"e"; "f"; "g h"; "i"|] / expected: [|"e"; "f"; "g h"; "i"|]

input: "j k" "l" "m"
__assert_eq' / actual: [|"j k"; "l"; "m"|] / expected: [|"j k"; "l"; "m"|]

input: s -t "u `"v`" w"
__assert_eq' / actual: [|"s"; "-t"; "u `"v`" w"|] / expected: [|"s"; "-t"; "u `"v`" w"|]

input: n -o "p \"q\" r"
__assert_eq' / actual: [|"n"; "-o"; "p \"q\" r"|] / expected: [|"n"; "-o"; "p \"q\" r"|]

input: r -s "t \"u\""
__assert_eq' / actual: [|"r"; "-s"; "t \"u\""|] / expected: [|"r"; "-s"; "t \"u\""|]

input: x -y "$z -a '(b=\"c-id=)[a-fA-F0-9]{8}', { `$_[1] + `$d++ }"
__assert_eq' / actual: [|"x"; "-y"; "$z -a '(b=\"c-id=)[a-fA-F0-9]{8}', { `$_[1] + `$d++ }"|] / expected: [|"x"; "-y"; "$z -a '(b=\"c-id=)[a-fA-F0-9]{8}', { `$_[1] + `$d++ }"|]

input: e -f "$g -h '(i=`"j-id=)[a-fA-F0-9]{8}', { `$_[1] + `$k++ }"
__assert_eq' / actual: [|"e"; "-f"; "$g -h '(i=`"j-id=)[a-fA-F0-9]{8}', { `$_[1] + `$k++ }"|] / expected: [|"e"; "-f"; "$g -h '(i=`"j-id=)[a-fA-F0-9]{8}', { `$_[1] + `$k++ }"|]

input: --l \"''' m '''\" 
__assert_eq' / actual: [|"--l"; "''' m '''"|] / expected: [|"--l"; "''' m '''"|]

input: n --o --p q --r "s:/t u/v.w" --x "y:/z.a" --b c.d "\e{f-g}" h.i "j (k)"
__assert_eq' / actual: [|"n"; "--o"; "--p"; "q"; "--r"; "s:/t u/v.w"; "--x"; "y:/z.a"; "--b"; "c.d";
  "\e{f-g}"; "h.i"; "j (k)"|] / expected: [|"n"; "--o"; "--p"; "q"; "--r"; "s:/t u/v.w"; "--x"; "y:/z.a"; "--b"; "c.d";
  "\e{f-g}"; "h.i"; "j (k)"|]

input: l "m n:\o.p"
__assert_eq' / actual: [|"l"; "m n:\o.p"|] / expected: [|"l"; "m n:\o.p"|]

parsing

range

type range =
    {
        from : int
        to : int
    }

position

type position =
    {
        line : int
        col : int
    }

parser_state

nominal parser_state =
    {
        line_text : sm'.string_builder
        position : position
    }

parser

type parser t = string * parser_state -> result (t * string * parser_state) string

parse

inl parse forall t. (p : parser t) (input : string) : result (t * string * parser_state) string =
    inl input =
        input
        |> optionm'.of_obj
        |> optionm'.default_value' ""
    p (input, { line_text = "" |> sm'.string_builder; position = { line = 1; col = 1 } } |> parser_state)

inc

inl inc c (parser_state s) =
    match c with
    | '\n' => { line = s.position.line + 1; col = 1 }
    | _ => { s.position with col = s.position.col + 1 }.position

update

inl update result s =
    (s, result |> sm'.to_char_array |> a |> (fun x => x : _ int _) |> am'.to_list' |> listm'.unbox)
    ||> listm.fold fun (parser_state s) c =>
        { s with
            position = s |> parser_state |> inc c
            line_text =
                match c with
                | '\n' => s.line_text |> sm'.builder_clear
                | c => s.line_text |> sm'.builder_append (sm'.obj_to_string c)
        } |> parser_state

any_char

inl any_char () : parser char = function
    | "", s => Error $'$"parsing.any_char / unexpected end of input / s: %A{!s}"'
    | x, s =>
        inl first_char = x |> sm'.index 0i32
        inl rest = x |> sm'.range (am'.Start 1i32) (am'.End id)
        in Ok (first_char, rest, s |> update (sm'.obj_to_string first_char))

//// test

"abc"
|> parse (any_char ())
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    ('a', "bc", { line_text = "a" |> sm'.string_builder; position = { line = 1i32; col = 2i32 } })
    |> sm'.format_debug
)

__assert_eq / actual: "struct ('a', "bc", a, 1, 2)" / expected: "struct ('a', "bc", a, 1, 2)"

//// test

"abc"
|> parse_ (any_char_ ())
|> resultm.get
|> sm'.format_debug
|> _assert_eq' (('a', ($'FParsec.Position (null, 0, 1, 2)' : position_)) |> sm'.format_debug)

__assert_eq' / actual: "struct ('a', (Ln: 1, Col: 2))" / expected: "struct ('a', (Ln: 1, Col: 2))"

p_char

inl p_char (c : char) : parser char = function
    | "", s => Error $'$"parsing.p_char / unexpected end of input / s: %A{!s}"'
    | input, parser_state ({ line_text position = { line col } } as s) =>
        inl first_char = input |> sm'.index 0i32
        if first_char = c
        then Ok (
            first_char,
            input |> sm'.range (am'.Start 1i32) (am'.End id),
            s |> parser_state |> update (sm'.obj_to_string first_char)
        )
        else
            inl message : string =
                inl rest =
                    input
                    |> sm'.range
                        (am'.Start 0i32)
                        (am'.End fun l =>
                            match (input |> sm'.index_of "\n") - 1 with
                            | -2 => l
                            | l => l
                        )
                $'$"parsing.p_char / expected: \'{!c}\' / line: {!line} / col: {!col}\n{!line_text}{!rest}"'
            inl pointer_line = (sm'.replicate (col - 1) " ") +. "^"
            $'$"{!message}\n{!pointer_line}\n"' |> Error

//// test

"abc"
|> parse (p_char 'a')
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    ('a', "bc", { line_text = "a" |> sm'.string_builder; position = { line = 1i32; col = 2i32 } })
    |> sm'.format_debug
)

__assert_eq / actual: "struct ('a', "bc", a, 1, 2)" / expected: "struct ('a', "bc", a, 1, 2)"

//// test

"abc"
|> parse_ (p_char_ 'a')
|> resultm.get
|> sm'.format_debug
|> _assert_eq' (('a', ($'FParsec.Position (null, 0, 1, 2)' : position_)) |> sm'.format_debug)

__assert_eq' / actual: "struct ('a', (Ln: 1, Col: 2))" / expected: "struct ('a', (Ln: 1, Col: 2))"

any_string

inl any_string length : parser string = fun input, s =>
    if sm'.length input < length
    then Error $'$"parsing.any_string / unexpected end of input / s: %A{!s}"'
    else
        inl result = input |> sm'.range (am'.Start 0i32) (am'.End fun _ => length - 1)
        inl rest = input |> sm'.range (am'.Start length) (am'.End id)
        Ok (result, rest, s |> update result)

//// test

"abcdef"
|> parse (any_string 3i32)
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    ("abc", "def", { line_text = "abc" |> sm'.string_builder; position = { line = 1i32; col = 4i32 } })
    |> sm'.format_debug
)

__assert_eq / actual: "struct ("abc", "def", abc, 1, 4)" / expected: "struct ("abc", "def", abc, 1, 4)"

//// test

"abcdef"
|> parse_ (any_string__ 3)
|> resultm.get
|> sm'.obj_to_string
|> _assert_eq' (("abc", ($'FParsec.Position (null, 0, 1, 4)' : position_)) |> sm'.obj_to_string)

__assert_eq' / actual: "(abc, (Ln: 1, Col: 4))" / expected: "(abc, (Ln: 1, Col: 4))"

skip_any_string

inl skip_any_string length : parser () = fun input, s =>
    if sm'.length input < length
    then Error $'$"parsing.skip_any_string / unexpected end of input / s: %A{!s}"'
    else Ok (
        (),
        input |> sm'.range (am'.Start length) (am'.End id),
        s |> update (input |> sm'.range (am'.Start 0i32) (am'.End fun _ => length - 1))
    )

//// test

"abcdef"
|> parse (skip_any_string 3i32)
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    ((), "def", { line_text = "abc" |> sm'.string_builder; position = { line = 1i32; col = 4i32 } })
    |> sm'.format_debug
)

__assert_eq / actual: "struct ("def", abc, 1, 4)" / expected: "struct ("def", abc, 1, 4)"

(>>.)

inl (>>.) forall t u. (a : parser t) (b : parser u) : parser u = fun input, s =>
    match a (input, s) with
    | Ok (_, rest, s) => b (rest, s)
    | Error e => Error e

(>>.)

inl (.>>) forall t u. (a : parser t) (b : parser u) : parser t = fun input, s =>
    match a (input, s) with
    | Ok (result, rest, s) =>
        match b (rest, s) with
        | Ok (_, rest, s) => Ok (result, rest, s)
        | Error e => Error e
    | Error e => Error e

(.>>.)

inl (.>>.) forall t u. (a : parser t) (b : parser u) : parser (t * u) = fun input, s =>
    match a (input, s) with
    | Ok (result_a, rest, s) =>
        match b (rest, s) with
        | Ok (result_b, rest, s) => Ok ((result_a, result_b), rest, s)
        | Error e => Error e
    | Error e => Error e

(>>%)

inl (>>%) forall t u. (a : parser t) (b : u) : parser u = fun input, s =>
    match a (input, s) with
    | Ok (_, rest, s) => Ok (b, rest, s)
    | Error e => Error e

//// test

"abc"
|> parse (p_char 'a' >>. p_char 'b')
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    ('b', "c", { line_text = "ab" |> sm'.string_builder; position = { line = 1i32; col = 3i32 } })
    |> sm'.format_debug
)

"abc\ndef\nghi"
|> parse (skip_any_string 5i32 >>. p_char 'a')
|> _assert_eq (Error "parsing.p_char / expected: 'a' / line: 2 / col: 2\ndef\n ^\n")

__assert_eq / actual: "struct ('b', "c", ab, 1, 3)" / expected: "struct ('b', "c", ab, 1, 3)"
__assert_eq / actual: US0_1 "parsing.p_char / expected: 'a' / line: 2 / col: 2
def
 ^
" / expected: US0_1 "parsing.p_char / expected: 'a' / line: 2 / col: 2
def
 ^
"

//// test

"abc"
|> parse_ (p_char_ 'a' >>.$ p_char_ 'b')
|> resultm.get
|> sm'.obj_to_string
|> _assert_eq' (('b', ($'FParsec.Position (null, 0, 1, 3)' : position_)) |> sm'.obj_to_string)

__assert_eq' / actual: "(b, (Ln: 1, Col: 3))" / expected: "(b, (Ln: 1, Col: 3))"

//// test

"abc\ndef\nghi"
|> parse_ (skip_any_string_ 5 >>.$ p_char_ 'a')
|> resultm.unwrap_err
|> sm'.obj_to_string
|> sm'.replace "\r\n" "\n"
|> _assert_eq "(Error in Ln: 2 Col: 2\ndef\n ^\nExpecting: 'a'\n, Error in Ln: 2 Col: 2\nExpecting: 'a'\n)"

__assert_eq / actual: "(Error in Ln: 2 Col: 2
def
 ^
Expecting: 'a'
, Error in Ln: 2 Col: 2
Expecting: 'a'
)" / expected: "(Error in Ln: 2 Col: 2
def
 ^
Expecting: 'a'
, Error in Ln: 2 Col: 2
Expecting: 'a'
)"

none_of

inl none_of (chars : list char) : parser char = function
    | "", s =>
        inl chars = chars |> listm'.box |> listm'.to_array'
        Error $'$"parsing.none_of / unexpected end of input / chars: %A{!chars} / s: %A{!s}"'
    | x, s =>
        inl first_char = x |> sm'.index 0i32
        inl rest = x |> sm'.range (am'.Start 1i32) (am'.End id)
        if chars |> listm'.exists' ((=) first_char) |> not
        then Ok (first_char, rest, s |> update (sm'.obj_to_string first_char))
        else
            inl chars = chars |> listm'.box |> listm'.to_array'
            Error $'$"parsing.none_of / unexpected char: \'{!first_char}\' / chars: %A{!chars} / s: %A{!s}"'

//// test

"abc"
|> parse (none_of ['a'; 'b'; 'c'])
|> _assert_eq (Error "parsing.none_of / unexpected char: \'a\' / chars: [|'a'; 'b'; 'c'|] / s: struct (, 1, 1)")

"def"
|> parse (none_of ['a'; 'b'; 'c'])
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    ('d', "ef", { line_text = "d" |> sm'.string_builder; position = { line = 1i32; col = 2i32 } })
    |> sm'.format_debug
)

__assert_eq / actual: US0_1
  "parsing.none_of / unexpected char: 'a' / chars: [|'a'; 'b'; 'c'|] / s: struct (, 1, 1)" / expected: US0_1
  "parsing.none_of / unexpected char: 'a' / chars: [|'a'; 'b'; 'c'|] / s: struct (, 1, 1)"
__assert_eq / actual: "struct ('d', "ef", d, 1, 2)" / expected: "struct ('d', "ef", d, 1, 2)"

//// test

"abc"
|> parse_ (none_of_ ['a'; 'b'; 'c'])
|> resultm.unwrap_err
|> sm'.obj_to_string
|> sm'.replace "\r\n" "\n"
|> _assert_eq ($'"(Error in Ln: 1 Col: 1\nabc\n^\nExpecting: any char not in ‘abc’\n, Error in Ln: 1 Col: 1\nExpecting: any char not in ‘abc’\n)"')

"def"
|> parse_ (none_of_ ['a'; 'b'; 'c'])
|> resultm.get
|> sm'.obj_to_string
|> _assert_eq' (('d', ($'FParsec.Position (null, 0, 1, 2)' : position_)) |> sm'.obj_to_string)

__assert_eq / actual: "(Error in Ln: 1 Col: 1
abc
^
Expecting: any char not in ‘abc’
, Error in Ln: 1 Col: 1
Expecting: any char not in ‘abc’
)" / expected: "(Error in Ln: 1 Col: 1
abc
^
Expecting: any char not in ‘abc’
, Error in Ln: 1 Col: 1
Expecting: any char not in ‘abc’
)"
__assert_eq' / actual: "(d, (Ln: 1, Col: 2))" / expected: "(d, (Ln: 1, Col: 2))"

(<|>)

inl (<|>) forall t. (a : parser t) (b : parser t) : parser t = fun input, s =>
    match a (input, s) with
    | Ok _ as result => result
    | Error _ => b (input, s)

//// test

"abc"
|> parse (p_char 'a' <|> p_char 'b')
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    ('a', "bc", { line_text = "a" |> sm'.string_builder; position = { line = 1i32; col = 2i32 } })
    |> sm'.format_debug
)

"cba"
|> parse (p_char 'a' <|> p_char 'b')
|> _assert_eq (Error "parsing.p_char / expected: 'b' / line: 1 / col: 1\ncba\n^\n")

__assert_eq / actual: "struct ('a', "bc", a, 1, 2)" / expected: "struct ('a', "bc", a, 1, 2)"
__assert_eq / actual: US0_1 "parsing.p_char / expected: 'b' / line: 1 / col: 1
cba
^
" / expected: US0_1 "parsing.p_char / expected: 'b' / line: 1 / col: 1
cba
^
"

(|>>)

inl (|>>) p f : parser _ = fun input =>
    match p input with
    | Ok (result, rest) => Ok (f result, rest)
    | Error e => Error e

//// test

"abc"
|> parse (p_char 'a' |>> sm'.char_to_upper)
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    ('A', "bc", { line_text = "a" |> sm'.string_builder; position = { line = 1i32; col = 2i32 } })
    |> sm'.format_debug
)

__assert_eq / actual: "struct ('A', "bc", a, 1, 2)" / expected: "struct ('A', "bc", a, 1, 2)"

many

inl many p : parser (list _) = fun input =>
    let rec loop acc input =
        match p input with
        | Ok (result, rest) => loop (result :: acc) rest
        | Error _ => Ok (listm.rev acc, input)
    loop [] input

//// test

"aaabbc"
|> parse (many (p_char 'a' <|> p_char 'b'))
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    (['a'; 'a'; 'a'; 'b'; 'b'], "c", { line_text = "aaabb" |> sm'.string_builder; position = { line = 1i32; col = 6i32 } })
    |> sm'.format_debug
)

__assert_eq / actual: "struct (UH0_1 ('a', UH0_1 ('a', UH0_1 ('a', UH0_1 ('b', UH0_1 ('b', UH0_0))))),
        "c", aaabb, 1, 6)" / expected: "struct (UH0_1 ('a', UH0_1 ('a', UH0_1 ('a', UH0_1 ('b', UH0_1 ('b', UH0_0))))),
        "c", aaabb, 1, 6)"

many1_chars

inl many1_chars p : parser string = fun input =>
    match p input with
    | Error e => Error e
    | Ok (first_result, rest) =>
        let rec loop acc input =
            match p input with
            | Ok (result, rest) => loop (acc +. sm'.obj_to_string result) rest
            | Error _ => Ok (acc, input)
        loop (sm'.obj_to_string first_result) rest

//// test

"aaabbc"
|> parse (many1_chars (p_char 'a' <|> p_char 'b'))
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    ("aaabb", "c", { line_text = "aaabb" |> sm'.string_builder; position = { line = 1i32; col = 6i32 } })
    |> sm'.format_debug
)

__assert_eq / actual: "struct ("aaabb", "c", aaabb, 1, 6)" / expected: "struct ("aaabb", "c", aaabb, 1, 6)"

many_chars

inl many_chars p : parser string = fun input =>
    match many1_chars p input with
    | Ok (result, rest) => Ok (result, rest)
    | Error e => Ok ("", input)

many_chars_till

inl many_chars_till p end_p : parser string = fun input =>
    match end_p input with
    | Ok _ => Ok ("", input)
    | Error _ =>
        match many_chars p input with
        | Ok (result, rest) => Ok (result, rest)
        | Error e => Error e

many1

inl many1 p : parser (list _) = fun input =>
    match p input with
    | Error e => Error e
    | Ok (first_result, rest) =>
        let rec loop acc input =
            match p input with
            | Ok (result, rest) => loop (result :: acc) rest
            | Error _ => Ok (listm.rev acc, input)
        loop [ first_result ] rest

//// test

"aaabbc"
|> parse (many1 (p_char 'a' <|> p_char 'b'))
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    (['a'; 'a'; 'a'; 'b'; 'b'], "c", { line_text = "aaabb" |> sm'.string_builder; position = { line = 1i32; col = 6i32 } })
    |> sm'.format_debug
)

"bcc"
|> parse (many1 (p_char 'a' <|> p_char 'b'))
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    (['b'], "cc", { line_text = "b" |> sm'.string_builder; position = { line = 1i32; col = 2i32 } })
    |> sm'.format_debug
)

"cba"
|> parse (many1 (p_char 'a' <|> p_char 'b'))
|> _assert_eq (Error "parsing.p_char / expected: 'b' / line: 1 / col: 1\ncba\n^\n")

__assert_eq / actual: "struct (UH0_1 ('a', UH0_1 ('a', UH0_1 ('a', UH0_1 ('b', UH0_1 ('b', UH0_0))))),
        "c", aaabb, 1, 6)" / expected: "struct (UH0_1 ('a', UH0_1 ('a', UH0_1 ('a', UH0_1 ('b', UH0_1 ('b', UH0_0))))),
        "c", aaabb, 1, 6)"
__assert_eq / actual: "struct (UH0_1 ('b', UH0_0), "cc", b, 1, 2)" / expected: "struct (UH0_1 ('b', UH0_0), "cc", b, 1, 2)"
__assert_eq / actual: US1_1 "parsing.p_char / expected: 'b' / line: 1 / col: 1
cba
^
" / expected: US1_1 "parsing.p_char / expected: 'b' / line: 1 / col: 1
cba
^
"

many1_strings

inl many1_strings p : parser string = fun input =>
    match many1 p input with
    | Ok (results, rest) =>
        Ok (results |> listm.map sm'.obj_to_string |> listm'.box |> seq.of_list' |> sm'.concat "", rest)
    | Error e => Error e

//// test

"aaabbc"
|> parse (many1_strings (p_char 'a' <|> p_char 'b'))
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    ("aaabb", "c", { line_text = "aaabb" |> sm'.string_builder; position = { line = 1i32; col = 6i32 } })
    |> sm'.format_debug
)

__assert_eq / actual: "struct ("aaabb", "c", aaabb, 1, 6)" / expected: "struct ("aaabb", "c", aaabb, 1, 6)"

many_strings

inl many_strings p : parser string = fun input =>
    match many p input with
    | Ok (results, rest) =>
        Ok (results |> listm.map sm'.obj_to_string |> listm'.box |> seq.of_list' |> sm'.concat "", rest)
    | Error e => Ok ("", input)

choice

inl choice parsers : parser _ = fun input =>
    let rec loop = function
        | [] => Error "choice / no parsers succeeded"
        | p :: ps =>
            match p input with
            | Ok _ as result => result
            | Error _ => loop ps
    loop parsers

//// test

"bca"
|> parse (choice [p_char 'a'; p_char 'b'; p_char 'c'])
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    ('b', "ca", { line_text = "b" |> sm'.string_builder; position = { line = 1i32; col = 2i32 } })
    |> sm'.format_debug
)

"cba"
|> parse (choice [p_char 'a'; p_char 'b'; p_char 'c'])
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    ('c', "ba", { line_text = "c" |> sm'.string_builder; position = { line = 1i32; col = 2i32 } })
    |> sm'.format_debug
)

__assert_eq / actual: "struct ('b', "ca", b, 1, 2)" / expected: "struct ('b', "ca", b, 1, 2)"
__assert_eq / actual: "struct ('c', "ba", c, 1, 2)" / expected: "struct ('c', "ba", c, 1, 2)"

between

inl between p_open p_close p_content : parser _ = fun input =>
    match p_open input with
    | Ok (_, rest1) =>
        match p_content rest1 with
        | Ok (result, rest2) =>
            match p_close rest2 with
            | Ok (_, rest3) => Ok (result, rest3)
            | Error e => Error $'$"between / expected closing delimiter / e: %A{!e} / input: %A{!input} / rest1: %A{!rest1} / rest2: %A{!rest2}"'
        | Error _ => Error "between / expected content"
    | Error e => Error e

//// test

"[aaabb]"
|> parse (between (p_char '[') (p_char ']') (many1_chars (p_char 'a' <|> p_char 'b')))
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    ("aaabb", "", { line_text = "[aaabb]" |> sm'.string_builder; position = { line = 1i32; col = 8i32 } })
    |> sm'.format_debug
)

"[aaabb"
|> parse (between (p_char '[') (p_char ']') (many1_chars (p_char 'a' <|> p_char 'b')))
|> resultm.unwrap_err
|> sm'.format_debug
|> _assert_eq "\"between / expected closing delimiter / e: \"parsing.p_char / unexpected end of input / s: struct ([aaabb, 1, 7)\" / input: struct (\"[aaabb\", [aaabb, 1, 1) / rest1: struct (\"aaabb\", [aaabb, 1, 2) / rest2: struct (\"\", [aaabb, 1, 7)\""

__assert_eq / actual: "struct ("aaabb", "", [aaabb], 1, 8)" / expected: "struct ("aaabb", "", [aaabb], 1, 8)"
__assert_eq / actual: ""between / expected closing delimiter / e: "parsing.p_char / unexpected end of input / s: struct ([aaabb, 1, 7)" / input: struct ("[aaabb", [aaabb, 1, 1) / rest1: struct ("aaabb", [aaabb, 1, 2) / rest2: struct ("", [aaabb, 1, 7)"" / expected: ""between / expected closing delimiter / e: "parsing.p_char / unexpected end of input / s: struct ([aaabb, 1, 7)" / input: struct ("[aaabb", [aaabb, 1, 1) / rest1: struct ("aaabb", [aaabb, 1, 2) / rest2: struct ("", [aaabb, 1, 7)""

sep_by

inl sep_by p sep : parser (list _) = fun input, s =>
    let rec loop acc input s =
        match p (input, s) with
        | Error _ => Ok (acc |> listm.rev, input, s)
        | Ok (result, rest, s) =>
            match sep (rest, s) with
            | Error _ => Ok ((result :: acc) |> listm.rev, rest, s)
            | Ok (_, rest, s) => loop (result :: acc) rest s
    loop [] input s

span

inl span pred str =
    let rec loop i =
        if i >= sm'.length str
        then i
        elif pred (str |> sm'.index i)
        then loop (i + 1)
        else i
    loop 0

spaces1

inl spaces1 () : parser () = fun input, s =>
    match input |> span fun c => c = ' ' with
    | 0i32 => Error "spaces1 / expected at least one space"
    | n => Ok ((), input |> sm'.range (am'.Start n) (am'.End id), s)

spaces

inl spaces () : parser () = fun input, s =>
    input
    |> span fun c => c = ' '
    |> fun (n : i32) => Ok ((), input |> sm'.range (am'.Start n) (am'.End id), s)

p_digit

inl p_digit () : parser char = fun input, s =>
    match input |> sm'.index 0i32 with
    | ('0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9') as c =>
        Ok (c, input |> sm'.range (am'.Start 1i32) (am'.End id), s)
    | c => Error $'$"p_digit / unexpected char: {!c}"'

//// test

"1 2 3"
|> parse (sep_by (p_digit ()) (spaces1 ()))
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    (['1'; '2'; '3'], "", { line_text = "" |> sm'.string_builder; position = { col = 1i32; line = 1i32 } })
    |> sm'.format_debug
)

__assert_eq / actual: "struct (UH0_1 ('1', UH0_1 ('2', UH0_1 ('3', UH0_0))), "", , 1, 1)" / expected: "struct (UH0_1 ('1', UH0_1 ('2', UH0_1 ('3', UH0_0))), "", , 1, 1)"

//// test

"1 a 2"
|> parse (sep_by (p_digit ()) (spaces1 ()))
|> resultm.get
|> sm'.format_debug
|> _assert_eq (
    (['1'], "a 2", { line_text = "" |> sm'.string_builder; position = { col = 1i32; line = 1i32 } })
    |> sm'.format_debug
)

__assert_eq / actual: "struct (UH0_1 ('1', UH0_0), "a 2", , 1, 1)" / expected: "struct (UH0_1 ('1', UH0_0), "a 2", , 1, 1)"

opt

inl opt p : parser (option _) = fun input, s =>
    match p (input, s) with
    | Ok (result, rest, s) => Ok (Some result, rest, s)
    | Error _ => Ok (None, input, s)

rest_of_line

inl rest_of_line () : parser string = fun input, s =>
    inl i : i32 = input |> span ((<>) '\n')
    Ok (input |> sm'.range (am'.Start i) (am'.End id), input |> sm'.range (am'.Start i) (am'.End id), s)

eof

inl eof () : parser () = fun input, s =>
    if sm'.length input = 0i32
    then Ok ((), input, s)
    else Error $'$"parsing.eof / expected end of input / input: %A{!input}"'