utils.phel

utils.phel

# Some Phel utility fns / macros
(ns my-project\utils)

(defn parse-float
  "Converts to float without doing odd type conversions, acting more like
  Float/parseFloat in Clojure."
  [x]
  (when-not (php/is_numeric x)
    (throw (php/new \InvalidArgumentException
                    (str "Invalid value for parse-float (" x ")"))))
  (php/floatval x))

(defn parse-int
  "Converts to float without doing odd type conversions, acting more like
  Integer/parseInt in Clojure."
  [x]
  (when-not (php/is_numeric x)
    (throw (php/new \InvalidArgumentException
                    (str "Invalid value for parse-int (" x ")"))))
  (when (and (= :string (type x))
             (> (php/bccomp x (php/strval php/PHP_INT_MAX)) 0))
    (throw (php/new \InvalidArgumentException
                    (str "Value exceeds maximum 64-bit integer (" x ")"))))
  (php/intval x))


# TODO See Carbon DateTime library if more complex stuff is required
#      https://carbon.nesbot.com/

(def date-str-format "Y-m-d")

(defn valid-date-str? [date-str]
  "Validate date string in format '2024-12-31'.
  Uses the sloppy PHP DateTime constructor, validating it's returned string
  presentation afterwards to finish the validation.
  Otherwise E.g. 2024-99-99 would pass otherwise."
  (let [fmt date-str-format
        dt (php/:: \DateTimeImmutable (createFromFormat fmt date-str))]
    (cond (= false dt)
          false

          (= "DateTimeImmutable" (php/get_class dt))
          (= date-str (php/-> dt (format fmt))))))

(def datetime-str-format "Y-m-d H:i:s")
(defn valid-datetime-str? [datetime-str]
  "Validate datetime string in format '2024-12-31 12:00:00'.
  Uses the sloppy PHP DateTime constructor, validating it's returned string
  presentation afterwards to finish the validation.
  Otherwise E.g. 2024-99-99 12:00:00 would pass otherwise."
  (let [fmt datetime-str-format
        dt (php/:: \DateTimeImmutable (createFromFormat fmt datetime-str))]
    (cond (= false dt)
          false

          (= "DateTimeImmutable" (php/get_class dt))
          (= datetime-str (php/-> dt (format fmt))))))

(defn first-day-of-month
  "Get first date of month for given `date-str` YYYY-MM-DD returning string"
  [date-str]
  (when-not (valid-date-str? date-str)
    (throw (php/new \Exception "Date format is invalid for fn first-day-of-month")))
  (let [fmt date-str-format]
    (-> (php/new \DateTimeImmutable date-str)
        (php/-> (modify "first day of this month"))
        (php/-> (format fmt)))))

(defn last-day-of-month
  "Get first date of month for given `date-str` YYYY-MM-DD returning string"
  [date-str]
  (when-not (valid-date-str? date-str)
    (throw (php/new \Exception "Date format is invalid for fn last-day-of-month")))
  (let [fmt date-str-format]
    (-> (php/new \DateTimeImmutable date-str)
        (php/-> (modify "last day of this month"))
        (php/-> (format fmt)))))

(defn first-day-of-year
  "Get first date of month for given `date-str` YYYY-MM-DD returning string"
  [date-str]
  (when-not (valid-date-str? date-str)
    (throw (php/new \Exception "Date format is invalid for fn first-day-of-year")))
  (let [fmt date-str-format]
    (-> (php/new \DateTimeImmutable date-str)
        (php/-> (modify "first day of January this year"))
        (php/-> (format fmt)))))

(defn last-day-of-year
  "Get first date of month for given `date-str` YYYY-MM-DD returning string"
  [date-str]
  (when-not (valid-date-str? date-str)
    (throw (php/new \Exception "Date format is invalid for fn last-day-of-year")))
  (let [fmt date-str-format]
    (-> (php/new \DateTimeImmutable date-str)
        (php/-> (modify "last day of December this year"))
        (php/-> (format fmt)))))

(defmacro time
  "Evaluates expr and prints the time it took.  Returns the value of expr.
  WIP has issue (https://github.com/phel-lang/phel-lang/issues/784)"
  [expr]
  (let [start (gensym)
        ret (gensym)]
    `(let [,start (php/microtime true)
           ,ret ,expr]
       (println "Elapsed time:" (* 1000 (- (php/microtime true) ,start)) "msecs")
       ,ret)))


# Opts spec utility inspired from https://github.com/babashka/cli command argument parsing.

# Validates opts map in following format:

(comment
  {:pdo-conn
   {:require  true
    :validate 'struct? ## pdo/connection?  # fails on global test run
    :default |(wp/pdo-get-connection)}  ; default value used by set-missing-opts-to-defaults

   :excluded-barcode-prefixes
   {:require  true :validate '|(and (vector? $) (all? string? $))
    :default  |(get-excluded-barcode-prefixes)}

   :negative-stock-policy
   {:require  true
    :validate '|(contains? php/ODOO_POL_SYNC_NEGATIVE_STOCK_POLICIES $)
    :default  |(wp/get-cf-option
                (str php/ODOO_PREFIX "_negative_stock_policy"))}
   :initiator
   {:require false
    :validate '|(= :string (type $))}})

(defn validate-opts
  "Validates opts map, returns true or throws `InvalidArgumentException` with
  details in message on failure."
  [opts-spec opts]
  (when-not (hash-map? opts)
    (throw (php/new \InvalidArgumentException
                    (str "Invalid opts type, expected hash-map, got " (type opts)))))

  (let [required-opts (for [[k v] :pairs opts-spec :when (true? (:require v))] k)
        missing-opts (filter |(not (contains? opts $)) required-opts)]

    (when-not (empty? missing-opts)
      (throw (php/new \InvalidArgumentException
                      (str "Missing required opts " missing-opts))))

    (let [failing-validations
          (for [[k v] :pairs opts
                :let [validator-declaration (:validate (k opts-spec))
                      validator-fn (eval validator-declaration)]
                :when (not (validator-fn v))]
            {:key k :value v :validate-fn validator-declaration})]
      (when-not (empty? failing-validations)
        (throw
         (php/new \InvalidArgumentException
                  (str "Invalid opts values " failing-validations)))))
    true))

(defn set-missing-opts-to-defaults
  "Given `opts` map (or nil) returns opts map with missing opts added with
  default values. Invalid opt values will pass through, validation required."
  [opts-spec & [opts]]
  (let [opts (or opts {})
        default-opts-to-add
        (for [[opt-key opt-spec-map] :pairs opts-spec
              :let [default-fn (:default opt-spec-map)]
              :when (and (not (nil? default-fn))
                         (not (contains? opts opt-key)))
              :reduce [acc {}]]
          (put acc opt-key (default-fn)))]
    (merge default-opts-to-add opts)))

## Tests
(comment
(require my-project\lib\wp)
(require phel\pdo :as pdo)

(deftest parse-float
  (is (= 1.1 (parse-float 1.1)))
  (is (= 1.0 (parse-float 1)))
  (is (= 1.1 (parse-float "1.1")))
  (is (= -1.1 (parse-float "-1.1")))
  (is (= 0.0 (parse-float 0)))
  (is (= 0.0 (parse-float "0")))
  (is (= 1.0E-10 (parse-float 1.0E-10)))
  (is (= 1.0E-10 (parse-float "1.0E-10")))
  (is (= 1.0E10 (parse-float 1.0E10)))
  (is (= 1.0E10 (parse-float "1.0E10")))
  (is (thrown? \InvalidArgumentException (parse-float "")))
  (is (thrown? \InvalidArgumentException (parse-float true)))
  (is (thrown? \InvalidArgumentException (parse-float false)))
  (is (thrown? \InvalidArgumentException (parse-float "abc")))
  (is (thrown? \InvalidArgumentException (parse-float "1.1.1")))
  (is (thrown? \InvalidArgumentException (parse-float [])))
  (is (thrown? \InvalidArgumentException (parse-float {})))
  (is (thrown? \InvalidArgumentException (parse-float nil))))

(deftest parse-int
  (is (= 1 (parse-int 1)))
  (is (false? (= 1.0 (parse-int 1))) "not equivalent to same float number")

  (is (= 0 (parse-int 0)))
  (is (= 0 (parse-int "0")))

  (is (= 9223372036854775807 (parse-int "9223372036854775807"))
      "maximum 64bit value")

  (is (thrown? \InvalidArgumentException (parse-int "")))
  (is (thrown? \InvalidArgumentException (parse-int true)))
  (is (thrown? \InvalidArgumentException (parse-int false)))
  (is (thrown? \InvalidArgumentException (parse-int "abc")))
  (is (thrown? \InvalidArgumentException (parse-int "1.1.1")))
  (is (thrown? \InvalidArgumentException (parse-int [])))
  (is (thrown? \InvalidArgumentException (parse-int {})))
  (is (thrown? \InvalidArgumentException (parse-int nil)))
  (is (thrown? \InvalidArgumentException (parse-int "9223372036854775808"))
      "over 64 bit number should throw instead of returning maximum value")

  (is (= 10000000000 (parse-int 1.0E10)))
  # fails because of bccomp:
  (is (thrown? \ValueError (parse-int "1.0E-10")))
  (is (thrown? \ValueError (parse-int "1.0E10")))
  )

(deftest valid-date-str?
  (is (= (valid-date-str? "2024-12-31") true))
  (is (= (valid-date-str? "2024-99-99") false))
  (is (= (valid-date-str? "2024-1-1") false))
  (is (= (valid-date-str? "0000-00-00") false))
  )

(deftest date-utilities
  (is (= (first-day-of-month "2024-12-07") "2024-12-01") "first-day-of-month")
  (is (= (last-day-of-month "2024-12-07") "2024-12-31") "last-day-of-month")

  (is (thrown? \Exception (last-day-of-month "2024-1-1")) "last-day-of-month throws for bad input")
  (is (thrown? \Exception (last-day-of-month "2024-99-99")))
  (is (thrown? \Exception (last-day-of-month "0000-00-00")))

  (is (= (first-day-of-year "2024-12-07") "2024-01-01") "first-day-of-year")
  (is (= (last-day-of-year "2024-12-07") "2024-12-31") "first-day-of-year"))

(def opts-spec
  {:pdo-conn
   {:require  true
    :validate 'struct? # 'pdo/connection?  # fails on global test run
    :default |(wp/pdo-get-connection)}

   :excluded-barcode-prefixes
   {:require  true :validate '|(and (vector? $) (all? string? $))
    :default  |(vector "Test" "123")}

   :negative-stock-policy
   {:require  true
    :validate '|(contains-value? ["one" "another" "default"] $)
    :default  |(str "default")}
   :initiator
   {:require false
    :validate '|(= :string (type $))
    }
   })

## May throw AnalyzerException: Cannot resolve symbol 'pdo/connection?'
## when run with `phel test` without pointing to file directly
## TODO bug report

(deftest validate-opts
  (is (thrown? \InvalidArgumentException (validate-opts opts-spec "FOO")) "exception thrown for non hash map opts")
  (is (thrown? \InvalidArgumentException (validate-opts opts-spec {})) "exception thrown for empty opts")

                                        # TODO currently not implemented
                                        # (is (thrown? \InvalidArgumentException
                                        #              (validate-opts {:non-nil-key {:require true}} {:non-nil-key nil})
                                        #              ) "exception thrown for empty opts")

  (is (thrown? \InvalidArgumentException
               (validate-opts opts-spec {:excluded-barcode-prefixes ["test" "123"]}))
      "exception thrown for partially missing required opts")

  (is (thrown? \InvalidArgumentException
               (validate-opts opts-spec {:pdo-conn "Foo"
                                         :negative-stock-policy "default"
                                         :excluded-barcode-prefixes ["test" "123"]})
               )
      "exception thrown for opts failing validation")

  (let [pdo-conn (wp/pdo-get-connection)]
    (is (thrown? \InvalidArgumentException
                 (validate-opts opts-spec {:pdo-conn pdo-conn
                                           :negative-stock-policy "FOO"
                                           :excluded-barcode-prefixes ["test" "123"]})
                 )
        "exception thrown for invalid negative-stock-policy opt ")
    (is (thrown? \InvalidArgumentException
                 (validate-opts opts-spec {:pdo-conn pdo-conn
                                           :negative-stock-policy "FOO"
                                           :excluded-barcode-prefixes ["test" "123"]})
                 )
        "exception thrown for invalid negative-stock-policy opt ")

    (is (thrown? \InvalidArgumentException
                 (validate-opts opts-spec {:pdo-conn pdo-conn
                                           :negative-stock-policy "default"
                                           :excluded-barcode-prefixes "TEST"}))
        "exception thrown for invalid excluded-barcode-prefixes opt")

    (is (thrown? \InvalidArgumentException
                 (validate-opts opts-spec {:pdo-conn pdo-conn
                                           :negative-stock-policy "default"
                                           :excluded-barcode-prefixes ["TEST" 123]})
                 )
        "exception thrown for invalid excluded-barcode-prefixes opt")

    (is (true?
         (validate-opts opts-spec {:pdo-conn pdo-conn
                                   :negative-stock-policy "default"
                                   :excluded-barcode-prefixes ["test" "123"]}))
        "successful opts validation")
    )
  )

# TODO May have some WordPress plugin dependency
(deftest set-missing-opts-to-defaults
  (is (hash-map? (set-missing-opts-to-defaults opts-spec nil)) "returns hash-map for nil")
  (is (true? (validate-opts opts-spec (set-missing-opts-to-defaults opts-spec nil))) "..which passes validate-opts")

  (let [faulty-opts {:pdo-conn 123}
        faulty-opts-with-defaults-added (set-missing-opts-to-defaults opts-spec faulty-opts)]
    (is (hash-map? faulty-opts-with-defaults-added) "opts map with faulty values passes through and ")
    (is (< (count (keys faulty-opts)) (count (keys faulty-opts-with-defaults-added))) "..gets default opt keys added")
    (is (= 123 (:pdo-conn faulty-opts-with-defaults-added)) "..keeps original (invalid) opt value")
    (is (thrown? \InvalidArgumentException
                 (validate-opts opts-spec faulty-opts-with-defaults-added)) "..but fails on validation")
    )
  )


)