test for number types

docs/lqn.md

@@ -401,10 +401,10 @@
  ;   [symbol]
  ; 
  ; FLT!? names a compiled function:
- ;   Lambda-list: (F &OPTIONAL D)
- ;   Derived type: (FUNCTION (T &OPTIONAL T) (VALUES T &OPTIONAL))
+ ;   Lambda-list: (F &OPTIONAL D STRICT)
+ ;   Derived type: (FUNCTION (T &OPTIONAL T T) (VALUES T &OPTIONAL))
  ;   Documentation:
- ;     f as float if it can be parsed; or d
+ ;     f as flt if it is or can be parsed or coerced as flt; or d
  ;   Source file: /data/x/lqn/src/basic-utils.lisp
 ```
 
@@ -504,10 +504,10 @@
  ;   [symbol]
  ; 
  ; INT!? names a compiled function:
- ;   Lambda-list: (I &OPTIONAL D)
- ;   Derived type: (FUNCTION (T &OPTIONAL T) (VALUES T &OPTIONAL))
+ ;   Lambda-list: (I &OPTIONAL D STRICT)
+ ;   Derived type: (FUNCTION (T &OPTIONAL T T) (VALUES T &OPTIONAL))
  ;   Documentation:
- ;     i as int if it can be parsed; or d
+ ;     i as int if it is or can be parsed or coerced as int; or d
  ;   Source file: /data/x/lqn/src/basic-utils.lisp
 ```
 
@@ -814,7 +814,7 @@
  ;   [symbol]
  ; 
  ; LST! names a compiled function:
- ;   Lambda-list: (V &OPTIONAL (D `(,V)))
+ ;   Lambda-list: (V &OPTIONAL D)
  ;   Derived type: (FUNCTION (T &OPTIONAL T) (VALUES T &OPTIONAL))
  ;   Documentation:
  ;     coerce v to list if v; else d
@@ -828,7 +828,7 @@
  ;   [symbol]
  ; 
  ; LST!? names a compiled function:
- ;   Lambda-list: (N &OPTIONAL D)
+ ;   Lambda-list: (L &OPTIONAL D)
  ;   Derived type: (FUNCTION (T &OPTIONAL T) (VALUES T &OPTIONAL))
  ;   Documentation:
  ;     v as list if it can be a list; or d
@@ -956,7 +956,7 @@
  ;   Lambda-list: (N &OPTIONAL D)
  ;   Derived type: (FUNCTION (T &OPTIONAL T) (VALUES T &OPTIONAL))
  ;   Documentation:
- ;     n as number if it can be parsed; or d
+ ;     n as number if it is or can be parsed as num; or d
  ;   Source file: /data/x/lqn/src/basic-utils.lisp
 ```
 
@@ -1120,6 +1120,21 @@
  ;   Source file: /data/x/lqn/src/qry-utils.lisp
 ```
 
+#### LQN:READ?
+
+```
+ ; LQN:READ?
+ ;   [symbol]
+ ; 
+ ; READ? names a compiled function:
+ ;   Lambda-list: (S &OPTIONAL D &REST REST)
+ ;   Derived type: (FUNCTION (T &REST T)
+ ;                  (VALUES T &OPTIONAL (UNSIGNED-BYTE 44)))
+ ;   Documentation:
+ ;     read from string; or d
+ ;   Source file: /data/x/lqn/src/basic-utils.lisp
+```
+
 #### LQN:REPL
 
 ```
@@ -1200,15 +1215,10 @@
 #### LQN:SEQ!?
 
 ```
+:missing:todo:
+
  ; LQN:SEQ!?
  ;   [symbol]
- ; 
- ; SEQ!? names a compiled function:
- ;   Lambda-list: (N &OPTIONAL D)
- ;   Derived type: (FUNCTION (T &OPTIONAL T) (VALUES T &OPTIONAL))
- ;   Documentation:
- ;     s as seq if it can be parsed; or d
- ;   Source file: /data/x/lqn/src/basic-utils.lisp
 ```
 
 #### LQN:SEQ?
@@ -1315,10 +1325,10 @@
  ;   [symbol]
  ; 
  ; STR!? names a compiled function:
- ;   Lambda-list: (N &OPTIONAL D)
+ ;   Lambda-list: (S &OPTIONAL D)
  ;   Derived type: (FUNCTION (T &OPTIONAL T) (VALUES T &OPTIONAL))
  ;   Documentation:
- ;     s as str if it can be parsed; or d
+ ;     s as str if it or can be parsed as str; or d
  ;   Source file: /data/x/lqn/src/basic-utils.lisp
 ```
 
@@ -1602,15 +1612,10 @@
 #### LQN:VEC!?
 
 ```
+:missing:todo:
+
  ; LQN:VEC!?
  ;   [symbol]
- ; 
- ; VEC!? names a compiled function:
- ;   Lambda-list: (N &OPTIONAL D)
- ;   Derived type: (FUNCTION (T &OPTIONAL T) (VALUES T &OPTIONAL))
- ;   Documentation:
- ;     v as vector if it can be parsed; or d
- ;   Source file: /data/x/lqn/src/basic-utils.lisp
 ```
 
 #### LQN:VEC?

lqn.asd

@@ -1,6 +1,6 @@
 (asdf:defsystem #:lqn
   :description "Lisp Query Notation"
-  :version "1.15.0"
+  :version "1.16.0"
   :author "anders hoff / @inconvergent / inconvergent@gmail.com"
   :in-order-to ((asdf:test-op (asdf:test-op #:lqn/tests)))
   :licence "MIT" :pathname "src/" :serial nil
@@ -19,7 +19,7 @@
 
 (asdf:defsystem #:lqn/tests
   :depends-on (#:lqn #:prove #:uiop #:asdf)
-  :version "1.15.0"
+  :version "1.16.0"
   :perform (asdf:test-op (o s) (uiop:symbol-call ':lqn-tests '#:run-tests))
   :pathname "test/" :serial t
   :components ((:file "run")))

src/basic-utils.lisp

@@ -46,54 +46,48 @@
 ; IS TYPE?
 (defun flt?  (f &optional d) "f if float; or d"
   (typecase f (double-float (coerce f 'single-float)) (single-float f) (otherwise d)))
-
 (defun int?  (i &optional d) "i if int; or d"
   (typecase i (integer (coerce i 'fixnum)) (fixnum i) (otherwise d)))
 
-(defun kv? (k &optional d) "k if kv; or d"
-  (typecase k (hash-table k) (otherwise d)))
-
-(defun kw? (k &optional d) "k if kw; or d"
-  (typecase k (keyword k) (otherwise d)))
-
-(defun sym? (s &optional d) "s if sym; or d"
-  (typecase s (symbol s) (otherwise d)))
-
-(defun ssym? (s &optional d) "s if sym, not kw; or d"
-  (if (and (sym? s) (not (kw? s))) s d))
-
-(defun num? (n &optional d) "n if number; or d"
-  (typecase n (number n) (otherwise d)))
+(defun kv? (k &optional d) "k if kv; or d"            (typecase k (hash-table k) (otherwise d)))
+(defun kw? (k &optional d) "k if kw; or d"            (typecase k (keyword k) (otherwise d)))
+(defun sym? (s &optional d) "s if sym; or d"          (typecase s (symbol s) (otherwise d)))
+(defun ssym? (s &optional d) "s if sym, not kw; or d" (if (and (sym? s) (not (kw? s))) s d))
 
-(defun str? (s &optional d) "s if string; or d"
-  (typecase s (string s) (otherwise d)))
+(defun num? (n &optional d) "n if number; or d"   (typecase n (number n) (otherwise d)))
+(defun str? (s &optional d) "s if string; or d"   (typecase s (string s) (otherwise d)))
+(defun vec? (v &optional d) "v if vector; or d"   (typecase v (vector v) (otherwise d)))
+(defun lst? (l &optional d) "l if list; or d"     (typecase l (list l) (otherwise d)))
+(defun seq? (s &optional d) "s if sequence; or d" (typecase s (sequence s) (otherwise d)))
 
-(defun vec? (v &optional d) "v if vector; or d"
-  (typecase v (vector v) (otherwise d)))
-
-(defun lst? (l &optional d) "l if list; or d"
-  (typecase l (list l) (otherwise d)))
-
-(defun seq? (s &optional d) "s if sequence; or d"
-  (typecase s (sequence s) (otherwise d)))
-
-; TODO: int to float? float to int?
 ; PARSE AS TYPE OR DEFAULT
-(defun int!? (i &optional d) "i as int if it can be parsed; or d"
-  (handler-case (or (int? i) (int? (read-from-string i nil nil)) d) (error () d)))
-(defun flt!? (f &optional d) "f as float if it can be parsed; or d"
-  (handler-case (or (flt? f) (flt? (read-from-string f nil nil)) d) (error () d)))
-(defun num!? (n &optional d) "n as number if it can be parsed; or d"
-  (handler-case (or (num? n) (num? (read-from-string n nil nil)) d) (error () d)))
-(defun str!? (n &optional d) "s as str if it can be parsed; or d"
-  (handler-case (or (str? n) (str? (read-from-string n nil nil)) d) (error () d)))
-(defun vec!? (n &optional d) "v as vector if it can be parsed; or d"
-  (handler-case (or (vec? n) (vec? (read-from-string n nil nil)) d) (error () d)))
-(defun seq!? (n &optional d) "s as seq if it can be parsed; or d"
-  (handler-case (or (seq? n) (seq? (read-from-string n nil nil)) d) (error () d)))
-(defun lst!? (n &optional d) "v as list if it can be a list; or d"
-  (labels ((cnv (a) (if (vec? a) (coerce a 'list) nil)))
-    (handler-case (or (cnv n) (cnv (read-from-string n nil nil)) d) (error () d))))
+(defun read? (s &optional d &rest rest) "read from string; or d"
+  (typecase s (string (apply #'read-from-string s rest)) (otherwise d)))
+
+; this is messy, but it works (i think)
+(defun int!? (i &optional d strict) "i as int if it is or can be parsed or coerced as int; or d"
+  (handler-case (or (int? i) (int? (read? i))
+                    (and (not strict) (floor (or (flt? i) (flt? (read? i)) d)))
+                    d)
+                (error () d)))
+(defun flt!? (f &optional d strict) "f as flt if it is or can be parsed or coerced as flt; or d"
+  (handler-case (or (flt? f) (flt? (read? f))
+                    (and (not strict) (coerce (or (int? f) (int? (read? f)) d) 'single-float))
+                    d)
+                (error () d)))
+
+(defun num!? (n &optional d) "n as number if it is or can be parsed as num; or d"
+  (handler-case (or (num? n) (num? (read? n)) d) (error () d)))
+
+(defun str!? (s &optional d) "s as str if it or can be parsed as str; or d"
+  (handler-case (or (str? (read? s)) (str? s)  d) (error () d)))
+; (defun vec!? (v &optional d) "v as vector if it is vec; or d"
+;   (handler-case (or (vec? v) (vec? (read? v)) d) (error () d)))
+; (defun seq!? (s &optional d) "s as seq if it can be parsed; or d"
+;   (handler-case (or (seq? s) (seq? (read? s)) d) (error () d)))
+(defun lst!? (l &optional d) "v as list if it can be a list; or d"
+  (labels ((cnv (a) (when (vec? a) (coerce a 'list))))
+    (handler-case (or (cnv l) (cnv (read? l)) d) (error () d))))
 
 ; COERCE TO TYPE
 (defun sym! (&rest rest) "stringify, make symbol" (apply #'symb rest))
@@ -103,31 +97,27 @@
 (defun vec! (v &optional (d `#(,v))) "coerce v to vector. if v is not a vector, list, string it returns d"
   (etypecase v (vector v) (list (coerce v 'vector)) (t d)))
 
-(defun int! (i) "i as int; or fail."
-  (or (int!? i) (error "unable to force ~a to int" i)))
+(defun int! (i) "i as int; or fail." ; remember to use strict
+  (or (int!? i nil t) (error "unable to force ~a to int" i)))
 (defun flt! (f)  "f as int; or fail."
-  (or (flt!? f) (error "unable to force ~a to flt" f)))
+  (or (flt!? f nil t) (error "unable to force ~a to flt" f)))
 
-; TODO: maybe model after int!
-(defun lst! (v &optional (d `(,v))) "coerce v to list if v; else d"
-  (etypecase v (list v) (vector (coerce v 'list)) (t d)))
+(defun lst! (v &optional d) "coerce v to list if v; else d"
+  (etypecase v (list v) (string d) (vector (coerce v 'list)) (t d)))
 
 (defun size? (l &optional d) "length of sequence/number of keys in kv."
   (typecase l (sequence (length l)) (hash-table (hash-table-count l)) (otherwise d)))
 (defun empty? (l &optional d &aux (n (size? l))) (if (int? n) (< n 1) d))
-(defun uniq (s &optional (fx #'equal))
-  (declare (function fx)) "remove duplicates from sequence"
+
+(defun uniq (s &optional (fx #'equal)) (declare (function fx)) "remove duplicates from sequence"
   (remove-duplicates s :test fx))
 
 ; TODO: extend to check kvs?
-(defun all? (v &optional empty) "check if all; or empty."
-  (declare (sequence v))
-  (if (empty? v) empty (loop for k across (vec!? v) always (is? k))))
-(defun none? (v &optional (empty t)) "check if none; or empty."
-  (declare (sequence v))
-  (if (empty? v) empty (loop for k across (vec!? v) never (is? k))))
-(defun some? (v &optional empty) "check if some; or empty."
-  (declare (sequence v))
+(defun all? (v &optional empty) (declare (sequence v)) "check if all; or empty."
+  (if (empty? v) empty (loop for k across (vec? v) always (is? k))))
+(defun none? (v &optional (empty t)) (declare (sequence v)) "check if none; or empty."
+  (if (empty? v) empty (loop for k across (vec? v) never (is? k))))
+(defun some? (v &optional empty) (declare (sequence v)) "check if some; or empty."
   (if (empty? v) empty (not (none? v))))
 
 (defmacro smth? (v &body body) ; TODO: recursive strip with ext function

src/init.lisp

@@ -7,7 +7,7 @@
 (defvar *fxns* '(:err :wrn :nope :noop :lst :lit :qt :hld :ghv :pnum :inum :cnt :λ
                  :fmt :out :jsnstr
                  :fn :fi :ctx  :par :itr :compct :?? :@@ :@*
-                 :some? :all? :none? :smth? :size?
+                 :read? :some? :all? :none? :smth? :size?
                  :new* :new$ :cat* :cat$
                  :ind* :sel :seq :apply* :grp :uniq
                  :flatn* :flatall* :flatn$

src/packages.lisp

@@ -4,7 +4,7 @@
   (:export #:d? #:v?
     #:qry #:qryd #:jsnqryf #:qryl #:proc-qry
     #:jsnloads #:jsnloadf #:jsnout #:ldnout #:ldnload #:fmt #:out #:jsnstr #:@* #:@@ #:??
-    #:some? #:none? #:all? #:empty? #:size? #:is?
+    #:read? #:some? #:none? #:all? #:empty? #:size? #:is?
     #:path? #:subdir #:subfiles #:ls #:dir? #:file? #:cwd #:now #:cmd
     #:some? #:all? #:none? #:cd #:keys?
     #:new* #:new$ #:cat$ #:cat* #:head #:tail #:apply* #:range #:linspace #:psh* #:pop*

test/run.lisp

@@ -16,6 +16,7 @@
           finally (return (unless (< fails 1) (uiop:quit 7))))))
 
 (defun run-tests ()
+  (-run-tests '(#P"test/test-utils.lisp"))
   (-run-tests '(#P"test/test-lqn.lisp"))
   (-run-tests '(#P"test/test-lqn-2.lisp")))
 

test/test-lqn-2.lisp

@@ -5,6 +5,8 @@
 (subtest "lqn vector"
   (is (lqn:empty? (lqn:new* 1 2 3)) nil)
   (is (lqn:empty? (lqn:new*)) t)
+  (is (lqn:empty? (lqn:new$)) t)
+  (is (lqn:empty? (lqn:new$) :empty) t)
   (is (lqn:empty? 1 :empty) :empty)
   (is (lqn:some? (lqn:new*) :empty) :empty)
   (is (lqn:some? (lqn:new* nil nil) :empty) nil)

test/test-lqn.lisp

@@ -1,51 +1,6 @@
 (in-package #:lqn-tests)
 
-(plan 7)
-
-(subtest "utils"
-  (is (lqn:sub? "aabb" "ab") "aabb")
-  (is (lqn:sub? "aabb" "abc") nil)
-  (is (lqn:sub? "AABB" "ab") nil)
-  (is (lqn:isub? "AABB" "ab") "AABB")
-  (is (lqn:isub? "AABB" "abc") nil)
-  (is (lqn:pref? "AABB" "AA") "AABB")
-  (is (lqn:ipref? "AABB" "aa") "AABB")
-  (is (lqn:suf? "AABB" "BB") "AABB")
-  (is (lqn:suf? "AABB" "bb") nil)
-  (is (lqn:isuf? "AABB" "bb") "AABB")
-  (is (lqn::ct/kw/str "AABB") "AABB")
-  (is (lqn::ct/kw/str :AABB) "aabb")
-  (is (lqn::ct/kw/str 'AABB) 'AABB)
-  (is (lqn::ct/kw/str (+ 1 2)) 3)
-  (is (lqn::ct/kw/str (progn 'abc)) 'abc)
-  (is (lqn:msym? 'aa 'aa) 'aa)
-  (is (lqn:msym? 'aa :aa) nil)
-  (is (lqn:msym? 'aabb "ab") 'aabb)
-  (is (lqn:msym? 'aabb (progn "ab")) nil)
-  (is (lqn:msym? 'aabb (progn 'aabb)) 'aabb)
-  (is (lqn:msym? 'AABB (progn 'aabb)) 'aabb)
-  (is (lqn:msym? :AABB (progn :aabb)) :aabb)
-  (is (lqn::unpack-mode "?@fxfx")    '(:? "fxfx"))
-  (is (lqn::unpack-mode '?@fxfx)     '(:? fxfx))
-  (is (lqn::unpack-mode '(?@fxfx))   '(:? (fxfx)))
-  (is (lqn::unpack-mode '(:? fxfx))  '(:? fxfx))
-  (is (lqn::unpack-mode '(:?@fxfx))  '(:? (:fxfx)))
-  (is (lqn::unpack-mode '(fxfx :ss)) '(:+ (fxfx :ss)))
-  (is (lqn::unpack-mode "fxfx")      '(:+ "fxfx"))
-  (is (lqn::unpack-mode 'fxfx :y)    '(:y fxfx))
-  (is (lqn::unpack-mode 'fxfx :y)    '(:y fxfx)))
-
-(subtest "io"
-  (is (lqn:ldnout *test-data-raw*) *test-data-raw* :test #'equalp)
-  (is (lqn:ldnout (lqn:jsnloadf *test-data-fn*)) *test-data-raw* :test #'equalp)
-  (is-str (lqn::jsnstr (lqn:jsnloadf *test-data-fn*))
-          "[{\"_id\":\"65679d23d38d711eaf999e89\",\"index\":0,\"things\":[{\"id\":0,\"name\":\"Chris\",\"extra\":\"extra99\"}],\"msg\":\"this is a message\",\"fave\":\"strawberry\"},{\"_id\":\"65679d23fe33bc4c240675c0\",\"index\":1,\"things\":[{\"id\":10,\"name\":\"Winters\",\"extra\":\"extra1\"},{\"id\":11,\"name\":\"Haii\",\"extra\":\"extra2\"},{\"id\":12,\"name\":\"Klein\"}],\"msg\":\"Hello, undefined! You have 1 unread messages.\",\"fave\":\"strawberry\"},{\"_id\":\"65679d235b4143d2932ea17a\",\"things\":[{\"id\":31,\"name\":\"Star\"},{\"id\":32,\"name\":\"Ball\"}],\"msg\":\"Hello, undefined! You have 5 unread messages.\",\"fave\":\"blueberry\"}]")
-  (is (lqn:ldnout *test-data-2-raw*) *test-data-2-raw* :test #'equalp)
-  (is (lqn:ldnout (lqn:jsnloadf *test-data-2-fn*)) *test-data-2-raw* :test #'equalp)
-  (is-str (lqn::jsnstr (lqn:jsnloadf *test-data-2-fn*))
-          "{\"credit\":\"Mega Corp.\",\"credit_URL\":\"http://fax.megacorp\",\"disclaimer_url\":null,\"copyright_url\":\"http://fax.megacorp/about/terms.asp\",\"image\":{\"url\":\"http://fax.megacorp/images/Logo.jpg\",\"title\":\"Mega Corp\",\"link\":\"http://fax.megacorp/yyyyyyyyy\"},\"suggested_pickup\":\"15 minutes after the hour\",\"suggested_pickup_period\":\"60\",\"dewpoint_c\":-22.2,\"dewpoint_f\":null,\"dewpoint_string\":\"-8.0 F (-22.2 C)\",\"heat_index_c\":-20.6,\"heat_index_f\":-5.0,\"heat_index_string\":\"-5.0 F (-20.6 C)\",\"observation_time\":\"Last Updated on Dec 5 2023, 9:37 pm CET\",\"current_observation\":{\"station_name\":\"Gulhuset\",\"observation_age\":42,\"dewpoint_day_high_f\":\"-7\",\"dewpoint_day_high_time\":\"8:47pm\",\"dewpoint_day_low_f\":-8.0,\"windchill_month_low_f\":-9,\"windchill_year_low_f\":-9},\"time_to_generate\":0.012046}")
-  (is (lqn:sdwn (lqn::jsnstr (lqn:jsnloadf *test-data-2-fn*)))
-      (lqn:sdwn (lqn::jsnstr *test-data-2-raw*))))
+(plan 5)
 
 (subtest "lqn qry preproc"
   (is (lqn::pre/$$ '(:ccc :ddd "IIUJ" "%@UU" :?@aa :?@bb ("cc" (progn _)) (:+ "ABC" (print _)) (:% "ABC" _) (:kkk "ABC" _)))