#lang racket

(require megaparsack
         megaparsack/text)
(require data/monad
         data/applicative)

(define (token p)
  (do
    (many/p space/p)
    (v <- p)
    (many/p space/p)
    (pure v)))

(define (symbol s)
  (token (string/p s)))

(define json-string
  (do
    (char/p #\")
    (x <- (many/p (satisfy/p (lambda (c) (not (equal? c #\"))))))
    (char/p #\")
    (pure (list->string x))))

(define json-bool
  (or/p
   (do
     (symbol "true")
     (pure #t))
   (do
     (symbol "false")
     (pure #f))))

(define json-null
  (do
    (symbol "null")
    (pure '())))

(define ufloat
  (do
    (whole <- integer/p)
    (char/p #\.)
    (decimal <- integer/p)
    (pure (string->number (string-append (number->string whole) "." (number->string decimal))))))

(define float
  (or/p
   (do
     (char/p #\-)
     (n <- ufloat)
     (pure (- n)))
   ufloat))

(define efloat
  (do
    (frac <- float)
    (or/p (char/p #\e) (char/p #\E))
    (exp <- integer/p)
    (pure (* frac (expt 10 exp)))))

(define int
  (or/p
   (do
    (char/p #\-)
    (n <- integer/p)
    (pure (- n)))
   integer/p))

(define integer (token int))

(define json-float
  (or/p
    (try/p
     (do
      (n <- (or/p (try/p efloat) float))
      (pure n)))
    (do
      (n <- integer)
      (pure n))))