From 85d6f263b50ea7079aecceaf9caa3232c0dbad76 Mon Sep 17 00:00:00 2001 From: Grazfather Date: Fri, 15 Oct 2021 12:14:49 -0400 Subject: [PATCH] Rework statemachine (#139) This reworks the statemachine as imagined by @eccentric-j. It keeps the state machine static, only uses 2 atoms: 1 for current state and one for context. Each state defines a transition function for each action it supports. These functions return a new state, a new context, and an effect. Effects are sent to all subscribers, along with the new state and new context. They cannot modify the state or context, but can instead use it. The intent here is to allow these 'effect handlers' to display modals, set up hot keys, etc. Additionally, we add a helper effect-handler, which is a higher order function that takes a map of effect->handler, and closes over an atom. The handlers provided in this way should return their own cleanup function, which is stored in the atom. This allows the returned function to be registered as an effect handler and to have the returned cleanup function automatically called on the subsequent event. --- lib/apps.fnl | 286 ++++++++++++++++++++----------------- lib/functional.fnl | 14 +- lib/modal.fnl | 235 +++++++++++++----------------- lib/statemachine.fnl | 236 ++++++++++++++++-------------- lib/testing/assert.fnl | 4 + test/statemachine-test.fnl | 107 ++++++++++---- vim.fnl | 128 +++++++++-------- 7 files changed, 543 insertions(+), 467 deletions(-) diff --git a/lib/apps.fnl b/lib/apps.fnl index 99ae34b..25478cc 100644 --- a/lib/apps.fnl +++ b/lib/apps.fnl @@ -12,6 +12,7 @@ This module works mechanically similar to lib/modal.fnl. (local os (require :os)) (local {: call-when : find + : merge : noop : tap} (require :lib.functional)) @@ -57,9 +58,8 @@ This module works mechanically similar to lib/modal.fnl. " (atom.swap! actions (fn [] [action data]))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Event Dispatchers +;; Action dispatch functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (fn enter @@ -72,7 +72,7 @@ This module works mechanically similar to lib/modal.fnl. Transitions to the entered finite-state-machine state. Returns nil. " - (fsm.dispatch :enter-app app-name)) + (fsm.send :enter-app app-name)) (fn leave [app-name] @@ -82,7 +82,7 @@ This module works mechanically similar to lib/modal.fnl. Transition the state machine to idle from active app state. Returns nil. " - (fsm.dispatch :leave-app app-name)) + (fsm.send :leave-app app-name)) (fn launch [app-name] @@ -92,7 +92,7 @@ This module works mechanically similar to lib/modal.fnl. Calls the launch lifecycle method defined for an app in config.fnl Returns nil. " - (fsm.dispatch :launch-app app-name)) + (fsm.send :launch-app app-name)) (fn close [app-name] @@ -102,7 +102,8 @@ This module works mechanically similar to lib/modal.fnl. Calls the exit lifecycle method defined for an app in config.fnl Returns nil. " - (fsm.dispatch :close-app app-name)) + (fsm.send :close-app app-name)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Set Key Bindings @@ -140,113 +141,71 @@ This module works mechanically similar to lib/modal.fnl. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (fn ->enter - [state app-name] + [state action app-name] " Transition the app state machine from the general, shared key bindings to an app we have local keybindings for. - Runs the following side-effects - - Unbinds the previous app local keys if there were any set - - Calls the :deactivate method of previous app config.fnl table lifecycle - precautionary in case it was set by a previous app in use - - Calls the :activate method of the current app config.fnl table if config - exists for current app - Takes the current app state machine state table - Returns the next app state machine state table - " - (let [{:apps apps - :app prev-app - :unbind-keys unbind-keys} state - next-app (find (by-key app-name) apps)] - (when next-app - (call-when unbind-keys) - (lifecycle.deactivate-app prev-app) - (lifecycle.activate-app next-app) - {:status :in-app - :app next-app - :unbind-keys (bind-app-keys next-app.keys) - :action :enter-app}))) - -(fn in-app->enter - [state app-name] - " - Transition the app state machine from an app the user was using with local keybindings - to another app that may or may not have local keybindings. - Runs the following side-effects - - Unbinds the previous app local keys - - Calls the :deactivate method of previous app config.fnl table lifecycle - - Calls the :activate method of the current app config.fnl table for the new app - that we are activating + Kicks off an effect to bind app-specific keys. Takes the current app state machine state table - Returns the next app state machine state table + Returns update modal state machine state table. " - (let [{:apps apps - :app prev-app - :unbind-keys unbind-keys} state + (let [{: apps + : app} state.context next-app (find (by-key app-name) apps)] - (when next-app - (call-when unbind-keys) - (lifecycle.deactivate-app prev-app) - (lifecycle.activate-app next-app) - {:status :in-app - :app next-app - :unbind-keys (bind-app-keys next-app.keys) - :action :enter-app}))) + {:state {:current-state :in-app + :context {:apps apps + :app next-app + :prev-app app}} + :effect :enter-app-effect})) -(fn in-app->leave - [state app-name] - " - Transition the app state machine from an app the user was using with local keybindings - to another app that may or may not have local keybindings. - Runs the following side-effects - - Unbinds the previous app local keys - - Calls the :deactivate method of previous app config.fnl table lifecycle - - Calls the :activate method of the current app config.fnl table for the new app - that we are activating - Takes the current app state machine state table - Returns the next app state machine state table - " - (let [{:apps apps - :app current-app - :unbind-keys unbind-keys} state] - (if (= current-app.key app-name) - (do - (call-when unbind-keys) - (lifecycle.deactivate-app current-app) - {:status :general-app - :app :nil - :unbind-keys :nil - :action :leave-app}) - nil))) -(fn ->launch - [state app-name] - " - Using the state machine we also react to launching apps by calling the :launch lifecycle method - on apps defined in a user's config.fnl. This way they can run hammerspoon functions when an app - is opened like say resizing emacs on launch. - Takes the current app state machine state table - Calls the lifecycle method on the given app config defined in config.fnl - Returns nil which tells the statemachine that no state updates have ocurred. - " - (let [{:apps apps} state - app-menu (find (by-key app-name) apps)] - (lifecycle.launch-app app-menu) - nil)) +(fn in-app->leave + [state action app-name] + " + Transition the app state machine from an app the user was using with local + keybindings to another app that may or may not have local keybindings. + Because a 'enter (new) app' action is fired before a 'leave (old) app', we + know that this will be called AFTER the enter transition has updated the + state, so we should not update the state. + Takes the current app state machine state table, + Kicks off an effect to run leave-app effects and unbind the old app's keys + Returns the old state. + " + {:state state + :effect :leave-app-effect}) + +(fn launch-app + [state action app-name] + " + Using the state machine we also react to launching apps by calling the :launch + lifecycle method on apps defined in a user's config.fnl. This way they can run + hammerspoon functions when an app is opened like say resizing emacs on launch. + Takes the current app state machine state table. + Kicks off an effect to bind app-specific keys & fire launch app lifecycle + Returns a new state. + " + (let [{: apps + : app} state + next-app (find (by-key app-name) apps)] + {:state {:current-state :in-app + :context {:apps apps + :app next-app + :prev-app app}} + :effect :launch-app-effect})) (fn ->close - [state app-name] + [state action app-name] " - Using the state machine we also react to launching apps by calling the :close lifecycle method - on apps defined in a user's config.fnl. This way they can run hammerspoon functions when an app - is closed. For instance re-enabling vim mode when an app is closed that was incompatible + Using the state machine we also react to launching apps by calling the :close + lifecycle method on apps defined in a user's config.fnl. This way they can run + hammerspoon functions when an app is closed. For instance re-enabling vim mode + when an app is closed that was incompatible Takes the current app state machine state table - Calls the lifecycle method on the given app config defined in config.fnl - Returns nil which tells the statemachine that no state updates have ocurred. + Kicks off an effect to bind app-specific keys + Returns the old state " - (let [{:apps apps} state - app-menu (find (by-key app-name) apps)] - (lifecycle.close-app app-menu) - nil)) + {:state state + :effect :close-app-effect}) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -261,22 +220,17 @@ Defines the two states our app state machine can be in: modal menu items, or lifecycle methods to trigger other hammerspoon functions Maps each state to a table of actions mapped to handlers responsible for returning the next state the statemachine is in. - -TODO: Currently each handler function is responsible for performing transition - side effects like cleaning up previous key bindings and lifecycle methods - as well as returning the next statemachine state. - In the near future we can likely separate those responsibilities out more - akin to something like ClojureScript's re-frame or JS's redux. " + (local states - {:general-app {:enter-app ->enter - :leave-app noop - :launch-app ->launch - :close-app ->close} - :in-app {:enter-app in-app->enter - :leave-app in-app->leave - :launch-app ->launch - :close-app ->close}}) + {:general-app {:enter-app ->enter + :leave-app noop + :launch-app launch-app + :close-app ->close} + :in-app {:enter-app ->enter + :leave-app in-app->leave + :launch-app launch-app + :close-app ->close}}) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -339,23 +293,19 @@ Assign some simple keywords for each hs.application.watcher event type. fsm.state :log-state (fn log-state [state] - (log.df "app is now: %s" (and state.app state.app.key))))) + (log.df "app is now: %s" (and state.context.app state.context.app.key))))) -(fn proxy-actions - [fsm] +(fn watch-actions + [{: prev-state : next-state : action : effect : extra}] " Internal API function to emit app-specific state machine events and transitions to other state machines. Like telling our modal state machine the user has entered into emacs so display the emacs-specific menu modal. - Takes the apps finite state machine instance. - Performs a side-effect to watch the finite-state-machine and log each action - to a list of actions other FSMs can subscribe to like a stream. + Subscribes to the apps state machine. + Takes a transition record from the FSM. Returns nil. " - (atom.add-watch fsm.state :actions - (fn action-watcher - [state] - (emit state.action state.app)))) + (emit action next-state.context.app)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -373,7 +323,7 @@ Assign some simple keywords for each hs.application.watcher event type. " (when fsm (let [state (atom.deref fsm.state)] - state.app))) + state.context.app))) (fn subscribe [f] @@ -390,6 +340,70 @@ Assign some simple keywords for each hs.application.watcher event type. [] (atom.remove-watch actions key)))) +(fn enter-app-effect + [context] + " + Bind keys and lifecycle for the new current app. + Return a cleanup function to cleanup these bindings. + " + (when context.app + (lifecycle.activate-app context.app) + (let [unbind-keys (bind-app-keys context.app.keys)] + (fn [] + (unbind-keys))))) + +(fn launch-app-effect + [context] + " + Bind keys and lifecycle for the next current app. + Return a cleanup function to cleanup these bindings. + " + (when context.app + (lifecycle.launch-app context.app) + (let [unbind-keys (bind-app-keys context.app.keys)] + (fn [] + (unbind-keys))))) + +(fn app-effect-handler + [effect-map] + " + Takes a map of effect->function and returns a function that handles these + effects by calling the mapped-to function, and then calls that function's + return value (a cleanup function) and calls it on the next transition. + + Unlike the fsm's effect-handler, these are app-aware and only call the cleanup + function for that particular app. + + These functions must return their own cleanup function or nil. + " + ;; Create a one-time atom used to store the cleanup function map + (let [cleanup-ref (atom.new {})] + ;; Return a subscriber function + (fn [{: prev-state : next-state : action : effect : extra}] + ;; Call the cleanup function for this app if it's set + (call-when (. (atom.deref cleanup-ref) extra)) + (let [cleanup-map (atom.deref cleanup-ref) + effect-func (. effect-map effect)] + ;; Update the cleanup entry for this app with a new func or nil + (atom.reset! cleanup-ref + (merge cleanup-map + {extra (call-when effect-func next-state extra)})))))) + +(local apps-effect + (app-effect-handler + {:enter-app-effect (fn [state extra] + (enter-app-effect state.context)) + :leave-app-effect (fn [state extra] + (when state.context.prev-app + (lifecycle.deactivate-app state.context.prev-app)) + nil) + :launch-app-effect (fn [state extra] + (launch-app-effect state.context)) + :close-app-effect (fn [state extra] + (when state.context.prev-app + (lifecycle.close-app state.context.prev-app)) + nil)})) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Initialization @@ -404,15 +418,17 @@ Assign some simple keywords for each hs.application.watcher event type. Returns a function to cleanup the hs.application.watcher. " (let [active-app (active-app-name) - initial-state {:apps config.apps - :app nil - :status :general-app - :unbind-keys nil - :action nil} + initial-context {:apps config.apps + :app nil} + template {:state {:current-state :general-app + :context initial-context} + :states states + :log "apps"} app-watcher (hs.application.watcher.new watch-apps)] - (set fsm (statemachine.new states initial-state :status)) + (set fsm (statemachine.new template)) + (fsm.subscribe apps-effect) (start-logger fsm) - (proxy-actions fsm) + (fsm.subscribe watch-actions) (enter active-app) (: app-watcher :start) (fn cleanup [] @@ -424,6 +440,6 @@ Assign some simple keywords for each hs.application.watcher event type. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -{:init init - :get-app get-app - :subscribe subscribe} +{: init + : get-app + : subscribe} diff --git a/lib/functional.fnl b/lib/functional.fnl index 62a2faf..af7117c 100644 --- a/lib/functional.fnl +++ b/lib/functional.fnl @@ -206,6 +206,16 @@ (let [filtered (filter f tbl)] (<= 1 (length filtered)))) +(fn conj + [tbl e] + "Return a new list with the element e added at the end" + (concat tbl [e])) + +(fn butlast + [tbl] + "Return a new list with all but the last item" + (slice 1 -1 tbl)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Others @@ -226,9 +236,11 @@ ;; Exports ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -{: call-when +{: butlast + : call-when : compose : concat + : conj : contains? : count : eq? diff --git a/lib/modal.fnl b/lib/modal.fnl index 82be3f4..e97c2fc 100644 --- a/lib/modal.fnl +++ b/lib/modal.fnl @@ -2,9 +2,9 @@ Displays the menu modals, sub-menus, and application-specific modals if set in config.fnl. -We define a state machine, which uses our local states to determine states, -and transitions. Then we can dispatch events that attempt to transition -between specific states defined in the table. +We define a state machine, which uses our local states to determine states, and +transitions. Then we can send actions that may transition between specific +states defined in the table. Allows us to create the machinery for displaying, entering, exiting, and switching menus in one place which is then powered by config.fnl. @@ -12,17 +12,17 @@ switching menus in one place which is then powered by config.fnl. (local atom (require :lib.atom)) (local statemachine (require :lib.statemachine)) (local apps (require :lib.apps)) -(local {: call-when +(local {: butlast + : call-when : concat + : conj : find : filter : has-some? : identity : join : map - : merge - : noop - : slice} + : merge} (require :lib.functional)) (local {:align-columns align-columns} (require :lib.text)) @@ -31,7 +31,7 @@ switching menus in one place which is then powered by config.fnl. (require :lib.bind)) (local lifecycle (require :lib.lifecycle)) -(local log (hs.logger.new "\tmodal.fnl\t" "debug")) +(local log (hs.logger.new "modal.fnl" "debug")) (var fsm nil) @@ -54,7 +54,7 @@ switching menus in one place which is then powered by config.fnl. nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Event Dispatchers +;; Action dispatch functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (fn activate-modal @@ -68,7 +68,7 @@ switching menus in one place which is then powered by config.fnl. specific menu key. Side effectful " - (fsm.dispatch :activate menu-key)) + (fsm.send :activate menu-key)) (fn deactivate-modal @@ -78,7 +78,7 @@ switching menus in one place which is then powered by config.fnl. Takes no arguments. Side effectful " - (fsm.dispatch :deactivate)) + (fsm.send :deactivate)) (fn previous-modal @@ -87,7 +87,7 @@ switching menus in one place which is then powered by config.fnl. API to transition to the previous modal in our history. Useful for returning to the main menu when in the window modal for instance. " - (fsm.dispatch :previous)) + (fsm.send :previous)) (fn start-modal-timeout @@ -101,7 +101,7 @@ switching menus in one place which is then powered by config.fnl. Takes no arguments. Side effectful " - (fsm.dispatch :start-timeout)) + (fsm.send :start-timeout)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -246,35 +246,24 @@ switching menus in one place which is then powered by config.fnl. :strokeWidth 0} 99999))) - (fn show-modal-menu - [{:menu menu - :prev-menu prev-menu - :unbind-keys unbind-keys - :stop-timeout stop-timeout - :history history}] + [state] " Main API to display a modal and run side-effects - - Unbind keys of previous modal if set - - Stop modal timeout that closes the modal after inactivity - - Call the exit-menu lifecycle method on previous menu if set - - Call the enter-menu lifecycle method on new menu if set - Display the modal alert Takes current modal state from our modal statemachine - Returns updated modal state to store in the modal statemachine + Returns the function to cleanup everything it sets up " - (call-when unbind-keys) - (call-when stop-timeout) - (lifecycle.exit-menu prev-menu) - (lifecycle.enter-menu menu) - (modal-alert menu) - {:menu menu - :stop-timeout :nil - :unbind-keys (bind-menu-keys menu.items) - :history (if history - (concat [] history [menu]) - [menu])}) - + (lifecycle.enter-menu state.context.menu) + (modal-alert state.context.menu) + (let [unbind-keys (bind-menu-keys state.context.menu.items) + stop-timeout state.context.stop-timeout] + (fn [] + (hs.alert.closeAll 0) + (unbind-keys) + (call-when stop-timeout) + (lifecycle.exit-menu state.context.menu) + ))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Menus, & Config Navigation @@ -293,82 +282,71 @@ switching menus in one place which is then powered by config.fnl. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; State Transitions +;; State Transition Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (fn idle->active - [state data] + [state action extra] " Transition our modal statemachine from the idle state to active where a menu modal is displayed to the user. Takes the current modal state table plus the key of the menu if submenu - Displays the modal or local app menu if specified + Kicks off an effect to display the modal or local app menu Returns updated modal state machine state table. " - (let [{:config config - :stop-timeout stop-timeout - :unbind-keys unbind-keys} state + (let [config state.context.config app-menu (apps.get-app) menu (if (and app-menu (has-some? app-menu.items)) app-menu config)] - (merge {:status :active} - (show-modal-menu {:menu menu - :stop-timeout stop-timeout - :unbind-keys unbind-keys})))) + {:state {:current-state :active + :context (merge state.context {:menu menu + :history (if state.history + (conj history menu) + [menu])})} + :effect :show-modal-menu})) (fn active->idle - [state _] + [state action extra] " - Transition our modal state machine from the active, open state to idle by - closing the modal. + Transition our modal state machine from the active, open state to idle. Takes the current modal state table. - Closes the modal, stops the close timeout, and unbinds modal keys - Returns new modal state + Kicks off an effect to close the modal, stop the timeout, and unbind keys + Returns updated modal state machine state table. " - (let [{:menu prev-menu} state] - (hs.alert.closeAll 0) - (call-when state.stop-timeout) - (call-when state.unbind-keys) - (lifecycle.exit-menu prev-menu) - {:status :idle - :menu :nil - :stop-timeout :nil - :history [] - :unbind-keys :nil})) + {:state {:current-state :idle + :context (merge state.context {:menu :nil + :history []})} + :effect :close-modal-menu}) -(fn active->enter-app - [state app-menu] +(fn ->enter-app + [state action extra] " - Transition our modal state machine that is already open to an app menu + Transition our modal state machine the main menu to an app menu Takes the current modal state table and the app menu table. Displays updated modal menu if the current menu is different than the previous menu otherwise results in no operation Returns new modal state " (let [{:config config - :menu prev-menu - :stop-timeout stop-timeout - :unbind-keys unbind-keys - :history history} state + :menu prev-menu} state.context + app-menu (apps.get-app) menu (if (and app-menu (has-some? app-menu.items)) app-menu config)] (if (= menu.key prev-menu.key) + ; nil transition object means keep all state nil - (merge {:history [menu]} - (show-modal-menu - {:stop-timeout stop-timeout - :unbind-keys unbind-keys - :menu menu - :history history}))))) + {:state {:current-state :submenu + :context (merge state.context {:menu menu})} + :effect :open-submenu}))) (fn active->leave-app - [state] + [state action extra] " Transition to the regular menu when user removes focus (blurs) another app. If the leave event was fired for the app we are already in, do nothing. @@ -376,37 +354,30 @@ switching menus in one place which is then powered by config.fnl. Returns new updated modal state if we are leaving the current app. " (let [{:config config - :menu prev-menu} state] + :menu prev-menu} state.context] (if (= prev-menu.key config.key) nil - (idle->active state)))) + (idle->active state action extra)))) (fn active->submenu - [state menu-key] + [state action menu-key] " Enter a submenu like entering into the Window menu from the default main menu. - Takes the current menu state table and the submenu ke. + Takes the current menu state table and the submenu key as 'extra'. Returns updated menu state " (let [{:config config - :menu prev-menu - :stop-timeout stop-timeout - :unbind-keys unbind-keys - :history history} state + :menu prev-menu} state.context menu (if menu-key (find (by-key menu-key) prev-menu.items) config)] - (when menu - (merge {:status :submenu} - (show-modal-menu {:stop-timeout stop-timeout - :unbind-keys unbind-keys - :prev-menu prev-menu - :menu menu - :history history}))))) - -(fn active->timeout - [state] + {:state {:current-state :submenu + :context (merge state.context {:menu menu})} + :effect :open-submenu})) + +(fn add-timeout-transition + [state action extra] " Transition from active to idle, but this transition only fires when the timeout occurs. The timeout is only started after firing a repeatable action. @@ -415,13 +386,15 @@ switching menus in one place which is then powered by config.fnl. more modal keypresses until the timeout triggers which will deactivate the modal. Takes the current modal state table. - Returns a partial modal state table to merge into the modal state. + Returns a the old state with a :stop-timeout added " - (call-when state.stop-timeout) - {:stop-timeout (timeout deactivate-modal)}) + {:state {:current-state state.current-state + :context + (merge state.context {:stop-timeout (timeout deactivate-modal)})} + :effect :open-submenu}) (fn submenu->previous - [state] + [state action extra] " Transition to the previous submenu. Like if you went into the window menu and wanted to go back to the main menu. @@ -430,15 +403,14 @@ switching menus in one place which is then powered by config.fnl. Dynamically calls another transition depending on history. " (let [{:config config - :history history - :menu menu} state - prev-menu (. history (- (length history) 1))] + :history hist + :menu menu} state.context + prev-menu (. hist (- (length hist) 1))] (if prev-menu - (merge state - (show-modal-menu (merge state - {:menu prev-menu - :prev-menu menu})) - {:history (slice 1 -1 history)}) + {:state {:current-state :submenu + :context (merge state.context {:menu prev-menu + :history (butlast hist)})} + :effect :open-submenu} (idle->active state)))) @@ -448,26 +420,19 @@ switching menus in one place which is then powered by config.fnl. ;; State machine states table. Maps states to actions to transition functions. -;; Our state machine implementation is a bit naive in that the transition can -;; return the new state that it's in by updating the status. -;; -;; We can make it more rigid if necessary but can be helpful when navigating -;; submenus or leaving apps. +;; These transition functions return transition objects that contain the new +;; state key and context. (local states - {:idle {:activate idle->active - :enter-app noop - :leave-app noop} + {:idle {:activate idle->active} :active {:deactivate active->idle :activate active->submenu - :start-timeout active->timeout - :enter-app active->enter-app - :leave-app active->leave-app} + :start-timeout add-timeout-transition + :enter-app ->enter-app} :submenu {:deactivate active->idle :activate active->submenu :previous submenu->previous - :start-timeout active->timeout - :enter-app noop - :leave-app noop}}) + :start-timeout add-timeout-transition + :enter-app ->enter-app}}) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -487,9 +452,13 @@ switching menus in one place which is then powered by config.fnl. fsm.state :log-state (fn log-state [state] - (log.df "state is now: %s" state.status) - (when state.history - (log.df (hs.inspect (map #(. $1 :title) state.history))))))) + (when state.context.history + (log.df (hs.inspect (map #(. $1 :title) state.context.history))))))) + +(local modal-effect + (statemachine.effect-handler + {:show-modal-menu show-modal-menu + :open-submenu show-modal-menu})) (fn proxy-app-action [[action data]] @@ -501,7 +470,7 @@ switching menus in one place which is then powered by config.fnl. Executes a side-effect Returns nil " - (fsm.dispatch action data)) + (fsm.send action data)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -517,14 +486,16 @@ switching menus in one place which is then powered by config.fnl. Causes side effects to start the state machine, show the modal, and logging. Returns a function to unsubscribe from the app state machine. " - (let [initial-state {:config config - :history [] - :menu nil - :status :idle - :stop-timeout nil - :unbind-keys nil} + (let [initial-context {:config config + :history [] + :menu :nil} + template {:state {:current-state :idle + :context initial-context} + :states states + :log "modal"} unsubscribe (apps.subscribe proxy-app-action)] - (set fsm (statemachine.new states initial-state :status)) + (set fsm (statemachine.new template)) + (fsm.subscribe modal-effect) (start-logger fsm) (fn cleanup [] (unsubscribe)))) @@ -535,5 +506,5 @@ switching menus in one place which is then powered by config.fnl. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -{:init init - :activate-modal activate-modal} +{: init + : activate-modal} diff --git a/lib/statemachine.fnl b/lib/statemachine.fnl index 72309e5..e5a971e 100644 --- a/lib/statemachine.fnl +++ b/lib/statemachine.fnl @@ -1,121 +1,141 @@ -(local atom (require :lib.atom)) -(local {: filter - : map - : merge} (require :lib.functional)) +" +Provides the mechanism to generate a finite state machine. -(local log (hs.logger.new "\tstatemachine.fnl\t" "debug")) +A finite state machine defines states and some way to transition between states. -" -Transition -Takes an action fn, state, and extra action data -Returns updated state -" -(fn transition - [action-fn state data] - (action-fn state data)) +The 'new' function takes a template, which is a table with the following schema: +{ + :state {:current-state :state1 + :context {}} + :states {:state1 {} + :state2 {} + :state3 {:leave transition-fn-leave + :exit transition-fn-exit}}} +* The CONTEXT is any table that can be updated by TRANSITION FUNCTIONS. This + allows the client to track their own state. +* The STATES table is a map from ACTIONS to TRANSITION FUNCTIONS. +* These functions must return a TRANSITION OBJECT containing the new + :state and the :effect. +* The :state contains a (potentially changed) :current-state and a new :context, + which is updated in the state machine. +* Functions can subscribe to all transitions, and are provided a TRANSITION + RECORD, which contains: + * :prev-state + * :next-state + * :action + * :effect that was kicked off from the transition function +* The subscribe method returns a function that can be called to unsubscribe. +Additionally, we provide a helper function `effect-handler`, which is a +higher-order function that returns a function suitable to be provided to +subscribe. It takes a map of EFFECTs to handler functions. These handler +functions should return their own cleanup. The effect-handler will automatically +call this cleanup function after the next transition. For example, if you want +to bind keys when a certain effect is kicked off, write a function that binds +the keys and returns an unbind function. The unbind function will be called on +the next transition. " -Remove Nils -Takes a dest table and an update. -For each key in update set to :nil, it is removed from the tbl. -Returns a mutated tbl with :nil keys removed. -" -(fn remove-nils - [tbl update] - (let [keys (->> update - (map (fn [v k] [v k])) - (filter (fn [[v _]] - (= v :nil))) - (map (fn [[_ k]] k)))] - (each [_ k (ipairs keys)] - (tset tbl k nil)) - tbl)) -" -Update State -Takes a state atom and an update table to merge -Updates the state-atom by merging the update table into previous state. -Returns the state-atom. -" + +(require-macros :lib.macros) +(local atom (require :lib.atom)) +(local {: butlast + : call-when + : concat + : conj + : last + : merge + : slice} (require :lib.functional)) + + (fn update-state - [state-atom update] - (when update - (atom.swap! - state-atom - (fn [state] - (-> {} - (merge state update) - (remove-nils update)))))) + [fsm state] + (atom.swap! fsm.state (fn [_ state] state) state)) -" -Dispatch Error -Prints an error explaining that we are not able to perform the target -action while in the current state. -" -(fn dispatch-error - [current-state-key action-name] - (log.wf "Could not %s from %s state" - action-name - current-state-key)) +(fn get-transition-function + [fsm current-state action] + (. fsm.states current-state action)) -" -Creates Dispatcher -Creates a dispatcher function to update the machine state atom. -If an update cannot be performed an error is printed to console. - -Takes a table of states, a state-atom, and a state-key used to store the current -state keyword/string. -Returns a function that can be used as a method of the fsm to transition to -another state. -" -(fn create-dispatcher - [states state-atom state-key] - (fn dispatch - [action data] - (let [state (atom.deref state-atom) - key (. state state-key) - action-fn (-?> states - (. key) - (. action))] - (if action-fn - (do - (update-state state-atom (transition action-fn state data)) - true) - (do - (dispatch-error key action) - false))))) +(fn get-state + [fsm] + (atom.deref fsm.state)) +(fn send + [fsm action extra] + " + Based on the action and the fsm's current-state, set the new state and call + all subscribers with the previous state, new state, action, and extra. + " + (let [state (get-state fsm) + {: current-state : context} state] + (if-let [tx-fn (get-transition-function fsm current-state action)] + (let [ + transition (tx-fn state action extra) + new-state (if transition transition.state state) + effect (if transition transition.effect nil)] + + (update-state fsm new-state) + ; Call all subscribers + (each [_ sub (pairs (atom.deref fsm.subscribers))] + (sub {:prev-state state :next-state new-state : action : effect : extra})) + true) + (do + (if fsm.log + (fsm.log.df "Action :%s does not have a transition function in state :%s" + action current-state)) + false)))) + +(fn subscribe + [fsm sub] + " + Adds a subscriber to the provided fsm. Returns a function to unsubscribe + Naive: Because each entry is keyed by the function address it doesn't allow + the same function to subscribe more than once. + " + (let [sub-key (tostring sub)] + (atom.swap! fsm.subscribers (fn [subs sub] + (merge {sub-key sub} subs)) sub) + ; Return the unsub func + (fn [] + (atom.swap! fsm.subscribers (fn [subs key] (tset subs key nil) subs) sub-key)))) + +(fn effect-handler + [effect-map] + " + Takes a map of effect->function and returns a function that handles these + effects by calling the mapped-to function, and then calls that function's + return value (a cleanup function) and calls it on the next transition. + + These functions must return their own cleanup function or nil. + " + ;; Create a one-time atom used to store the cleanup function + (let [cleanup-ref (atom.new nil)] + ;; Return a subscriber function + (fn [{: prev-state : next-state : action : effect : extra}] + ;; Whenever a transition occurs, call the cleanup function, if set + (call-when (atom.deref cleanup-ref)) + ;; Get a new cleanup function or nil and update cleanup-ref atom + (atom.reset! cleanup-ref + (call-when (. effect-map effect) next-state extra))))) -" -Create Machine -Creates a finite-state-machine based on the table of given states. -Takes a map-table of states and actions, an initial state table, and a key -to specify which key stores the current state string. -Returns an fsm table that manages state and can dispatch actions. - -Example: - -(local states - {:idle {:activate idle->active - :enter-app idle->in-app} - :active {:deactivate active->idle-or-in-app - :activate active->active - :enter-app active->active - :leave-app active->active} - :in-app {:activate in-app->active - :enter-app in-app->in-app - :leave-app in-app->idle}}) - -(local fsm (create-machine states {:state :idle} :state)) -(fsm.dispatch :activate {:extra :data}) -(print \"current-state: \" (hs.inspect (atom.deref (fsm.state)))) -" (fn create-machine - [states initial-state state-key] - (let [machine-state (atom.new initial-state)] - {:dispatch (create-dispatcher states machine-state state-key) - :states states - :state machine-state})) + [template] + (let [fsm {:state (atom.new {:current-state template.state.current-state :context template.state.context}) + :states template.states + :subscribers (atom.new {}) + :log (if template.log (hs.logger.new template.log "info"))}] + ; Add methods + (tset fsm :get-state (partial get-state fsm)) + (tset fsm :send (partial send fsm)) + (tset fsm :subscribe (partial subscribe fsm)) + fsm)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Exports +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -{:new create-machine} +{: effect-handler + : send + : subscribe + :new create-machine} diff --git a/lib/testing/assert.fnl b/lib/testing/assert.fnl index becbf5f..3bd7478 100644 --- a/lib/testing/assert.fnl +++ b/lib/testing/assert.fnl @@ -4,6 +4,10 @@ [actual expected message] (assert (= actual expected) (.. message " instead got " (hs.inspect actual)))) +(fn exports.not-eq? + [first second message] + (assert (not= first second) (.. message " instead both were " (hs.inspect first)))) + (fn exports.ok? [actual message] (assert (= (not (not actual)) true) (.. message " instead got " (hs.inspect actual)))) diff --git a/test/statemachine-test.fnl b/test/statemachine-test.fnl index 7519a9b..be9a1a0 100644 --- a/test/statemachine-test.fnl +++ b/test/statemachine-test.fnl @@ -6,24 +6,20 @@ [] (statemachine.new ;; States that the machine can be in mapped to their actions and transitions - {:closed {:toggle (fn closed->opened - [machine event] - {:state :opened - :context {:i (+ machine.context.i 1) - :event event}})} - :opened {:toggle (fn opened->closed - [machine event] - {:state :closed - :context {:i (+ machine.context.i 1) - :event event}})}} - - ;; Initial machine state - {:state :closed - :context {:i 0 - :event nil}} - - ;; Key that refers to current machine state - :state)) + {:state {:current-state :closed + :context {:i 0 + :event nil}} + + :states {:closed {:toggle (fn closed->opened + [state action extra] + {:state {:current-state :opened + :context {:i (+ state.context.i 1)}} + :effect :opening})} + :opened {:toggle (fn opened->closed + [state action extra] + {:state {:current-state :closed + :context {:i (+ state.context.i 1)}} + :effect :closing})}}})) (describe "State Machine" @@ -32,29 +28,78 @@ (it "Should create a new fsm in the closed state" (fn [] (let [fsm (make-fsm)] - (is.eq? (. (atom.deref fsm.state) :state) :closed "Initial state was not closed") - (is.eq? (type fsm.dispatch) :function "Dispatch was not a function")))) + (is.eq? (. (atom.deref fsm.state) :current-state) :closed "Initial state was not closed")))) + + (it "Should include some methods" + (fn [] + (let [fsm (make-fsm)] + (is.eq? (type fsm.get-state) :function "No get-state method") + (is.eq? (type fsm.send) :function "No send method ") + (is.eq? (type fsm.subscribe) :function "No subscribe method")))) - (it "Should transition to opened on toggle event" + (it "Should transition to opened on toggle action" (fn [] (let [fsm (make-fsm)] - (is.eq? (fsm.dispatch :toggle :opening) true "Dispatch did not return true for handled event") - (is.eq? (. (atom.deref fsm.state) :state) :opened "State did not transition to opened") - (is.eq? (. (atom.deref fsm.state) :context :event) :opening "Context data was not updated with event data")))) + (is.eq? (fsm.send :toggle) true "Dispatch did not return true for handled event") + (is.eq? (. (atom.deref fsm.state) :current-state) :opened "State did not transition to opened")))) (it "Should transition from closed -> opened -> closed" (fn [] (let [fsm (make-fsm)] - (fsm.dispatch :toggle :opening) - (fsm.dispatch :toggle :closing) - (is.eq? (. (atom.deref fsm.state) :state) :closed "State did not transition back to closed") - (is.eq? (. (atom.deref fsm.state) :context :i) 2 "context.i should be 2 from 2 transitions") - (is.eq? (. (atom.deref fsm.state) :context :event) :closing "Context data was not updated with event data")))) + (fsm.send :toggle) + (fsm.send :toggle) + (is.eq? (. (atom.deref fsm.state) :current-state) :closed "State did not transition back to closed") + (is.eq? (. (atom.deref fsm.state) :context :i) 2 "context.i should be 2 from 2 transitions")))) (it "Should not explode when dispatching an unhandled event" (fn [] (let [fsm (make-fsm)] - (is.eq? (fsm.dispatch :fail nil) false "The FSM exploded from dispatching a :fail event")))) + (is.eq? (fsm.send :fail nil) false "The FSM exploded from dispatching a :fail event")))) + + (it "Subscribers should be called on events" + (fn [] + (let [fsm (make-fsm) + i (atom.new 0)] + (fsm.subscribe (fn [] (atom.swap! i (fn [v] (+ v 1))))) + (fsm.send :toggle) + (is.eq? (atom.deref i) 1 "The subscriber was not called")))) + + (it "Subscribers should be provided old and new context, action, effect, and extra" + (fn [] + (let [fsm (make-fsm)] + (fsm.subscribe (fn [{: prev-state : next-state : action : effect : extra}] + (is.not-eq? prev-state.context.i + next-state.context.i "Subscriber did not get old and new state") + (is.eq? action :toggle "Subscriber did not get correct action") + (is.eq? effect :opening "Subscriber did not get correct effect") + (is.eq? extra :extra "Subscriber did not get correct extra"))) + (fsm.send :toggle :extra)))) + (it "Subscribers should be able to unsubscribe" + (fn [] + (let [fsm (make-fsm)] + (let [i (atom.new 0) + unsub (fsm.subscribe (fn [] (atom.swap! i (fn [v] (+ v 1)))))] + (fsm.send :toggle) + (unsub) + (fsm.send :toggle) + (is.eq? (atom.deref i) 1 "The subscriber was called after unsubscribing"))))) - )) + (it "Effect handler should maintain cleanup function" + (fn [] + (let [fsm (make-fsm) + effect-state (atom.new :unused) + effect-handler (statemachine.effect-handler + {:opening (fn [] + (atom.swap! effect-state + (fn [_ nv] nv) :opened) + ; Returned cleanup func + (fn [] + (atom.swap! effect-state + (fn [_ nv] nv) :cleaned)))}) + unsub (fsm.subscribe effect-handler)] + (fsm.send :toggle) + (is.eq? (atom.deref effect-state) :opened "Effect handler should have been called") + (fsm.send :toggle) + (is.eq? (atom.deref effect-state) :cleaned "Cleanup function should have been called") + ))))) diff --git a/vim.fnl b/vim.fnl index beba670..4caa5db 100644 --- a/vim.fnl +++ b/vim.fnl @@ -1,15 +1,15 @@ (local atom (require :lib.atom)) -(local hyper (require :lib.hyper)) -(local {:call-when call-when - :contains? contains? - :eq? eq? - :filter filter - :find find - :get-in get-in - :has-some? has-some? - :map map - :some some} (require :lib.functional)) -(local machine (require :lib.statemachine)) +(local {: call-when + : contains? + : eq? + : filter + : find + : get-in + : has-some? + : map + : noop + : some} (require :lib.functional)) +(local statemachine (require :lib.statemachine)) (local {:bind-keys bind-keys} (require :lib.bind)) (local log (hs.logger.new "vim.fnl" "debug")) @@ -26,9 +26,6 @@ TODO: Create another state machine system to support key chords for bindings endlessly enter recursive submenus " -;; Debug -(local hyper (require :lib.hyper)) - (var fsm nil) ;; Box shapes for displaying current mode @@ -50,35 +47,33 @@ TODO: Create another state machine system to support key chords for bindings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Actions +;; Action dispatch functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (fn disable [] (when fsm - (: box :hide) - (: text :hide) - (fsm.dispatch :disable))) + (fsm.send :disable))) (fn enable [] (when fsm - (fsm.dispatch :enable))) + (fsm.send :enable))) (fn normal [] (when fsm - (fsm.dispatch :normal))) + (fsm.send :normal))) (fn visual [] (when fsm - (fsm.dispatch :visual))) + (fsm.send :visual))) (fn insert [] (when fsm - (fsm.dispatch :insert))) + (fsm.send :insert))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -290,24 +285,33 @@ TODO: Create another state machine system to support key chords for bindings ;; Side Effects ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(fn normal-mode - [state] +(fn enter-normal-mode + [state extra] (state-box "Normal") - (call-when state.unbind-keys) - {:mode :normal - :unbind-keys (bind-keys bindings.normal) - }) + (bind-keys bindings.normal)) -(fn insert-mode - [] +(fn enter-insert-mode + [state extra] (state-box "Insert") (bind-keys bindings.insert)) -(fn visual-mode - [] +(fn enter-visual-mode + [state extra] (state-box "Visual") (bind-keys bindings.visual)) +(fn disable-vim-mode + [state extra] + (: box :hide) + (: text :hide)) + +(local vim-effect + (statemachine.effect-handler + {:enter-normal-mode enter-normal-mode + :enter-insert-mode enter-insert-mode + :enter-visual-mode enter-visual-mode + :disable-vim-mode disable-vim-mode})) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Transitions @@ -315,37 +319,40 @@ TODO: Create another state machine system to support key chords for bindings (fn disabled->normal [state data] - (when (get-in [:config :vim :enabled] state) - (normal-mode state))) + (when (get-in [:context :config :vim :enabled] state) + {:state {:current-state :normal + :context state.context} + :effect :enter-normal-mode})) (fn normal->insert [state data] - (call-when state.unbind-keys) - (call-when state.untap) - {:mode :insert - :unbind-keys (insert-mode)}) + {:state {:current-state :insert + :context state.context} + :effect :enter-insert-mode}) (fn normal->visual [state data] - (call-when state.unbind-keys) - (call-when state.untap) - {:mode :visual - :unbind-keys (visual-mode)}) + {:state {:current-state :visual + :context state.context} + :effect :enter-visual-mode}) (fn ->disabled [state data] - (call-when state.unbind-keys) - (call-when state.untap) - {:mode :disabled - :unbind-keys :nil}) + {:state {:current-state :disabled + :context state.context} + :effect :disable-vim-mode}) (fn insert->normal [state data] - (normal-mode state)) + {:state {:current-state :normal + :context state.context} + :effect :enter-normal-mode}) (fn visual->normal [state data] - (normal-mode state)) + {:state {:current-state :normal + :context state.context} + :effect :enter-normal-mode}) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -371,13 +378,13 @@ TODO: Create another state machine system to support key chords for bindings [fsm] (atom.add-watch fsm.state :logger (fn [state] - (log.f "Vim mode: %s" state.mode)))) + (log.f "Vim mode: %s" state.current-state)))) (fn watch-screen [fsm active-screen-changed] (let [state (atom.deref fsm.state)] - (when (~= state.mode :disabled) - (state-box state.mode)))) + (when (~= state.current-state :disabled) + (state-box state.current-state)))) ;; (fn log-key ;; [event] @@ -407,13 +414,14 @@ TODO: Create another state machine system to support key chords for bindings screen. Returns function to cleanup watcher resources " - (let [initial {:config config - :mode :disabled - :unbind-keys nil} - state-machine (machine.new states initial :mode) + (let [template {:state {:current-state :disabled + :context {:config config}} + :states states} + _fsm (statemachine.new template) stop-screen-watcher (create-screen-watcher - (partial watch-screen state-machine))] - (set fsm state-machine) + (partial watch-screen _fsm))] + (set fsm _fsm) + (fsm.subscribe vim-effect) (log-updates fsm) (when (get-in [:vim :enabled] config) (enable)) @@ -425,6 +433,6 @@ TODO: Create another state machine system to support key chords for bindings ;; Exports ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -{:init init - :disable disable - :enable enable} +{: init + : disable + : enable}