hy_odoo/hy_odoo/odoo.hy

;; -*- coding: utf-8 -*-
;;
;;    Copyright 2019-2020 Fabien Bourgeois <fabien@yaltik.com>
;;
;;    This program is free software: you can redistribute it and/or modify
;;    it under the terms of the GNU Affero General Public License as
;;    published by the Free Software Foundation, either version 3 of the
;;    License, or (at your option) any later version.
;;
;;    This program is distributed in the hope that it will be useful,
;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;    GNU Affero General Public License for more details.
;;
;;    You should have received a copy of the GNU Affero General Public License
;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.

" Odoo macros "

(import [os [path]])
(import [hy-odoo.xml [xmlroot xmln]])

; Global helpers

(defn strdm [hy-domain]
  "Generate Odoo domain from Hy like tuple domain"
  (do
    (setv (, op field value) hy-domain
           field (mangle field)
           value (if (string? value) f"'{value}'" value))
    (return f"('{field}', '{op}', {value})")))

(defmacro hydm [hy-domain]
  "Generate Odoo domain from Hy like tuple domain"
  (setv op (second hy-domain)
        field (mangle (nth hy-domain 2))
        value (nth hy-domain 3))
 `(, ~field ~op ~value))

; XML helpers functions and macros

(defn ox-odoo [&rest args] (xmlroot (xmln "odoo" {} #*args)))
(defn ox-data [&rest args] (xmln "data" {} #*args))
(defn ox-record [&rest args] (xmln "record" #*args))
(defn ox-form [&rest args] (xmln "form" #*args))
(defn ox-tree [&rest args] (xmln "tree" #*args))
(defn ox-search [&rest args] (xmln "search" #*args))
(defn ox-act-window [&rest args] (xmln "act_window" #*args))
(defn ox-act-window-model [model attrs]
  " Build new act_window from model and args"
  (setv model_und (.replace model "." "_")
        model_cap (.join " " (lfor w (.split model ".") (.capitalize w)))
        xmlid f"{model_und}_view_action"
        name f"{model_cap} Action")
  (.update attrs {"id" xmlid "name" name "res_model" model})
  (ox-act-window attrs))
(defn ox-menuitem [&rest args] (xmln "menuitem" #*args))
(defn ox-menuitem-model [model attrs]
  " Build new menuitem from model and attrs"
  (setv model_und (.replace model "." "_")
        actionid f"{model_und}_view_action"
        xmlid f"{model_und}_menu")
  (.update attrs {"id" xmlid "action" actionid})
  (ox-menuitem attrs))
(defn ox-group [&rest args] (xmln "group" #*args))
(defn ox-header [&rest args] (xmln "header" #*args))
(defn ox-footer [&rest args] (xmln "footer" #*args))
(defn ox-sheet [&rest args] (xmln "sheet" #*args))
(defn ox-button [&rest args] (xmln "button" #*args))
(defn ox-p [&rest args] (xmln "p" #*args))
(defn ox-field [&rest args]
  "Special ox-field allowing mangling name attribute"
  (setv attrs (nth args 0))
  (when (and (instance? dict attrs) (in "name" attrs))
        (assoc attrs "name" (mangle (get attrs "name")))
        (setv args (list args))
        (assoc args 0 attrs)
        (setv args (tuple args)))
  (xmln "field" #*args))

(defn ox-field-name [name] (ox-field {"name" "name"} [name]))
(defn ox-field-model [model] (ox-field {"name" "model"} [model]))
(defn ox-field-inherit [xmlid] (ox-field {"name" "inherit_id" "ref" xmlid} []))
(defn ox-field-arch [&rest args] (ox-field {"name" "arch" "type" "xml"} #*args))


(defn ox-view [xmlid children] (ox-record {"id" xmlid "model" "ir.ui.view"} children))
(defn ox-view-def [xmlid name model arch]
  "View and first fields simplification with record xmlid, name, targeted model"
   (ox-view xmlid
     [(ox-field-name name)
      (ox-field-model model)
      (ox-field-arch arch)]))
(defn ox-view-new[view_type model arch]
  "View : new view definition, based on type (form, tree, ...) and model ID"
  (setv model_und (.replace model "." "_")
        model_cap (.join " " (lfor w (.split model ".") (.capitalize w)))
        xmlid f"{model_und}_view_{view_type}"
        name f"{model_cap} {(.capitalize view_type)}")
  (ox-view-def :xmlid xmlid :name name :model model :arch arch))
(defn ox-view-inherit [name model inherit arch]
  "Inherited View simplification with name of the record, xmlid for model and
  inherited view"
  (setv module (get (.split __name__ ".") 2)
        inherited (get (.split inherit ".") 1)
        xmlid f"{inherited}_inherit_{module}")
   (ox-view xmlid
     [(ox-field-name name)
      (ox-field-model model)
      (ox-field-inherit inherit)
      (ox-field-arch arch)]))

(defn ox-actions-server-code [xmlid name modelref code]
  "Server actions of type code"
  (ox-record {"id" xmlid "model" "ir.actions.server"}
    [(ox-field-name name)
     (ox-field {"name" "model_id" "ref" modelref} [])
     (ox-field {"name" "state"} ["code"])
     (ox-field {"name" "code"} [code])]))

(defn ox-client-action-multi [xmlid name model action]
  "Client action multi (ir.values), with own xmlid, name, targeted model and
  action"
  (setv action f"'ir.actions.server,%d'%{action}")
  (ox-record {"id" xmlid "model" "ir.values"}
    [(ox-field-name name)
     (ox-field {"name" "key2" "eval" "'client_action_multi'"} [])
     (ox-field {"name" "model" "eval" (+ "'" model "'")} [])
     (ox-field {"name" "value" "eval" action})]))

; Odoo Backend macros

(defmacro/g! compute-fn [field dependencies body]
  "Macro to make computed definition smoother"
  (setv fname f"_compute_{(mangle field)}" descr f"Computes {field}"
        dependencies (list (map mangle dependencies)))
  (import [hy.models [HySymbol]])
  `(with-decorator (.depends api ~@dependencies)
    (defn ~(HySymbol fname) [self]
      ~descr
      ~body)))

(defmacro compute-field [fname body]
  "Takes fname Symbol and body to create computed field"
  (setv fn-name f"_compute_{(mangle fname)}")
  `(setv ~fname (~@body :compute ~fn-name)))

; Migrations

(defn generate-fn-name [filepath]
  "Generate function name from filepath"
  (setv version (.replace (get (.split (.dirname path filepath) "/") -1) "." "_")
        pre-post (get (.split (.basename path filepath) "-") 0))
  f"{pre-post}_{version}")