type input =
  { content : string
  ; column : int
  }

let make_input s = { content = s; column = 0 }

type error =
  { content : string
  ; column : int }

type 'a parser_result = (('a * input) list, error list) result

type 'a parser =
  { run : input -> 'a parser_result
  }

let runParser i p = p.run i

let fold_left1 (f: 'a -> 'a -> 'a) (xs: 'a list) : 'a = match xs with
  | []      -> failwith "TODO: make method total; empty list"
  | x :: xs -> List.fold_left f x xs 

let append (a: 'a parser_result) (b: 'a parser_result) : 'a parser_result =
  match (a,b) with
  | (Ok v, Ok v')       -> Ok (List.append v v')
  | (Error e, Error e') -> Error (List.append e e')
  | (v, _)              -> v

let fail (s: string) : 'a parser = 
  { run = fun x -> match x with
          | {content = _; column = c} -> Error [{content = s; column = c}] 
  }

let get : char parser = 
  { run = function
          | { content = ""; column = c } -> 
            Error [{ content = "unexpected EOF"; column = c }]
          | { content = xs; column = c } -> 
            Ok [(String.get xs 0, { content = String.sub xs 1 (String.length xs - 1); column = c+1})]
  }

let return (x: 'a) : 'a parser = 
  { run = fun inp ->
      Ok [(x,inp)]
  }

let (>>=) (p: 'a parser) (f: 'a -> 'b parser) : 'b parser = 
  { run = fun inp -> 
      match p.run inp with
      | Ok    v ->
        let f (x: 'a * input) =
          let (v',out) = x 
          in
          (f v').run out
        in 
        fold_left1 (fun acc v -> append acc v) @@ List.map f v
      | Error e -> Error e
  }

let (let*) = (>>=)

let sat (p: char -> bool) : char parser =
  let* x = get in
    if p x then return x else fail "unexpected character"

let (+++) (p: 'a parser) (q: 'a parser) : 'a parser =
  { run = fun inp -> match (p.run inp,q.run inp) with
          | (Error _, Ok v) -> Ok v
          | (a,b)           -> append a b
  }

let (<++) (p: 'a parser) (q: 'a parser) : 'a parser =
  { run = fun inp -> match (p.run inp,q.run inp) with
          | (Error _, Ok v)  -> Ok v
          | (Ok v ,   _)     -> Ok v
          | (a,b)            -> append a b 
  }

let digit : 'a parser = sat (fun x -> x >= '0' && x <= '9') 
let lower : 'a parser = sat (fun x -> x >= 'a' && x <= 'z') 
let upper : 'a parser = sat (fun x -> x >= 'A' && x <= 'Z') 

let rec many (p: 'a parser): 'a list parser =
  (
  let* x = p in 
  let* xs = many p in
    x::xs |> return
  ) +++ return []

let many1 (p: 'a parser): 'a list parser =
  let* x = p in
  let* xs = many p in
    x::xs |> return

let rec manyTill (p: 'a parser) (q: 'b parser): 'a list parser =
  (
  let* x = p in 
  let* xs = manyTill p q in
    x::xs |> return
  ) <++ (q >>= fun _ -> return [])

let eof : unit parser =
  { run = fun inp -> 
      if inp.content = "" 
      then Ok [(), {content = ""; column = inp.column}] 
      else Error[{content = "expected EOF"; column = inp.column+1}]
  }