From f53c649441f3e9c536c71e1665cfad49272a2e4f Mon Sep 17 00:00:00 2001 From: Sameer Rahmani Date: Wed, 27 Jan 2021 22:49:20 +0000 Subject: [PATCH] Finalize the state monad implementation --- core/{fg42/fpkg/core.el => cubes/elisp.el} | 20 +++- core/fg42.el | 15 ++- core/fg42/cube.el | 31 ++++-- core/fg42/extensions.el | 92 ----------------- core/fg42/extensions/core.el | 91 ----------------- core/fg42/state.el | 113 +++++++++++++++++++-- core/fg42/system.el | 14 +++ core/fg42/system/dependencies.el | 43 ++++++++ core/fg42/system/keys.el | 43 ++++++++ fg42-config.el | 45 +++++++- 10 files changed, 299 insertions(+), 208 deletions(-) rename core/{fg42/fpkg/core.el => cubes/elisp.el} (60%) delete mode 100644 core/fg42/extensions.el delete mode 100644 core/fg42/extensions/core.el create mode 100644 core/fg42/system/dependencies.el create mode 100644 core/fg42/system/keys.el diff --git a/core/fg42/fpkg/core.el b/core/cubes/elisp.el similarity index 60% rename from core/fg42/fpkg/core.el rename to core/cubes/elisp.el index e3febd4..deb51c8 100644 --- a/core/fg42/fpkg/core.el +++ b/core/cubes/elisp.el @@ -1,4 +1,4 @@ -;;; fpkg --- Package manager for FG42 -*- lexical-binding: t; -*- +;;; ElispCube --- The elisp cube for FG42 -*- lexical-binding: t; -*- ;; ;; Copyright (c) 2010-2020 Sameer Rahmani & Contributors ;; @@ -20,10 +20,22 @@ ;; along with this program. If not, see . ;; ;;; 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/system/api) +(require 'fg42/cube) +(defun fg42/elisp-cube () + "Elisp Cube of FG42." + (fg42/state-return + (list + '(name . "elisp") + (cons 'keys '()) + (cons 'dependencies '((paredit-mode . :latest)))))) -(provide 'fg42/fpkg/core) -;;; core.el ends here + +(provide 'cubes/elisp) +;;; elisp.el ends here diff --git a/core/fg42.el b/core/fg42.el index 5510c26..d223863 100644 --- a/core/fg42.el +++ b/core/fg42.el @@ -21,13 +21,26 @@ ;; ;;; Commentary: ;;; Code: -(require 'fg42/extensions) +(require 'fg42/cube) +(require 'fg42/state) (require 'fg42/system/utils) +(defvar fg42-home (getenv "FG42_HOME") + "The pass to fg42-home.") + +(defvar fg42-tmp (concat fg42-home "/tmp")) + + (autoload 'fg42-system/start "fg42/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) "Start the given SYSTEM description." (fg42-system/set-system! system) diff --git a/core/fg42/cube.el b/core/fg42/cube.el index d902892..fe5e187 100644 --- a/core/fg42/cube.el +++ b/core/fg42/cube.el @@ -31,18 +31,27 @@ (require 'fg42/state) -(defun fg42/cube-apply (state cube) - "Apply the given CUBE to the given STATE. +(defun fg42/cube-apply (state cube-value) + "Apply the given CUBE-VALUE to the given STATE. It returns a new state." - state) + (let ((name (assoc 'name cube-value))) + (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) "Bind the M1 to M2. M1 and M2 are state monads. See `fg42/utils'" (lambda (state) - (let* ((v (funcall cube1 state))) - (funcall cube2 + (let* ((v (funcall m1 state))) + (funcall m2 (fg42/cube-apply ;; State (car v) @@ -59,10 +68,10 @@ For example `(fg42/cube-compose #\'some-cube #\'some-other-cube)'" (funcall cube2)))) -(defun fg42/cube-identity () +(defun fg42/cube-empty () "Cube identity function." (lambda (state) - (cons state '()))) + (fg42/state-value state))) (defun fg42/cubes (&rest cubes) @@ -70,8 +79,14 @@ For example `(fg42/cube-compose #\'some-cube #\'some-other-cube)'" (seq-reduce (lambda (cube1 cube2) (fg42/cube-bind cube1 cube2)) cubes - (fg42/cube-identity))) + (fg42/cube-empty))) +(comment + (fg42/system + (fg42/cubes + (python-cube 2 3) + (swag) + (asd)))) (provide 'fg42/cube) ;;; cube.el ends here diff --git a/core/fg42/extensions.el b/core/fg42/extensions.el deleted file mode 100644 index e1e5cfc..0000000 --- a/core/fg42/extensions.el +++ /dev/null @@ -1,92 +0,0 @@ -;;; extensions --- Extension library of FG42 -*- lexical-binding: t; -*- -;; -;; Copyright (c) 2010-2020 Sameer Rahmani -;; -;; 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: -;;; Code: - -;; This library provides some basic means to create a new FG42 extensions -(require 'fg42/utils) -(require 'fg42/extensions/core) - - -(defun fg42-extensions/load-index (_system ext-name ext-path) - "Load the extension EXT-NAME which is in EXT-PATH using SYSTEM. -It will load the main file of the extension and return the `fg42-extension' -instance of the extension and nil otherwise." - (let ((is-loaded? (require ext-name ext-path t))) - (when is-loaded? - (symbol-value ext-name)))) - - -(defun fg42-extensions/load-extension (system ext) - "Setup the given extension EXT against the given SYSTEM. -At this stage we will install/load the main file of the extensions -and call the `on-initialize'function of extensions in order to setup -the autoloads and hooks." - (cond - ((symbolp ext) - (fg42-extensions/load-index system ext (fg42-extensions/path system ext))) - - ((listp ext) - (fg42-extensions/load-index system (car ext) (cadr ext))) - (t - ;; TODO: instead of throwing and error, inject the error into the system - (throw 'load-extension-failed - (format "Can't load extension %s" (->str ext)))))) - - -(defun fg42-extensions/load-system-extensions (system) - "Load the extensions defined in the given SYSTEM. - -SYSTEM should be an instance of `fg42-system' which contains a list -of extension names on the `extensions' field. This function finds and -loads the index file of those extensions and returns a new system -containing the `fg42-extension' instances." - (let ((exts (mapcar (lambda (ext) - (fg42-extensions/load-extension system ext)) - (fg42-system-extensions system)))) - (setf (fg42-system-extensions system) - exts)) - system) - - -(defun fg42-extensions/initialize (system ext) - "Initialize the given extension EXT aginst the given SYSTEM." - ;; TODO: Install the dependencies of the extension here - (funcall (fg42-extension-on-initialize ext) system)) - - -(defun fg42-extensions/initialize-extensions (system) - "Initialize the extensions within SYSTEM and return a new system." - (mapc - (lambda (ext) (fg42-extensions/initialize system ext)) - (fg42-system-extensions system)) - system) - - -(defun fg42-extensions/setup-extensions (system) - "Setup the preloads for the given SYSTEM." - (funcall (comp #'fg42-extensions/initialize-extensions - #'fg42-extensions/load-system-extensions) system)) - - -(provide 'fg42/extensions) -;;; extensions.el ends here diff --git a/core/fg42/extensions/core.el b/core/fg42/extensions/core.el deleted file mode 100644 index 6a5a530..0000000 --- a/core/fg42/extensions/core.el +++ /dev/null @@ -1,91 +0,0 @@ -;;; extensions --- Extension library of FG42 -*- lexical-binding: t; -*- -;; -;; Copyright (c) 2010-2020 Sameer Rahmani -;; -;; 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: -;;; Code: - -(require 'cl-lib) -(require 'fg42/system/core) - - -(cl-defstruct fg42-extension - "Each FG42 extension should implement a copy of this structure." - name - - ;; Let's keep this field for backward compatiblity for a while - docs - - ;; Each extension should expose a info page. - doc-index - ;; To be used with `describe-extension' - (docstring nil) - ;; Projectile provides a project type that we can use to - ;; activate/load the extensions based on their registered - ;; type. - project-types - - (version nil) - - ;; An instance of fg42-actions structure that describe the - ;; different actions of the given extension - (actions nil) - (path nil) - ;; Callbacks - (on-initialize nil) - (on-load) - (on-unload)) - - -(defun fg42-extensions/build-path (system ext) - "Build a path for the given EXT name (symbol) via SYSTEM info." - ;; TODO: should we extract variables such as `fg42-home' to their - ;; dedicated ns in order to avoid the warning ? - (let ((ext-name (symbol-name ext))) - (concat (fg42-system-root system) - "/extensions/" ext-name "/" ext-name ".el"))) - - -(defun fg42-extensions/path (system ext) - "Return the path to the given extension EXT in the given SYSTEM." - (cond - ((symbolp ext) (fg42-extensions/build-path system ext)) - ((fg42-extension-p ext) - (or (fg42-extension-path ext) - (fg42-extensions/build-path system - (intern (fg42-extension-name ext))))))) - - -(defmacro defextension (name docstring &rest args) - "A simple DSL to define new fg42 extension by given NAME, DOCSTRING and ARGS." - (declare (doc-string 2) (indent 1)) - ;; TODO: Inject the docstring to the current `system' in order - ;; to collect it later for `describe-extension' function. - (when (not (stringp docstring)) - (throw 'extention-error - "`docstring' is mandatory and it should be a string.")) - `(setq ,name (apply 'make-fg42-extension - :name ,(symbol-name name) - :docstring ,docstring - (quote ,args)))) - - -(provide 'fg42/extensions/core) -;;; core.el ends here diff --git a/core/fg42/state.el b/core/fg42/state.el index eb06b0b..72aec2e 100644 --- a/core/fg42/state.el +++ b/core/fg42/state.el @@ -24,14 +24,30 @@ ;; 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) - (cons state x))) + (fg42/state-value state x))) + + +(comment + (funcall (fg42/state-return 4) '(3))) (defun fg42/state-bind-maker (binder-fn) @@ -58,26 +74,105 @@ This monad describes the entire editor configuration" ;; Why not a cl-struct ? ;; Because first, we want it to be human readable (lambda (state) - (cons - (list '(:mode->keybindings . ()) - '(:mode->prefix . ()) - '(:mode->fn . ()) - '(:cubes . ())) - ()))) + (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) - (or (cdr (assoc k state)) default))) + (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) - (cons (cons k (cons v (or (fg42/state-get state k) '()))) 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) diff --git a/core/fg42/system.el b/core/fg42/system.el index ac87e53..bcebc23 100644 --- a/core/fg42/system.el +++ b/core/fg42/system.el @@ -24,6 +24,20 @@ ;; Each system has to have a `start' function to start the setup process. ;; ;;; Code: +(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 (defun fg42-system/start () diff --git a/core/fg42/system/dependencies.el b/core/fg42/system/dependencies.el new file mode 100644 index 0000000..c6be85c --- /dev/null +++ b/core/fg42/system/dependencies.el @@ -0,0 +1,43 @@ +;;; dependencies --- System library of FG42 -*- lexical-binding: t; -*- +;; +;; Copyright (c) 2010-2020 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 'fg42/state) + + +(defun fg42/system-merge-dependencies (cube-name deps) + "Retun an updated STATE with the given dependencies DEPS for CUBE-NAME." + (lambda (state) + (fg42/state-value + (if deps + ;; TODO: Validate the deps here + (cons (cons 'dependencies + (append (assoc 'dependencies state) deps)) + state) + state)))) + + +(provide 'fg42/system/dependencies) +;;; dependencies.el ends here diff --git a/core/fg42/system/keys.el b/core/fg42/system/keys.el new file mode 100644 index 0000000..a98f880 --- /dev/null +++ b/core/fg42/system/keys.el @@ -0,0 +1,43 @@ +;;; dependencies --- System library of FG42 -*- lexical-binding: t; -*- +;; +;; Copyright (c) 2010-2020 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 'fg42/state) + + +(defun fg42/system-merge-keys (state cube-name keys) + "Retun an updated STATE with the given KEYS for CUBE-NAME." + (lambda (state) + (fg42/state-value + (if keys + ;; TODO: Validate the keys here + (cons (cons 'keys + (append (assoc 'keys state) keys)) + state) + state)))) + + +(provide 'fg42/system/keys) +;;; keys.el ends here diff --git a/fg42-config.el b/fg42-config.el index a880993..e8f3ace 100644 --- a/fg42-config.el +++ b/fg42-config.el @@ -1,4 +1,33 @@ -(add-to-list 'load-path (concat (getenv "FG42_HOME") "/lib")) +;;; FG42 --- The mighty editor for the emacsians -*- lexical-binding: t; -*- +;; +;; Copyright (c) 2010-2020 Sameer Rahmani +;; +;; 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: +;;; Code: + +(defvar fg42-v3 (or (getenv "FG42_V3") '())) + +(if fg42-v3 + (add-to-list 'load-path (concat (getenv "FG42_HOME") "/core")) + (add-to-list 'load-path (concat (getenv "FG42_HOME") "/lib"))) + ;; DEBUG ;; ===== ;; Uncomment the below code to trigger stacktraces in case of any errors @@ -39,8 +68,18 @@ ;; USER CONFIGS ;; ============ ;; Load user config file in ~/.fg42.el -(load-user-config "~/.fg42.el") + +(load-user-config + (if fg42-v3 + "~/.fg42.v3.el" + "~/.fg42.el")) + ;; NOTE: It's important to use ~/.fg42.el instead of this file ;; because updating fg42 will discard your changes in ;; this file. -(fg42-initialize) +(when (not fg42-v3) + (fg42-initialize)) + + +(provide 'fg42-config) +;;; fg42-config.el ends here