Reimplemented a very simple state monad as system
This commit is contained in:
parent
f53c649441
commit
c72fe69314
|
@ -28,13 +28,14 @@
|
||||||
(require 'fg42/cube)
|
(require 'fg42/cube)
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/elisp-cube ()
|
(defcube fg42/elisp-cube ()
|
||||||
"Elisp Cube of FG42."
|
"Elisp Cube of FG42."
|
||||||
(fg42/state-return
|
(lambda (system)
|
||||||
(list
|
(cons
|
||||||
'(name . "elisp")
|
system
|
||||||
(cons 'keys '())
|
'(:name "elisp"
|
||||||
(cons 'dependencies '((paredit-mode . :latest))))))
|
:keys nil
|
||||||
|
:dependencies ((paredit-mode . :latest))))))
|
||||||
|
|
||||||
|
|
||||||
(provide 'cubes/elisp)
|
(provide 'cubes/elisp)
|
||||||
|
|
|
@ -0,0 +1,42 @@
|
||||||
|
;;; OrgCube --- The elisp cube for FG42 -*- lexical-binding: t; -*-
|
||||||
|
;;
|
||||||
|
;; Copyright (c) 2010-2020 Sameer Rahmani & Contributors
|
||||||
|
;;
|
||||||
|
;; Author: Sameer Rahmani <lxsameer@gnu.org>
|
||||||
|
;; 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 <http://www.gnu.org/licenses/>.
|
||||||
|
;;
|
||||||
|
;;; Commentary:
|
||||||
|
;; Cubes are the building blocks of any `FG42' editor. Each `cube' is a
|
||||||
|
;; unit which defines different abilities in a deterministic and idempotent
|
||||||
|
;; way. Cubes are composable and a composition of cubes creates an editor.
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
(require 'fg42/cube)
|
||||||
|
|
||||||
|
|
||||||
|
(defcube fg42/org-cube ()
|
||||||
|
"Elisp Cube of FG42."
|
||||||
|
(lambda (system)
|
||||||
|
(cons
|
||||||
|
system
|
||||||
|
'(:name "org"
|
||||||
|
:keys nil
|
||||||
|
:dependencies ((org-mode . :latest))))))
|
||||||
|
|
||||||
|
|
||||||
|
(provide 'cubes/org)
|
||||||
|
;;; org.el ends here
|
19
core/fg42.el
19
core/fg42.el
|
@ -22,8 +22,9 @@
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;; Code:
|
;;; Code:
|
||||||
(require 'fg42/cube)
|
(require 'fg42/cube)
|
||||||
(require 'fg42/state)
|
(require 'fg42/utils)
|
||||||
(require 'fg42/system/utils)
|
(require 'fg42/system/core)
|
||||||
|
|
||||||
|
|
||||||
(defvar fg42-home (getenv "FG42_HOME")
|
(defvar fg42-home (getenv "FG42_HOME")
|
||||||
"The pass to fg42-home.")
|
"The pass to fg42-home.")
|
||||||
|
@ -31,24 +32,16 @@
|
||||||
(defvar fg42-tmp (concat fg42-home "/tmp"))
|
(defvar fg42-tmp (concat fg42-home "/tmp"))
|
||||||
|
|
||||||
|
|
||||||
(autoload 'fg42-system/start "fg42/system"
|
(autoload 'fg42/system-start "fg42/system"
|
||||||
"Starts the given SYSTEM.")
|
"Starts the given SYSTEM.")
|
||||||
|
|
||||||
|
|
||||||
(defun load-user-config (file)
|
|
||||||
"Load the given FILE as user config file."
|
|
||||||
(if (file-exists-p file)
|
|
||||||
(load-file file)))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/start! (system)
|
(defun fg42/start! (system)
|
||||||
"Start the given SYSTEM description."
|
"Start the given SYSTEM description."
|
||||||
(fg42-system/set-system! system)
|
|
||||||
|
|
||||||
(add-hook 'window-setup-hook
|
(add-hook 'window-setup-hook
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(fg42-system/start)
|
(require 'fg42/system)
|
||||||
(fg42-extensions/setup-extensions system))))
|
(fg42/system-start system))))
|
||||||
|
|
||||||
|
|
||||||
(provide 'fg42)
|
(provide 'fg42)
|
||||||
|
|
|
@ -28,65 +28,55 @@
|
||||||
|
|
||||||
(require 'seq)
|
(require 'seq)
|
||||||
(require 'fg42/utils)
|
(require 'fg42/utils)
|
||||||
(require 'fg42/state)
|
(require 'fg42/system/dependencies)
|
||||||
|
(require 'fg42/system/keys)
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/cube-apply (state cube-value)
|
(defmacro defcube (name params &rest body)
|
||||||
"Apply the given CUBE-VALUE to the given STATE.
|
"Define a cube with the given NAME, PARAMS and BODY."
|
||||||
It returns a new state."
|
(declare (indent 1))
|
||||||
(let ((name (assoc 'name cube-value)))
|
`(defun ,name ,params ,@body))
|
||||||
(fg42/state-run
|
|
||||||
(fg42/state-compose-states
|
|
||||||
;; insert the cube into the state
|
|
||||||
(fg42/system-register-cube name cube-value)
|
|
||||||
;; Add the dependencies of the cube to the state
|
|
||||||
(fg42/system-merge-dependencies name (assoc 'dependencies cube-value))
|
|
||||||
;; Add the keybindings of the cube to the state
|
|
||||||
(fg42/system-merge-keys name (assoc 'keys cube-value)))
|
|
||||||
state)))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/cube-bind (m1 m2)
|
(defun fg42/cube-run (cube system)
|
||||||
"Bind the M1 to M2.
|
"Run the given CUBE with the given SYSTEM.
|
||||||
M1 and M2 are state monads. See `fg42/utils'"
|
|
||||||
(lambda (state)
|
Returns a pair of new system and the cube vlaue."
|
||||||
(let* ((v (funcall m1 state)))
|
(funcall cube system))
|
||||||
(funcall m2
|
|
||||||
(fg42/cube-apply
|
|
||||||
;; State
|
|
||||||
(car v)
|
|
||||||
;; Value of in the monad from M
|
|
||||||
(cdr v))))))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/cube-compose (cube1 cube2)
|
(defun fg42/cube-compose (&rest cubes)
|
||||||
"Compose CUBE1 and CUBE2 to create a new cube.
|
"Compose the given CUBES."
|
||||||
For example `(fg42/cube-compose #\'some-cube #\'some-other-cube)'"
|
(lambda (system)
|
||||||
(lambda ()
|
(cond
|
||||||
(fg42/cube-bind
|
((null cubes) (cons system '()))
|
||||||
(funcall cube1)
|
(t
|
||||||
(funcall cube2))))
|
(seq-reduce
|
||||||
|
(lambda (s cube)
|
||||||
|
(fg42/cube-apply (fg42/cube-run cube s)))
|
||||||
(defun fg42/cube-empty ()
|
|
||||||
"Cube identity function."
|
|
||||||
(lambda (state)
|
|
||||||
(fg42/state-value state)))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/cubes (&rest cubes)
|
|
||||||
"Create a new cube out of the given list of CUBES."
|
|
||||||
(seq-reduce (lambda (cube1 cube2)
|
|
||||||
(fg42/cube-bind cube1 cube2))
|
|
||||||
cubes
|
cubes
|
||||||
(fg42/cube-empty)))
|
system)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(defun fg42/cube--apply (system cube)
|
||||||
|
"Apply thie given CUBE to given SYSTEM."
|
||||||
|
(if cube
|
||||||
|
(let ((name (plist-get cube :name)))
|
||||||
|
(-> system
|
||||||
|
;; insert the cube into the state
|
||||||
|
(fg42/system-register-cube name cube)
|
||||||
|
;; Add the dependencies of the cube to the state
|
||||||
|
(fg42/system-merge-dependencies name (plist-get cube :dependencies))
|
||||||
|
;; Add the keybindings of the cube to the state
|
||||||
|
(fg42/system-merge-keys name (plist-get cube :keys))))
|
||||||
|
system))
|
||||||
|
|
||||||
|
|
||||||
|
(defun fg42/cube-apply (system-cube-pair)
|
||||||
|
"Apply the cube in the given SYSTEM-CUBE-PAIR to the system inside of it."
|
||||||
|
(fg42/cube--apply (car system-cube-pair) (cdr system-cube-pair)))
|
||||||
|
|
||||||
(comment
|
|
||||||
(fg42/system
|
|
||||||
(fg42/cubes
|
|
||||||
(python-cube 2 3)
|
|
||||||
(swag)
|
|
||||||
(asd))))
|
|
||||||
|
|
||||||
(provide 'fg42/cube)
|
(provide 'fg42/cube)
|
||||||
;;; cube.el ends here
|
;;; cube.el ends here
|
||||||
|
|
|
@ -1,179 +0,0 @@
|
||||||
;; State --- State library of FG42 -*- lexical-binding: t; -*-
|
|
||||||
;;
|
|
||||||
;; Copyright (c) 2010-2020 Sameer Rahmani & Contributors
|
|
||||||
;;
|
|
||||||
;; Author: Sameer Rahmani <lxsameer@gnu.org>
|
|
||||||
;; 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 <http://www.gnu.org/licenses/>.
|
|
||||||
;;
|
|
||||||
;;; Commentary:
|
|
||||||
;; Cubes are the building blocks of any `FG42' editor. Each `cube' is a
|
|
||||||
;; unit which defines different abilities in a deterministic and idempotent
|
|
||||||
;; way. Cubes are composable and a composition of cubes creates an editor.
|
|
||||||
;;
|
|
||||||
;; 'M' => (state . value)
|
|
||||||
;;; Code:
|
|
||||||
|
|
||||||
(require 'seq)
|
|
||||||
(require 'fg42/utils)
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/state-value (s &optional v)
|
|
||||||
"Return a monadic value from state S and optional value V."
|
|
||||||
(cons s v))
|
|
||||||
|
|
||||||
|
|
||||||
(comment
|
|
||||||
(fg42/state-value '(2)))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/state-return (x)
|
|
||||||
"Return a state monad containing X."
|
|
||||||
(lambda (state)
|
|
||||||
(fg42/state-value state x)))
|
|
||||||
|
|
||||||
|
|
||||||
(comment
|
|
||||||
(funcall (fg42/state-return 4) '(3)))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/state-bind-maker (binder-fn)
|
|
||||||
"Return a bind function for state monad.
|
|
||||||
It creates a bind function that binds monadic functions by applying BINDER-FN
|
|
||||||
to the return state and the value inside the monad before binding them.
|
|
||||||
|
|
||||||
The BINDER-FN has to return a cons in form of (state . prev-v)."
|
|
||||||
(lambda (m f)
|
|
||||||
"Applys F on the M monad."
|
|
||||||
(lambda (state)
|
|
||||||
(let* ((v (funcall m state))
|
|
||||||
(new-v (funcall (f (cdr v)) (car v))))
|
|
||||||
(funcall binder-fn
|
|
||||||
;; State
|
|
||||||
(car new-v)
|
|
||||||
;; Value of in the monad from M
|
|
||||||
(cdr new-v))))))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/state-unit ()
|
|
||||||
"Create a new state monad.
|
|
||||||
This monad describes the entire editor configuration"
|
|
||||||
;; Why not a cl-struct ?
|
|
||||||
;; Because first, we want it to be human readable
|
|
||||||
(lambda (state)
|
|
||||||
(let ((init (list '(mode->keybindings . ())
|
|
||||||
'(mode->prefix . ())
|
|
||||||
'(mode->fn . ())
|
|
||||||
'(dependencies . ())
|
|
||||||
'(cubes . ()))))
|
|
||||||
(fg42/state-value init init))))
|
|
||||||
|
|
||||||
|
|
||||||
(comment
|
|
||||||
(assoc 'cubes (funcall (fg42/state-unit) 3)))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/state-get (k &optional default)
|
|
||||||
"Return the value of the given K from the STATE.
|
|
||||||
It will return DEFAULT in case of a missing key."
|
|
||||||
(lambda (state)
|
|
||||||
(fg42/state-value
|
|
||||||
state
|
|
||||||
(or (cdr (assoc k state)) default))))
|
|
||||||
|
|
||||||
|
|
||||||
(comment
|
|
||||||
(funcall (fg42/state-get 'name) '((age . 22) (name . "sameer"))))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/state-cons (k v)
|
|
||||||
"Add the given value V to the list addressed by key K on STATE."
|
|
||||||
(lambda (state)
|
|
||||||
(fg42/state-value
|
|
||||||
(cons
|
|
||||||
(cons k
|
|
||||||
(cons v
|
|
||||||
(funcall (fg42/state-get k '()) state)))
|
|
||||||
state))))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/state-bind (m f)
|
|
||||||
"Bind the monad M to the monadic function F."
|
|
||||||
(lambda (state)
|
|
||||||
(let ((v (funcall m state)))
|
|
||||||
(funcall (funcall f (cdr v)) (car v)))))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/state-compose-states (&rest ms)
|
|
||||||
"Bind monad in MS together."
|
|
||||||
(lambda (state)
|
|
||||||
(cond
|
|
||||||
((= 0 (length ms)) (fg42/state-value state))
|
|
||||||
((= 1 (length ms)) (fg42/state-run (car ms) state))
|
|
||||||
(t
|
|
||||||
(seq-reduce
|
|
||||||
(lambda (composition m)
|
|
||||||
(fg42/state-run m (car composition)))
|
|
||||||
(cdr ms)
|
|
||||||
(fg42/state-run (car ms) state))))))
|
|
||||||
|
|
||||||
|
|
||||||
(comment
|
|
||||||
(fg42/state-run
|
|
||||||
(fg42/state-compose-states
|
|
||||||
(lambda (s) (fg42/state-value (cons 4 s) 14))
|
|
||||||
(lambda (s) (fg42/state-value (cons 5 s) 15))
|
|
||||||
(lambda (s) (fg42/state-value (cons 6 s) 16)))
|
|
||||||
'())
|
|
||||||
|
|
||||||
(funcall
|
|
||||||
(fg42/state-bind
|
|
||||||
(lambda (state)
|
|
||||||
(cons '((age . 3)) '(4 5)))
|
|
||||||
(lambda (x)
|
|
||||||
(lambda (state)
|
|
||||||
(cons
|
|
||||||
state
|
|
||||||
(+ (car x) (cadr x) 10)))))
|
|
||||||
'()))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/state-compose (f1 f2)
|
|
||||||
"Compose the given function F1 with F2."
|
|
||||||
(lambda (&rest xs)
|
|
||||||
(>>= (apply f1 xs) f2)))
|
|
||||||
|
|
||||||
|
|
||||||
(comment
|
|
||||||
(setq s 10)
|
|
||||||
(defun add (x)
|
|
||||||
(lambda (state) (cons (+ state x) (- x 1))))
|
|
||||||
(defun mul (x)
|
|
||||||
(lambda (state)
|
|
||||||
(fg42/state-value (* state x) (- x 1))))
|
|
||||||
|
|
||||||
(funcall
|
|
||||||
(funcall (fg42/state-compose #'add #'mul) 20)
|
|
||||||
s))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/state-run (m s)
|
|
||||||
"Evaluate the given state monad M with the given state S."
|
|
||||||
(funcall m s))
|
|
||||||
|
|
||||||
|
|
||||||
(provide 'fg42/state)
|
|
||||||
;;; state.el ends here
|
|
|
@ -27,28 +27,20 @@
|
||||||
(require 'fg42/state)
|
(require 'fg42/state)
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/system-register-cube (name cube)
|
|
||||||
"Add the given CUBE with the given NAME to the system.
|
|
||||||
|
|
||||||
System is a state monad that returns by state-cons"
|
|
||||||
(fg42/state-cons 'cubes (cons name cube)))
|
|
||||||
|
|
||||||
|
|
||||||
(comment
|
|
||||||
(fg42/state-run
|
|
||||||
(fg42/system-add-cube 'sam '(1 2 3)) (funcall (fg42/state-unit) '())))
|
|
||||||
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun fg42-system/start ()
|
(defun fg42/system-start (system)
|
||||||
"Start the system from `fg42-get-current-system'."
|
"Start the given SYSTEM."
|
||||||
(require 'fg42/utils)
|
(require 'fg42/utils)
|
||||||
(require 'fg42/system/core)
|
(require 'fg42/system/core)
|
||||||
|
(require 'fg42/system/dependencies)
|
||||||
(require 'fg42/system/utils)
|
(require 'fg42/system/utils)
|
||||||
|
|
||||||
(debug-message "Starting the default system.")
|
(debug-message "Starting the default system.")
|
||||||
(let ((sys (fg42-system/get-active-system)))
|
(let ((system-map (funcall system '())))
|
||||||
(funcall (fg42-system-start sys) sys)))
|
(fg42/system-install-dependencies system-map)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(provide 'fg42/system)
|
(provide 'fg42/system)
|
||||||
|
|
|
@ -1,66 +0,0 @@
|
||||||
;;; system --- System library of FG42 -*- lexical-binding: t; -*-
|
|
||||||
;;
|
|
||||||
;; Copyright (c) 2010-2020 Sameer Rahmani <lxsameer@gnu.org>
|
|
||||||
;;
|
|
||||||
;; Author: Sameer Rahmani <lxsameer@gnu.org>
|
|
||||||
;; 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 <http://www.gnu.org/licenses/>.
|
|
||||||
;;
|
|
||||||
;;; Commentary:
|
|
||||||
;; This namespace contains several selector function to work with the
|
|
||||||
;; `fg42-system' data structure.
|
|
||||||
;;
|
|
||||||
;;; Code:
|
|
||||||
(require 'fg42/utils)
|
|
||||||
(require 'fg42/system/core)
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42-system/root (system)
|
|
||||||
"Return the root path of the given SYSTEM."
|
|
||||||
(fg42-system-root system))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42-system/fpkg-path (system)
|
|
||||||
"Return the absolute path to the fpkg backend from SYSTEM root."
|
|
||||||
(path-join
|
|
||||||
(fg42-system/root system)
|
|
||||||
(fg42-system-fpkg-backend-path system)))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42-system/fpkg-backend-version (system)
|
|
||||||
"Return the FPKG backend version of the given SYSTEM."
|
|
||||||
(fg42-system-fpkg-backend-version system))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42-system/fpkg-initilized-p (system)
|
|
||||||
"Return a boolean value indicating whether the SYSTEM is initialized or not."
|
|
||||||
(fg42-system-fpkg-initilized system))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42-system/fpkg-initilized! (system)
|
|
||||||
"Mark fpkg as initialized for the given SYSTEM."
|
|
||||||
(setf (fg42-system-fpkg-initilized system) t))
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42-system/core-dependencies (system)
|
|
||||||
"Return a list of core dependencies for the given SYSTEM.
|
|
||||||
Core dependencies are those packages which are essential to the system itself
|
|
||||||
and not the extensions."
|
|
||||||
(fg42-system-core-dependencies system))
|
|
||||||
|
|
||||||
|
|
||||||
(provide 'fg42/system/api)
|
|
||||||
;;; api.el ends here
|
|
|
@ -27,45 +27,42 @@
|
||||||
|
|
||||||
(require 'cl-lib)
|
(require 'cl-lib)
|
||||||
(require 'fg42/utils)
|
(require 'fg42/utils)
|
||||||
|
(require 'fg42/state)
|
||||||
|
|
||||||
|
(defun fg42/system-cons (system k v)
|
||||||
|
"Set the given key K to the given value V in the SYSTEM."
|
||||||
|
(cons (cons k v) system))
|
||||||
|
|
||||||
|
|
||||||
(cl-defstruct fg42-system
|
(defun fg42/system-cons-to (system k v)
|
||||||
"A `system' describes a FG42 instance. Everything that is needed
|
"Add the given value V to the value of key K in SYSTEM."
|
||||||
to load FG42."
|
(let* ((value (fg42/system-get system k))
|
||||||
name
|
(m (fg42/system-cons system k (cons v value))))
|
||||||
|
m))
|
||||||
;; We will use this value for `describe-system' as a short
|
|
||||||
;; documentation.
|
|
||||||
docstring
|
|
||||||
|
|
||||||
;; TODO: guess the system root based on the `name' field
|
|
||||||
;; as the default value
|
|
||||||
(root (concat (getenv "HOME") "/.fg42"))
|
|
||||||
|
|
||||||
(fpkg-backend-version 5)
|
|
||||||
(fpkg-backend-path ".fpkg")
|
|
||||||
(fpkg-initilized nil)
|
|
||||||
|
|
||||||
(core-dependencies '())
|
|
||||||
;; The directory to store all sort of temporary files including
|
|
||||||
;; backups, flycheck temps and stuff like that.
|
|
||||||
(tmp-path "~/.tmp")
|
|
||||||
|
|
||||||
(extensions '())
|
|
||||||
(abilities '())
|
|
||||||
;; A function which takes the `system' and starts it.
|
|
||||||
(start (lambda (system) system))
|
|
||||||
(stop nil))
|
|
||||||
|
|
||||||
|
|
||||||
(defmacro defsystem (name &optional docstring &rest body)
|
(defun fg42/system-get (system k)
|
||||||
|
"Return the value of the given key K in the SYSTEM."
|
||||||
|
(cdr (assoc k system)))
|
||||||
|
|
||||||
|
(comment
|
||||||
|
(fg42/system-get (fg42/system-cons '((:1 . 4)) :1 2) :1)
|
||||||
|
(fg42/system-get '((:a . ((1 . 2)))) :a)
|
||||||
|
(fg42/system-get
|
||||||
|
(fg42/system-cons-to '() :a '((x . 5)))
|
||||||
|
:a))
|
||||||
|
|
||||||
|
|
||||||
|
(defun fg42/system-register-cube (system name cube)
|
||||||
|
"Add the given CUBE with the given NAME to the SYSTEM."
|
||||||
|
(fg42/system-cons-to system :cubes (cons name cube)))
|
||||||
|
|
||||||
|
|
||||||
|
(defmacro defsystem (name props &rest body)
|
||||||
"Define a system with the given NAME, DOCSTRING and BODY."
|
"Define a system with the given NAME, DOCSTRING and BODY."
|
||||||
(declare (doc-string 2) (indent 1))
|
(declare (indent 1))
|
||||||
(let ((form (if (boundp (intern (format "%s" name))) 'setq 'defvar)))
|
`(defun ,name ()
|
||||||
`(,form ,name (make-fg42-system
|
(fg42/cube-compose ,@body)))
|
||||||
:name ,(symbol-name name)
|
|
||||||
:docstring ,docstring
|
|
||||||
,@body))))
|
|
||||||
|
|
||||||
|
|
||||||
(provide 'fg42/system/core)
|
(provide 'fg42/system/core)
|
||||||
|
|
|
@ -24,19 +24,28 @@
|
||||||
;; Each system has to have a `start' function to start the setup process.
|
;; Each system has to have a `start' function to start the setup process.
|
||||||
;;
|
;;
|
||||||
;;; Code:
|
;;; Code:
|
||||||
(require 'fg42/state)
|
(require 'fg42/system/core)
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/system-merge-dependencies (cube-name deps)
|
(defun fg42/system-merge-dependencies (system cube-name deps)
|
||||||
"Retun an updated STATE with the given dependencies DEPS for CUBE-NAME."
|
"Retun an updated SYSTEM with the given dependencies DEPS for CUBE-NAME."
|
||||||
(lambda (state)
|
|
||||||
(fg42/state-value
|
|
||||||
(if deps
|
(if deps
|
||||||
;; TODO: Validate the deps here
|
;; TODO: Validate the deps here
|
||||||
(cons (cons 'dependencies
|
(fg42/system-cons-to system :dependencies (cons cube-name deps))
|
||||||
(append (assoc 'dependencies state) deps))
|
system))
|
||||||
state)
|
|
||||||
state))))
|
|
||||||
|
(defun fg42/system-install-dependency (dep)
|
||||||
|
"Install the given dependency DEP."
|
||||||
|
(message ">>>> %s" dep))
|
||||||
|
|
||||||
|
|
||||||
|
(defun fg42/system-install-dependencies (system)
|
||||||
|
"Install the dependencies in the SYSTEM."
|
||||||
|
(mapcar #'fg42/system-install-dependency
|
||||||
|
(fg42/system-get system :dependencies))
|
||||||
|
system)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(provide 'fg42/system/dependencies)
|
(provide 'fg42/system/dependencies)
|
||||||
|
|
|
@ -24,19 +24,15 @@
|
||||||
;; Each system has to have a `start' function to start the setup process.
|
;; Each system has to have a `start' function to start the setup process.
|
||||||
;;
|
;;
|
||||||
;;; Code:
|
;;; Code:
|
||||||
(require 'fg42/state)
|
(require 'fg42/system/core)
|
||||||
|
|
||||||
|
|
||||||
(defun fg42/system-merge-keys (state cube-name keys)
|
(defun fg42/system-merge-keys (system cube-name keys)
|
||||||
"Retun an updated STATE with the given KEYS for CUBE-NAME."
|
"Retun an updated SYSTEM with the given keys KEYS for CUBE-NAME."
|
||||||
(lambda (state)
|
|
||||||
(fg42/state-value
|
|
||||||
(if keys
|
(if keys
|
||||||
;; TODO: Validate the keys here
|
;; TODO: Validate the deps here
|
||||||
(cons (cons 'keys
|
(fg42/system-cons-to system :keys (cons cube-name keys))
|
||||||
(append (assoc 'keys state) keys))
|
system))
|
||||||
state)
|
|
||||||
state))))
|
|
||||||
|
|
||||||
|
|
||||||
(provide 'fg42/system/keys)
|
(provide 'fg42/system/keys)
|
||||||
|
|
|
@ -1,47 +0,0 @@
|
||||||
;;; system --- System library of FG42 -*- lexical-binding: t; -*-
|
|
||||||
;;
|
|
||||||
;; Copyright (c) 2010-2020 Sameer Rahmani <lxsameer@gnu.org>
|
|
||||||
;;
|
|
||||||
;; Author: Sameer Rahmani <lxsameer@gnu.org>
|
|
||||||
;; 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 <http://www.gnu.org/licenses/>.
|
|
||||||
;;
|
|
||||||
;;; 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:
|
|
||||||
|
|
||||||
(defvar fg42-system/active--system nil
|
|
||||||
"A private variable to store the active system.
|
|
||||||
Use `fg42-get-current-system' instead")
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42-system/get-active-system ()
|
|
||||||
"Return the current active system of FG42."
|
|
||||||
fg42-system/active--system)
|
|
||||||
|
|
||||||
|
|
||||||
(defun fg42-system/set-system! (system)
|
|
||||||
"Set the current system to the given SYSTEM."
|
|
||||||
;; TODO: In the future when we moved to parallel boot
|
|
||||||
;; we need to make sure that this funciton
|
|
||||||
;; sets the state safely.
|
|
||||||
(setq fg42-system/active--system system))
|
|
||||||
|
|
||||||
|
|
||||||
(provide 'fg42/system/utils)
|
|
||||||
;;; utils.el ends here
|
|
|
@ -158,5 +158,11 @@ last item in second form, etc."
|
||||||
(:else `(->> (->> ,x ,form) ,@more))))
|
(:else `(->> (->> ,x ,form) ,@more))))
|
||||||
|
|
||||||
|
|
||||||
|
(defun load-user-config (file)
|
||||||
|
"Load the given FILE as user config file."
|
||||||
|
(if (file-exists-p file)
|
||||||
|
(load-file file)))
|
||||||
|
|
||||||
|
|
||||||
(provide 'fg42/utils)
|
(provide 'fg42/utils)
|
||||||
;;; utils.el ends here
|
;;; utils.el ends here
|
||||||
|
|
|
@ -1 +0,0 @@
|
||||||
Subproject commit 721da6e0a242eb6630dd476f2d8e1146d67d2e40
|
|
Loading…
Reference in New Issue