Simple parser combinator example in Typed Racket

parser-combinator.rkt

#lang typed/racket

(provide None
         Just
         Opt
         maybe
         neq?
         Parser
         lit
         try-parse
         parse-and)

(require racket/match)

;; Typed parser combinator example

; Optional type
(struct: None ())
(struct: (a) Just ([v : a]))
(define-type (Opt a) (U None (Just a)))

(: maybe (All (a b) (-> (Opt a) (-> a b) b b)))
(define (maybe mb j n)
  (match mb
    [(Just v) (j v)]
    [(None)   n]))

; "not-equals"
(: neq? (All (a) (-> a a Boolean)))
(define (neq? a b)
  (not (eq? a b)))

; A parser is a function from input to failure or some output
(define-type (Parser a b) (-> (Listof a) (Pair (Opt b) (Listof a))))

; A function to create a parser combinator for a specific character
(: lit (-> String (Parser String String)))
(define (lit c)
  (λ (input)
    (let ([r (car input)])
      (if (eq? r c)
          (cons (Just r) (cdr input))
          (cons (None) input)))))

; Try one parser and, if it fails, try the other
(: try-parse (All (a b)
                 (-> (Parser a b)
                     (Parser a b)
                     (Parser a b))))
(define (try-parse p0 p1)
  (λ (input)
    (let ([r0 (p0 input)])
      (match (car r0)
        [(Just s0) r0]
        [(None)
         (let ([r1 (p1 input)])
           (match (car r1)
             [(Just s1) r1]
             [(None) (cons (None) input)]))]))))

(: parse-and (All (a b) (-> (-> b b b)
                            (Parser a b)
                            (Parser a b)
                            (Parser a b))))
(define (parse-and merge p0 p1)
  (λ (input)
    (let ([r0 (p0 input)])
      (match (car r0)
        [(None) (cons (None) input)]
        [(Just s0)
         (let ([r1 (p1 (cdr r0))])
           (match (car r1)
             [(None ) (cons (None) input)]
             [(Just s1)
              (cons (Just (merge s0 s1)) (cdr r1))]))]))))

z-main.rkt

#lang typed/racket

(require "./parser-combinator.rkt")

(define *input-1* (list "h" "e" "l" "l" "o"))
(define *input-2* (list "a" "b" "c" "d"))

(define h-parser (lit "h"))
(define e-parser (lit "e"))
(define h-or-a (try-parse h-parser (lit "a")))
(define h-and-e (parse-and string-append h-parser e-parser))