(in-package :cl-user)
(defpackage yaml.scalar
  (:use :cl)
  (:export :parse-scalar :*yaml-11-integers*)
  (:documentation "Parser for scalar values."))
(in-package :yaml.scalar)

;;; Constants

(defparameter +null+ nil
  "The NULL constant. Nil by default.")

(defparameter +false+ nil
  "The falsehood constant. Nil by default.")

;;; Regular expressions or lists of names

(defparameter +quoted-scalar-styles+
  (list :single-quoted-scalar-style :double-quoted-scalar-style))

(defparameter +null-names+
  (list "null" "Null" "NULL" "~"))

(defparameter +true-names+
  (list "true" "True" "TRUE"))

(defparameter +false-names+
  (list "false" "False" "FALSE"))

(defparameter +integer-scanner+
  (ppcre:create-scanner "^([-+]?[0-9]+)$"))

(defparameter +octal-integer-scanner+
  (ppcre:create-scanner "^0o([0-7]+)$"))

(defparameter +hex-integer-scanner+
  (ppcre:create-scanner "^0x([0-9a-fA-F]+)$"))

(defparameter +float-scanner+
  (ppcre:create-scanner
   "^[-+]?(\\.[0-9]+|[0-9]+(\\.[0-9]*)?)([eE][-+]?[0-9]+)?$"))

(defparameter +nan-names+
  (list ".nan" ".NaN" ".NAN"))

(defparameter +positive-infinity-scanner+
  (ppcre:create-scanner "^[+]?(\\.inf|\\.Inf|\\.INF)$"))

(defparameter +negative-infinity-scanner+
  (ppcre:create-scanner "^-(\\.inf|\\.Inf|\\.INF)$"))

;;; The actual parser
(defvar *yaml-11-integers* nil)

(defun parse-yaml-integer (string)
  (if (and *yaml-11-integers*
           (eql #\0 (elt string 0)))
      (if (every (lambda (it)
                   (member it '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)))
                 string)
          (parse-integer string :radix 8)
          string)
      (parse-integer string)))

(defun parse-scalar (string &optional (style :plain-scalar-style))
  "Parse a YAML scalar string into a Lisp scalar value."
  (cond
    ;; Quoted string
    ((member style +quoted-scalar-styles+)
     string)
    ;; Null
    ((member string +null-names+ :test #'equal)
     +null+)
    ;; Truth and falsehood
    ((member string +true-names+ :test #'equal)
     t)
    ((member string +false-names+ :test #'equal)
     +false+)
    ;; Integers
    ((ppcre:scan +integer-scanner+ string)
     (parse-yaml-integer string))
    ((ppcre:scan +octal-integer-scanner+ string)
     (parse-integer (subseq string 2) :radix 8))
    ((ppcre:scan +hex-integer-scanner+ string)
     (parse-integer (subseq string 2) :radix 16))
    ;; Floating-point numbers
    ((ppcre:scan +float-scanner+ string)
     (parse-number:parse-real-number string))
    ;; Special floats
    ((member string +nan-names+ :test #'equal)
     (yaml.float:not-a-number))
    ((ppcre:scan +positive-infinity-scanner+ string)
     (yaml.float:positive-infinity))
    ((ppcre:scan +negative-infinity-scanner+ string)
     (yaml.float:negative-infinity))
    ;; Just a string
    (t
     string)))