(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)))