models.clj

(ns lambdaisland.models
  (:require [honeysql.format :as hformat]
            [toucan.models :as models :refer [invoke-model-or-instance]]))

(defn fully-qualified-symbol [s]
  (let [{:keys [ns name]} (meta (resolve s))]
    (symbol (str ns "/" name))))

(defn extend-syntax->map [forms]
  (second
   (reduce (fn [[type acc] form]
             (if (symbol? form)
               [(fully-qualified-symbol form) acc]
               [type (assoc-in acc [type (keyword (first form))] `(fn ~@(drop 1 form)))])) [nil {}] forms)))

(defmacro defmodel
  "Define a new \"model\". Models encapsulate information and behaviors related to a specific table in the application DB,
   and have their own unique record type.

   `defmodel` defines a backing record type following the format `<model>Instance`. For example, the class associated with
   `User` is `<root-namespace>.user/UserInstance`. (The root namespace defaults to `models` but can be configured via
    `set-root-namespace!`)

   This class is used for both the titular model (e.g. `User`) and
   for objects that are fetched from the DB. This means they can share the `IModel` protocol and simplifies the interface
   somewhat; functions like `types` work on either the model or instances fetched from the DB.

     (defmodel User :user_table)  ; creates class `UserInstance` and DB model `User`

     (db/select User, ...)  ; use with `toucan.db` functions. All results are instances of `UserInstance`

   The record type automatically extends `IModel` with `IModelDefaults`, but you may call `extend` again if you need to
   override default behaviors:

     (extend (class User)             ; it's somewhat more readable to write `(class User)` instead of `UserInstance`
       IModel (merge IModelDefaults
                      {...}))

   Finally, the model itself is invokable. Calling with no args returns *all* values of that object; calling with a single
   arg can be used to fetch a specific instance by its integer ID.

     (Database)                       ; return a seq of *all* Databases (as instances of `DatabaseInstance`)
     (Database 1)                     ; return Database 1"
  {:arglists     '([model table-name] [model docstr? table-name])
   :style/indent [2 :form :form [1]]}
  [model & args]
  (let [[docstr table-name] (if (string? (first args))
                              (take 2 args)
                              (list nil (first args)))
        extend-forms (if (string? (first args))
                       (drop 2 args)
                       (drop 1 args))
        instance            (symbol (str model "Instance"))
        map->instance       (symbol (str "map->" instance))]
    `(do
       (defrecord ~instance []
         clojure.lang.Named
         (~'getName [~'_]
          ~(name model))

         clojure.lang.IFn
         (~'invoke [this#]
          (invoke-model-or-instance this#))
         (~'invoke [this# id#]
          (invoke-model-or-instance this# id#))
         (~'invoke [this# arg1# arg2#]
          (invoke-model-or-instance this# arg1# arg2#))
         (~'invoke [this# arg1# arg2# arg3#]
          (invoke-model-or-instance this# arg1# arg2# arg3#))
         (~'invoke [this# arg1# arg2# arg3# arg4#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6# arg7#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6# arg7#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12# arg13#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
                                    arg13#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
                    arg13# arg14#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
                                    arg13# arg14#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
                    arg13# arg14# arg15#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
                                    arg13# arg14# arg15#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
                    arg13# arg14# arg15# arg16#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
                                    arg13# arg14# arg15# arg16#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
                    arg13# arg14# arg15# arg16# arg17#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
                                    arg13# arg14# arg15# arg16# arg17#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
                    arg13# arg14# arg15# arg16# arg17# arg18#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
                                    arg13# arg14# arg15# arg16# arg17# arg18#))
         (~'invoke [this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
                    arg13# arg14# arg15# arg16# arg17# arg18# arg19#]
          (invoke-model-or-instance this# arg1# arg2# arg3# arg4# arg5# arg6# arg7# arg8# arg9# arg10# arg11# arg12#
                                    arg13# arg14# arg15# arg16# arg17# arg18# arg19#)))

       (extend ~instance
         ~@(mapcat identity (merge-with (fn [this that] `(merge ~this ~that))
                                        `{models/IModel         models/IModelDefaults
                                          models/ICreateFromMap {:map-> (fn [~'_ & args#] (apply ~map->instance args#))}
                                          honeysql.format/ToSql {:to-sql (comp hformat/to-sql keyword :table)}}
                                        (extend-syntax->map extend-forms))))

       (def ~(vary-meta model assoc
                        :tag      (symbol (str (namespace-munge *ns*) \. instance))
                        :arglists ''([] [id] [& kvs])
                        :doc      (or docstr
                                      (format "Entity for '%s' table; instance of %s." (name table-name) instance)))
         (~map->instance {:table   ~table-name
                          :name    ~(name model)
                          ::models/model true})))))