Monadic parser combinators in JS

nanoparsec.js

require("@babel/polyfill");
const {
  adt,
  _,
  fail,
  Maybe,
  Fn,
  Arr,
  implement,
  Chain,
  Apply,
  Functor
} = require("@masaeedu/fp");

// Utils
const deriveMonad = Fn.pipe([
  implement(Chain),
  implement(Apply),
  implement(Functor),
  implement(Apply)
]);

const Applicanoid = A => M => ({
  empty: A.of(M.empty),
  append: A.lift2(M.append)
});

const Str = (() => {
  const Nil = "";
  const Cons = x => xs => `${x}${xs}`;
  const match = ({ Nil, Cons }) => s =>
    s === "" ? Nil : Cons(s[0])(s.slice(1));

  return { Nil, Cons, match };
})();

const Arr_ = (() => {
  const Nil = [];
  const Cons = x => xs => [x, ...xs];
  const match = ({ Nil, Cons }) => xs =>
    xs.length === 0 ? Nil : Cons(xs[0])(xs.slice(1));

  return { Nil, Cons, match };
})();

// :: [Char]
const digits = Arr.range(10).map(x => x.toString());
// :: Char -> Bool
const isDigit = c => digits.indexOf(c) !== -1;

// Parsing

// A parser is a function from a string to a number of
// possibly partial interpretations of that string
// :: type Parser a = String -> [(a, String)]
const Parser = (() => {
  // Monad

  // Force a single interpretation of a string
  // without consuming any of it
  // :: x -> Parser x
  const of = x => s => [[x, s]];

  // Partially parse a string, then for every interpretation
  // generate a parser to parse the remainder of the string
  // under that interpretation
  // :: (a -> Parser b) -> Parser a -> Parser b
  const chain = f => p => s => Arr.foldMap(Arr)(([a, s_]) => f(a)(s_))(p(s));

  const { empty: fail, append: tryBoth } = Applicanoid(Fn)(Arr);
  const zero = fail;
  const alt = pa => pb => s =>
    Arr_.match({
      Cons: Arr_.Cons,
      get Nil() {
        return pb(s);
      }
    })(pa(s));

  // :: Parser a -> Parser [a]
  const some = v => Parser.lift2(Arr_.Cons)(v)(s => many(v)(s));
  // :: Parser a -> Parser [a]
  const many = v => Parser.alt(s => some(v)(s))(Parser.of([]));

  return deriveMonad({ of, chain, fail, tryBoth, zero, alt, some, many });
})();

// :: Parser Char
const item = Str.match({
  Nil: [],
  Cons: c => cs => [[c, cs]]
});

// :: (Char -> Bool) -> Parser Char
const satisfy = p =>
  Parser.chain(c => (p(c) ? Parser.of(c) : Parser.fail))(item);

// :: [Char] -> Parser Char
const oneOf = chars => satisfy(c => chars.indexOf(c) !== -1);

// :: Parser a -> Parser (a -> a -> a) -> Parser a
const chainl1 = p => op => {
  const rest = a =>
    Parser.alt(Parser.chain(f => Parser.chain(b => rest(f(a)(b)))(p))(op))(
      Parser.of(a)
    );
  return Parser.chain(rest)(p);
};

// :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
const chainl = p => op => a => Parser.alt(chainl1(p)(op))(Parser.of(a));

// :: Char -> Parser Char
const char = c => satisfy(c_ => c === c_);

// :: String -> Parser String
const string = Str.match({
  Nil: Parser.of(Str.Nil),
  Cons: c => cs =>
    Parser.chain(_ => Parser.map(_ => `${c}${cs}`)(string(cs)))(char(c))
});

// :: Parser String
const spaces = Parser.map(ss => ss.join(""))(
  Parser.many(oneOf([" ", "\n", "\r"]))
);

// :: Parser a -> Parser a
const token = p => Parser.chain(a => Parser.map(_ => a)(spaces))(p);

// :: String -> Parser String
const reserved = s => token(string(s));

// :: Parser Char
const digit = satisfy(isDigit);

// :: Parser Nat
const natural = Parser.map(ds => parseInt(ds.join("")))(Parser.some(digit));

// :: Parser Integer
const integer = Parser.chain(sign =>
  Parser.map(ds => parseInt(`${sign}${ds}`))(natural)
)(Parser.alt(char("-"))(Parser.of("")));

// :: Parser a -> Parser a
const parens = m =>
  Parser.chain(_ => Parser.chain(n => Parser.map(_ => n)(reserved(")")))(m))(
    reserved("(")
  );

{
  // Parse different things
  const tests = [
    [char("a"), "a -> b"], // => ["a", " -> b"]
    [natural, "123142"], // => [123142, ""]
    [natural, "abcd"], // => []
    [natural, "123abcd"], // => [123, "abcd"]
    [string("foo"), "abcd"], // => []
    [string("foo"), "food"], // => ["foo", "d"]
    [spaces, "  durr"] // => ["  ", "durr"]
  ];

  const results = tests.map(([p, s]) => p(s));
  console.log(results);
}

{
  const Expr = adt({ Add: [_, _], Mul: [_, _], Sub: [_, _], Lit: [_] });

  // :: Expr -> Int
  const eval = Expr.match({
    Add: a => b => eval(a) + eval(b),
    Mul: a => b => eval(a) * eval(b),
    Sub: a => b => eval(a) - eval(b),
    Lit: n => n
  });

  // :: Parser Expr
  const int = Parser.map(Expr.Lit)(integer);

  // :: Parser Expr
  const expr = s => chainl1(term)(addOp)(s);

  // :: Parser Expr
  const term = s => chainl1(factor)(mulOp)(s);

  // :: Parser Expr
  const factor = s => Parser.alt(int)(parens(expr))(s);

  // :: String -> (a -> a -> a) -> Parser (a -> a -> a)
  const infixOp = x => f => Parser.map(_ => f)(reserved(x));

  // :: Parser (Expr -> Expr -> Expr)
  const addOp = Parser.alt(infixOp("+")(Expr.Add))(infixOp("-")(Expr.Sub));

  // :: Parser (Expr -> Expr -> Expr)
  const mulOp = infixOp("*")(Expr.Mul);

  {
    const tests = [
      "1+2*11", // => [23, '']
      "(1+2)*11" // => [33, '']
    ];

    const results = tests.map(s => Parser.map(eval)(expr)(s));

    console.log(results);
  }
}