From b2a7f1ce27cda32d88ebdac7ef92f2a4325106a7 Mon Sep 17 00:00:00 2001 From: Sameer Rahmani Date: Fri, 29 Jan 2021 17:59:16 +0000 Subject: [PATCH] Add support for cube requiring other cubes in the system --- core/cubes/elisp.el | 12 ++---- core/cubes/org.el | 9 +---- core/fg42/cube.el | 10 ++++- core/fg42/system.el | 12 ++++-- core/fg42/system/cubes.el | 82 +++++++++++++++++++++++++++++++++++++++ 5 files changed, 104 insertions(+), 21 deletions(-) create mode 100644 core/fg42/system/cubes.el diff --git a/core/cubes/elisp.el b/core/cubes/elisp.el index e8a49e1..3c56cb5 100644 --- a/core/cubes/elisp.el +++ b/core/cubes/elisp.el @@ -29,14 +29,10 @@ (defcube fg42/elisp-cube () - "Elisp Cube of FG42." - (lambda (system) - (cons - system - '(:name "elisp" - :keys nil - :dependencies ((:name rainbow-delimiters - :version :latest)))))) + :keys nil + :requires '() + :dependencies '((:name rainbow-delimiters :version :latest))) + (provide 'cubes/elisp) diff --git a/core/cubes/org.el b/core/cubes/org.el index 47913f9..a1776f7 100644 --- a/core/cubes/org.el +++ b/core/cubes/org.el @@ -29,13 +29,8 @@ (defcube fg42/org-cube () - "Elisp Cube of FG42." - (lambda (system) - (cons - system - '(:name "org" - :keys nil - :dependencies ((:name org :version :latest)))))) + :keys nil + :dependencies '((:name org :version :latest))) (provide 'cubes/org) diff --git a/core/fg42/cube.el b/core/fg42/cube.el index 52d108e..fea3d74 100644 --- a/core/fg42/cube.el +++ b/core/fg42/cube.el @@ -34,8 +34,14 @@ (defmacro defcube (name params &rest body) "Define a cube with the given NAME, PARAMS and BODY." - (declare (indent 1)) - `(defun ,name ,params ,@body)) + (declare (indent defun)) + `(defun ,name ,params + (lambda (system) + (cons + system + (list + :name ',name + ,@body))))) (defun fg42/cube-run (cube system) diff --git a/core/fg42/system.el b/core/fg42/system.el index 83dd343..a1ce2b3 100644 --- a/core/fg42/system.el +++ b/core/fg42/system.el @@ -24,8 +24,6 @@ ;; Each system has to have a `start' function to start the setup process. ;; ;;; Code: -(require 'fg42/system/dependencies) - ;;;###autoload (defun fg42/system-start (system) @@ -33,9 +31,15 @@ (require 'fg42/utils) (require 'fg42/system/core) (require 'fg42/system/dependencies) + (require 'fg42/system/cubes) + + (let* ((system-map (funcall system '())) + (system (-> system-map + (fg42/system-install-dependencies) + (fg42/system-setup-cubes)))) + (message "SYSTEM: %s" + (fg42/system-get system :cubes)))) - (let ((system-map (funcall system '()))) - (fg42/system-install-dependencies system-map))) (provide 'fg42/system) diff --git a/core/fg42/system/cubes.el b/core/fg42/system/cubes.el new file mode 100644 index 0000000..77d1283 --- /dev/null +++ b/core/fg42/system/cubes.el @@ -0,0 +1,82 @@ +;;; system --- System library of FG42 -*- lexical-binding: t; -*- +;; +;; Copyright (c) 2010-2021 Sameer Rahmani & Contributors +;; +;; Author: Sameer Rahmani +;; URL: https://gitlab.com/FG42/FG42 +;; Version: 3.0.0 +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . +;; +;;; Commentary: +;; `System' is just a state monad which holds the state of the editor. +;; Each system has to have a `start' function to start the setup process. +;; +;;; Code: +(require 'seq) +(require 'fg42/system/core) + +(defun fg42/system-get-cube (system cube-name) + "Return the cube with CUBE-NAME ins the SYSTEM." + ;; car is the name cdr is the cube itself + (cdr (assoc cube-name (fg42/system-get system :cubes)))) + + +(defun fg42/system-get-cube-property (system cube-name prop) + "Return the value of the given property PROP of CUBE-NAME in SYSTEM." + (let ((cube (fg42/system-get-cube system cube-name))) + (plist-get cube prop))) + + +(defun fg42/system-set-cube-property (system cube-name prop v) + "Set the given property PROP of CUBE-NAME to V in SYSTEM." + (let ((cube (append (list prop v) + (fg42/system-get-cube system cube-name)))) + + (fg42/system-register-cube system cube-name cube))) + + +(defun fg42/system-setup-cube (system cube-name) + "Setup the given CUBE-NAME using the given SYSTEM." + (if (eq t (fg42/system-get-cube-property system cube-name :dependencies-processed)) + system + (let ((cube (fg42/system-get-cube system cube-name))) + + (when (null cube) + (error "Can't find cube '%s' in the system" cube-name)) + + (message "Setting up '%s' cube..." cube-name) + (let ((updated-system + (seq-reduce + (lambda (sys requirement) + (fg42/system-setup-cube sys requirement)) + (plist-get cube :requires) + system))) + + (fg42/system-set-cube-property updated-system cube-name :dependencies-processed t))))) + + +(defun fg42/system-setup-cubes (system) + "Setup the cubes in the given SYSTEM by creating a dependency tree." + (let ((cubes (fg42/system-get system :cubes))) + (seq-reduce + (lambda (sys cube-pair) + (fg42/system-setup-cube sys (car cube-pair))) + cubes + system))) + + + +(provide 'fg42/system/cubes) +;;; cubes.el ends here