2019-09-17 16:39:34 +02:00
|
|
|
;; -*- coding: utf-8 -*-
|
|
|
|
;;
|
2020-03-26 23:31:36 +01:00
|
|
|
;; Copyright 2019-2020 Fabien Bourgeois <fabien@yaltik.com>
|
2019-09-17 16:39:34 +02:00
|
|
|
;;
|
|
|
|
;; 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/>.
|
|
|
|
|
2019-10-23 05:29:17 +02:00
|
|
|
" Odoo macros "
|
2019-09-17 16:39:34 +02:00
|
|
|
|
2020-04-27 12:30:20 +02:00
|
|
|
(require [hy-odoo.xml [if-python2]])
|
2019-10-23 05:29:17 +02:00
|
|
|
(import [os [path]])
|
2020-03-26 23:31:36 +01:00
|
|
|
(import [hy-odoo.xml [xmlroot xmln]])
|
2019-09-18 09:26:07 +02:00
|
|
|
|
2020-03-27 11:17:39 +01:00
|
|
|
; 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})")))
|
|
|
|
|
2020-03-27 16:16:24 +01:00
|
|
|
(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))
|
|
|
|
|
2019-10-23 05:29:17 +02:00
|
|
|
; XML helpers functions and macros
|
|
|
|
|
2020-04-24 11:51:34 +02:00
|
|
|
(defn odoo [&rest args] (xmlroot (xmln "odoo" {} #*args)))
|
2020-04-27 11:29:07 +02:00
|
|
|
(defn data [&rest args]
|
|
|
|
(if (= (len args) 1)
|
|
|
|
(xmln "data" {} #*args)
|
|
|
|
(xmln "data" #*args)))
|
|
|
|
(defn function [&rest args] (xmln "function" #*args))
|
2020-04-24 11:51:34 +02:00
|
|
|
(defn record [&rest args] (xmln "record" #*args))
|
|
|
|
(defn form [&rest args] (xmln "form" #*args))
|
|
|
|
(defn tree [&rest args] (xmln "tree" #*args))
|
|
|
|
(defn search [&rest args] (xmln "search" #*args))
|
|
|
|
(defn act-window [&rest args] (xmln "act_window" #*args))
|
|
|
|
(defn act-window-model [model attrs]
|
2020-03-27 11:17:39 +01:00
|
|
|
" 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})
|
2020-04-24 11:51:34 +02:00
|
|
|
(act-window attrs))
|
|
|
|
(defn menuitem [&rest args] (xmln "menuitem" #*args))
|
|
|
|
(defn menuitem-model [model attrs]
|
2020-03-27 11:17:39 +01:00
|
|
|
" 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})
|
2020-04-24 11:51:34 +02:00
|
|
|
(menuitem attrs))
|
|
|
|
(defn group [&rest args] (xmln "group" #*args))
|
|
|
|
(defn header [&rest args] (xmln "header" #*args))
|
|
|
|
(defn footer [&rest args] (xmln "footer" #*args))
|
|
|
|
(defn sheet [&rest args] (xmln "sheet" #*args))
|
|
|
|
(defn button [&rest args] (xmln "button" #*args))
|
|
|
|
(defn p [&rest args] (xmln "p" #*args))
|
2020-04-25 16:51:54 +02:00
|
|
|
(defn xpath [&rest args] (xmln "xpath" #*args))
|
|
|
|
(defn attribute [name value] (xmln "attribute" {"name" name} [value]))
|
|
|
|
|
2020-04-24 11:51:34 +02:00
|
|
|
(defn field [&rest args]
|
|
|
|
"Special field allowing mangling name attribute"
|
2020-03-26 22:32:16 +01:00
|
|
|
(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))
|
2019-09-17 16:39:34 +02:00
|
|
|
|
2020-04-24 11:51:34 +02:00
|
|
|
(defn field-name [name] (field {"name" "name"} [name]))
|
|
|
|
(defn field-model [model] (field {"name" "model"} [model]))
|
|
|
|
(defn field-inherit [xmlid] (field {"name" "inherit_id" "ref" xmlid} []))
|
|
|
|
(defn field-arch [&rest args] (field {"name" "arch" "type" "xml"} #*args))
|
2019-09-22 10:12:41 +02:00
|
|
|
|
|
|
|
|
2020-04-24 11:51:34 +02:00
|
|
|
(defn view [xmlid children] (record {"id" xmlid "model" "ir.ui.view"} children))
|
|
|
|
(defn view-def [xmlid name model arch]
|
2019-09-17 16:39:34 +02:00
|
|
|
"View and first fields simplification with record xmlid, name, targeted model"
|
2020-04-24 11:51:34 +02:00
|
|
|
(view xmlid
|
|
|
|
[(field-name name)
|
|
|
|
(field-model model)
|
|
|
|
(field-arch arch)]))
|
|
|
|
(defn view-new[view_type model arch]
|
2020-03-26 22:32:16 +01:00
|
|
|
"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)}")
|
2020-04-24 11:51:34 +02:00
|
|
|
(view-def :xmlid xmlid :name name :model model :arch arch))
|
2020-04-25 16:51:54 +02:00
|
|
|
(defn view-inherit [filename model inherit arch]
|
2019-09-17 16:39:34 +02:00
|
|
|
"Inherited View simplification with name of the record, xmlid for model and
|
|
|
|
inherited view"
|
2020-04-25 16:51:54 +02:00
|
|
|
(setv module (get (.split filename ".") 2)
|
2019-09-17 16:39:34 +02:00
|
|
|
inherited (get (.split inherit ".") 1)
|
2020-04-25 16:51:54 +02:00
|
|
|
xmlid f"{inherited}_inherit_{module}"
|
|
|
|
model_cap (.join " " (lfor w (.split model ".") (.capitalize w)))
|
|
|
|
name f"{model_cap} Adaptations")
|
|
|
|
(view xmlid
|
|
|
|
[(field-name name)
|
|
|
|
(field-model model)
|
|
|
|
(field-inherit inherit)
|
|
|
|
(field-arch arch)]))
|
2019-09-17 16:39:34 +02:00
|
|
|
|
2020-04-24 11:51:34 +02:00
|
|
|
(defn actions-server-code [xmlid name modelref code]
|
2019-09-17 16:39:58 +02:00
|
|
|
"Server actions of type code"
|
2020-04-24 11:51:34 +02:00
|
|
|
(record {"id" xmlid "model" "ir.actions.server"}
|
|
|
|
[(field-name name)
|
|
|
|
(field {"name" "model_id" "ref" modelref} [])
|
|
|
|
(field {"name" "state"} ["code"])
|
|
|
|
(field {"name" "code"} [code])]))
|
2019-09-17 16:39:58 +02:00
|
|
|
|
2020-04-24 11:51:34 +02:00
|
|
|
(defn client-action-multi [xmlid name model action]
|
2019-09-18 21:10:00 +02:00
|
|
|
"Client action multi (ir.values), with own xmlid, name, targeted model and
|
|
|
|
action"
|
|
|
|
(setv action f"'ir.actions.server,%d'%{action}")
|
2020-04-24 11:51:34 +02:00
|
|
|
(record {"id" xmlid "model" "ir.values"}
|
|
|
|
[(field-name name)
|
|
|
|
(field {"name" "key2" "eval" "'client_action_multi'"} [])
|
|
|
|
(field {"name" "model" "eval" (+ "'" model "'")} [])
|
|
|
|
(field {"name" "value" "eval" action})]))
|
2019-09-17 16:39:34 +02:00
|
|
|
|
2020-04-27 11:32:10 +02:00
|
|
|
; Odoo ORM macros
|
2019-10-23 05:29:17 +02:00
|
|
|
|
|
|
|
(defmacro/g! compute-fn [field dependencies body]
|
|
|
|
"Macro to make computed definition smoother"
|
2020-03-26 22:32:16 +01:00
|
|
|
(setv fname f"_compute_{(mangle field)}" descr f"Computes {field}"
|
|
|
|
dependencies (list (map mangle dependencies)))
|
2020-03-27 19:18:40 +01:00
|
|
|
(import [hy.models [HySymbol]])
|
|
|
|
`(with-decorator (.depends api ~@dependencies)
|
|
|
|
(defn ~(HySymbol fname) [self]
|
|
|
|
~descr
|
|
|
|
~body)))
|
2019-10-23 05:29:17 +02:00
|
|
|
|
|
|
|
(defmacro compute-field [fname body]
|
2020-03-27 09:39:01 +01:00
|
|
|
"Takes fname Symbol and body to create computed field"
|
2019-10-23 05:29:17 +02:00
|
|
|
(setv fn-name f"_compute_{(mangle fname)}")
|
|
|
|
`(setv ~fname (~@body :compute ~fn-name)))
|
|
|
|
|
2020-04-27 11:32:10 +02:00
|
|
|
; Backend macros
|
|
|
|
|
2020-04-25 16:51:54 +02:00
|
|
|
(defmacro __ [sentence] `((py "_") ~sentence))
|
|
|
|
|
2020-04-27 11:32:10 +02:00
|
|
|
(defmacro logger []
|
|
|
|
`(do
|
|
|
|
(import logging)
|
|
|
|
(setv _logger (.getLogger logging --name--))))
|
|
|
|
|
|
|
|
(defmacro pdb []
|
|
|
|
`(do
|
|
|
|
(import [pdb [set-trace]])
|
|
|
|
(set-trace)))
|
|
|
|
|
|
|
|
; Hy-related helpers
|
|
|
|
|
|
|
|
(defn modulehytopy [module-path hy-files]
|
|
|
|
"Transforms hy to py for translation purpose"
|
|
|
|
(import astor)
|
|
|
|
(import [os.path [dirname]]
|
2020-04-27 12:30:20 +02:00
|
|
|
[io [open :as iopen]]
|
2020-04-27 11:32:10 +02:00
|
|
|
[hy.lex [hy-parse]]
|
|
|
|
[hy.compiler [hy-compile]]
|
|
|
|
[hy.errors [filtered-hy-exceptions]])
|
|
|
|
|
|
|
|
(defn hytopy [source path]
|
|
|
|
"Hy source to Py source"
|
|
|
|
(setv hst (with [(filtered-hy-exceptions)] (hy-parse source :filename path))
|
|
|
|
-ast (with [(filtered-hy-exceptions)] (hy-compile hst "__main__" :filename path :source source)))
|
|
|
|
(.to-source (. astor code-gen) -ast))
|
|
|
|
|
|
|
|
(for [hy-file hy-files]
|
|
|
|
(setv hy-path (% "%s/%s.hy" (, (dirname module-path) hy-file))
|
2020-04-27 12:30:20 +02:00
|
|
|
hy-source (with [o (iopen hy-path "r" :encoding "utf-8")] (.read o))
|
2020-04-27 11:32:10 +02:00
|
|
|
output-path (.replace hy-path ".hy" ".py")
|
2020-04-27 12:30:20 +02:00
|
|
|
content ["# Generate from Hy AST, for Babel translation purpose only."
|
|
|
|
"# For real source code, please see and use HY source."
|
|
|
|
(hytopy hy-source hy-path)])
|
|
|
|
(if-python2
|
|
|
|
(.insert content 0 "# -*- coding: utf-8 -*-") (continue))
|
|
|
|
(setv output-py (.join "\n" content))
|
|
|
|
(with [f (iopen output-path "w")] (.write f output-py))))
|
2020-04-27 11:32:10 +02:00
|
|
|
|
2019-10-23 05:29:17 +02:00
|
|
|
; 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}")
|