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 "

(require [hy-odoo.xml [if-python2]])
(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 odoo [&rest args] (xmlroot (xmln "odoo" {} #*args)))
(defn data [&rest args]
  (if (= (len args) 1)
    (xmln "data" {} #*args)
    (xmln "data" #*args)))
(defn function [&rest args] (xmln "function" #*args))
(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]
  " 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})
  (act-window attrs))
(defn menuitem [&rest args] (xmln "menuitem" #*args))
(defn 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})
  (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))
(defn xpath [&rest args] (xmln "xpath" #*args))
(defn attribute [name value] (xmln "attribute" {"name" name} [value]))

(defn field [&rest args]
  "Special 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 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))


(defn view [xmlid children] (record {"id" xmlid "model" "ir.ui.view"} children))
(defn view-def [xmlid name model arch]
  "View and first fields simplification with record xmlid, name, targeted model"
   (view xmlid
     [(field-name name)
      (field-model model)
      (field-arch arch)]))
(defn 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)}")
  (view-def :xmlid xmlid :name name :model model :arch arch))
(defn view-inherit [filename model inherit arch]
  "Inherited View simplification with name of the record, xmlid for model and
  inherited view"
  (setv module (get (.split filename ".") 2)
        inherited (get (.split inherit ".") 1)
        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)]))

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

(defn 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}")
  (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})]))

; Odoo ORM 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)))

; Backend macros

(defmacro __ [sentence] `((py "_") ~sentence))

(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]]
          [io [open :as iopen]]
          [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))
          hy-source (with [o (iopen hy-path "r" :encoding "utf-8")] (.read o))
          output-path (.replace hy-path ".hy" ".py")
          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))))

; 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}")