KumaChan/stdlib/json/parser.km

type Parser [out T, out E]
    &(String) => Result[(T,String),(E,String)];
    // note: currently, the error type (E,String) is an ad-hoc implementation
    //       (fatal errors and non-fatal errors should be distinguished)

function make-lazy:[T,E]
    &(&() => Parser[T,E]) => Parser[T,E]
    &(thunk) => &(input) =>
        let parse := { thunk () },
        { parse input };

function output:[T]
    &(T) => Parser[T,never]
    &(value) => &(input) => { Success (value, input) };

function throw:[E]
    &(E) => Parser[never,E]
    &(err) => &(input) => { Failure (err, input) };

function consume:[E]
    &(String, E) => Parser[unit,E]
    &(target, err) => &(input) =>
        switch (input.[String] shift-prefix target):
        case Some input:
            { Success ((), input) },
        case None:
            { Failure (err, input) },
        end;

function with-ignored:[T,E]
    &(Parser[T,E], Parser[unit,E]) => Parser[T,E]
    &(parse-t, parse-blank) =>
        let parse-blanks:
            &(String) => String :=
            &(input) rec(parse-blanks) =>
                switch { parse-blank input }:
                case Success (_, input):
                    { parse-blanks input },
                case Failure _:
                    input,
                end,
        &(input) =>
            { parse-t { parse-blanks input } }
                . { map &(t, input) => (t, { parse-blanks input }) };

function map:[A,B,E]
    &(Parser[A,E], &(A) => B) => Parser[B,E]
    &(parse-a, a->b) => &(input) =>
        switch { parse-a input }:
        case Success (a, input):
            { Success ({ a->b a }, input) },
        case Failure err:
            { Failure err },
        end;

function apply:[T,R,E]
    &(Parser[T,E], &(T) => Parser[R,E]) => Parser[R,E]
    &(parse, k) => &(input) =>
        switch { parse input }:
        case Success (value, input):
            let parse-next := { k(value) },
            { parse-next input },
        case Failure err:
            { Failure err },
        end;

function choose:[T,E]
    &(List[Parser[T,E]]) => Parser[T,E]
    &(parsers) =>
        \ (first, rest) := assert-some { shift parsers },
        (rest reduce (first, &(parse-prev, parse-this) => &(input) =>
            switch { parse-prev input }:
            case Success parsed:
                { Success parsed },
            case Failure (prev-err, prev-remaining):
                switch { parse-this input }:
                case Success parsed:
                    { Success parsed },
                case Failure (this-err, this-remaining):
                    if (this-remaining.{length} < prev-remaining.{length}):
                        { Failure (this-err, this-remaining) },
                    else:
                        { Failure (prev-err, prev-remaining) },
                end,
            end
        ));

function repeat:[T,E]
    &(Parser[T,E]) => Parser[List[T],E]
    &(item) => &(input) =>
        let proceed:
            &(String, Seq[T]) => Result[(Seq[T],String),(E,String)] :=
            &(input, seq) rec(proceed) =>
                switch { item input }:
                case Success (value, input):
                    { proceed (input, (value cons seq)) },
                case Failure _:
                    { Success (seq, input) },
                end,
        { proceed (input, Nil) }
            . { map &(seq, input) => (seq.{List}.{reverse}, input) };

function repeat:[T,E]
    & { item: Parser[T,E], sep: Parser[unit,E] } => Parser[List[T],E]
    & { item, sep } => &(input) =>
        let proceed:
            &(String, Seq[T]) => Result[(Seq[T],String),(E,String)] :=
            &(input, seq) rec(proceed) =>
                switch { item input }:
                case Success (value, input):
                    let seq := (value cons seq),
                    switch { sep input }:
                    case Success (_, input):
                        { proceed (input, seq) },
                    case Failure _:
                        { Success (seq, input) },
                    end,
                case Failure err:
                    if seq.{is-nil}:
                        { Success (Nil, input) },
                    else:
                        { Failure err },
                end,
        { proceed (input, Nil) }
            . { map &(seq, input) => (seq.{List}.{reverse}, input) };