├── .gitignore ├── .travis.yml ├── README.md ├── bower.json ├── src └── Data │ ├── Store.purs │ └── Store │ ├── DevTools.js │ ├── DevTools.purs │ └── Types.purs └── test └── Main.purs /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /.psc* 6 | /.psa* 7 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | node_js: 2 | - "node" 3 | language: node_js 4 | install: 5 | - npm install -g purescript pulp bower 6 | - bower install 7 | script: 8 | - pulp test 9 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-store 2 | 3 | A simple application state store in native PureScript, inspired by [Redux](http://redux.js.org/) (and compatible with the [Redux Dev Tools extension](http://zalmoxisus.github.io/redux-devtools-extension/)). 4 | 5 | ## Usage 6 | 7 | The store is built around the idea of _actions_ (usually an algebraic datatype like `data Action = DoThisThing | DoTheOtherThing`) and an _update_ function. The update function, a pure function, is responsible for updating the application state when you trigger an action using the `dispatch` function. To respond to these state changes, you `subscribe` to the store with an effectful function that updates the environment to reflect the new state. 8 | 9 | ```purescript 10 | createStore :: ∀ e s a. (Generic a, Generic s) ⇒ (a → s → s) → s → Eff (store :: STORE | e) (Store e a s) 11 | ``` 12 | 13 | You create a store using the `createStore` function, which takes an update function and a starting state. The `Store` you get back has two properties `store.dispatch` and `store.subscribe`, as described above. 14 | 15 | ```purescript 16 | type Store e a s = 17 | { subscribe :: (s → Eff e Unit) → Eff (store :: STORE | e) Unit 18 | , dispatch :: a → Eff (store :: STORE | e) Unit 19 | } 20 | ``` 21 | 22 | You'll note from looking at `createStore` that your actions and your state must both have `Generic` instances. This is in order to work nicely with the Redux Dev Tools extension, which provides features like being able to export states as JSON files and import them back into a running application. You can usually get the compiler to generate these by using generic deriving, for instance `derive instance genericAction :: Generic Action`. 23 | 24 | ### Example 25 | 26 | A simple working example, where the application state is just an integer, with two actions which increment and decrement it: 27 | 28 | ```purescript 29 | module Main where 30 | 31 | import Data.Generic (class Generic) 32 | import Control.Monad.Eff.Console (log) 33 | 34 | import Data.Store (createStore) 35 | 36 | type State = Int 37 | 38 | seedState :: State 39 | seedState = 0 40 | 41 | data Action = Pred | Succ 42 | derive instance genericAction :: Generic Action 43 | 44 | update :: Action → State → State 45 | update Pred n = n - 1 46 | update Succ n = n + 1 47 | 48 | main = do 49 | store ← createStore update seedState 50 | 51 | store.subscribe \n → log ("The number is " <> show n) 52 | -- prints "The number is 0" to the console. 53 | 54 | store.dispatch Succ 55 | -- prints "The number is 1" to the console. 56 | 57 | store.dispatch Pred 58 | -- prints "The number is 0" to the console. 59 | ``` 60 | 61 | ## Licence 62 | 63 | Copyright 2016 Bodil Stokke 64 | 65 | This program is free software: you can redistribute it and/or modify 66 | it under the terms of the GNU Lesser General Public License as 67 | published by the Free Software Foundation, either version 3 of the 68 | License, or (at your option) any later version. 69 | 70 | This program is distributed in the hope that it will be useful, but 71 | WITHOUT ANY WARRANTY; without even the implied warranty of 72 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 73 | Lesser General Public License for more details. 74 | 75 | You should have received a copy of the GNU Lesser General Public 76 | License along with this program. If not, see 77 | . 78 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-store", 3 | "version": "1.0.1", 4 | "license": "LGPL-3.0+", 5 | "repository": { 6 | "type": "git", 7 | "url": "git://github.com/bodil/purescript-store.git" 8 | }, 9 | "ignore": [ 10 | "**/.*", 11 | "node_modules", 12 | "bower_components", 13 | "output" 14 | ], 15 | "dependencies": { 16 | "purescript-prelude": "^2.1.0", 17 | "purescript-foreign-generic": "^3.0.0", 18 | "purescript-refs": "^2.0.0" 19 | }, 20 | "devDependencies": { 21 | "purescript-psci-support": "^2.0.0", 22 | "purescript-test-unit": "^10.0.1" 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /src/Data/Store.purs: -------------------------------------------------------------------------------- 1 | module Data.Store 2 | ( createStore 3 | , Store 4 | , module Data.Store.Types 5 | ) where 6 | 7 | import Prelude 8 | import Data.Store.DevTools as Dev 9 | import Control.Monad.Eff (Eff) 10 | import Control.Monad.Eff.Ref (Ref, readRef, newRef, writeRef, modifyRef) 11 | import Control.Monad.Eff.Ref.Unsafe (unsafeRunRef) 12 | import Control.Monad.Eff.Unsafe (unsafeCoerceEff) 13 | import Data.Generic (class Generic) 14 | import Data.List (List(Cons, Nil)) 15 | import Data.Store.DevTools (DevTools) 16 | import Data.Store.Types (STORE) 17 | import Data.Traversable (traverse_) 18 | 19 | type Store e a s = 20 | { subscribe :: (s → Eff e Unit) → Eff (store :: STORE | e) Unit 21 | , dispatch :: a → Eff (store :: STORE | e) Unit 22 | } 23 | 24 | type Store' e a s = 25 | { devTools :: DevTools a s 26 | , state :: Ref s 27 | , subscribers :: Ref (List (s → Eff e Unit)) 28 | , update :: a → s → s 29 | , seed :: s 30 | } 31 | 32 | subscribe :: ∀ e a s. Store' e a s → (s → Eff e Unit) → Eff (store :: STORE | e) Unit 33 | subscribe store sub = unsafeRunRef do 34 | modifyRef store.subscribers (Cons sub) 35 | state' ← readRef store.state 36 | unsafeCoerceEff $ sub state' 37 | 38 | setState :: ∀ e a s. Store' e a s → s → Eff (store :: STORE | e) Unit 39 | setState store state' = unsafeRunRef do 40 | writeRef store.state state' 41 | subs ← readRef store.subscribers 42 | traverse_ (\sub → unsafeCoerceEff $ sub state') subs 43 | 44 | dispatch :: ∀ e a s. Store' e a s → a → Eff (store :: STORE | e) Unit 45 | dispatch store action = unsafeRunRef do 46 | state ← readRef store.state 47 | let state' = store.update action state 48 | unsafeCoerceEff $ setState store state' 49 | Dev.send store.devTools action state' 50 | 51 | createStore' :: ∀ e s a. (Generic a, Generic s) ⇒ (a → s → s) → s → Eff (store :: STORE | e) (Store' e a s) 52 | createStore' update seed = unsafeRunRef do 53 | devTools ← Dev.connect 54 | state ← newRef seed 55 | subscribers ← newRef (Nil :: List (s → Eff e Unit)) 56 | let store = { devTools, state, subscribers, update, seed } 57 | Dev.subscribe devTools 58 | { setState: unsafeCoerceEff <<< setState store 59 | , reset: unsafeCoerceEff $ setState store seed *> Dev.init devTools seed 60 | , commit: readRef state >>= Dev.init devTools 61 | , rollback: \s → unsafeCoerceEff $ setState store s *> Dev.init devTools s 62 | , dispatch: unsafeCoerceEff <<< dispatch store 63 | } 64 | Dev.init devTools seed 65 | pure store 66 | 67 | createStore :: ∀ e s a. (Generic a, Generic s) ⇒ (a → s → s) → s → Eff (store :: STORE | e) (Store e a s) 68 | createStore update seed = do 69 | store ← createStore' update seed 70 | pure { subscribe: subscribe store, dispatch: dispatch store } 71 | -------------------------------------------------------------------------------- /src/Data/Store/DevTools.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | var withDevTools = typeof window !== "undefined" && window.devToolsExtension; 4 | 5 | function checkError(devTools, result) { 6 | if (result.error) { 7 | devTools.connection.error("State deserialise error: " + result.error.join(" + ")); 8 | return false; 9 | } 10 | return true; 11 | } 12 | 13 | exports.connectP = function(serialiseAction) { 14 | return function(deserialiseAction) { 15 | return function(serialiseState) { 16 | return function(deserialiseState) { 17 | return function() { 18 | return withDevTools ? { 19 | connection: window.devToolsExtension.connect(), 20 | serialiseAction: serialiseAction, 21 | deserialiseAction: deserialiseAction, 22 | serialiseState: serialiseState, 23 | deserialiseState: deserialiseState 24 | } : null; 25 | }; 26 | }; 27 | }; 28 | }; 29 | }; 30 | 31 | exports.subscribe = function(devTools) { 32 | return function(cb) { 33 | return function() { 34 | var state, liftedState, action; 35 | 36 | if (devTools) { 37 | devTools.connection.subscribe(function(msg) { 38 | if (msg.type === "DISPATCH") { 39 | if (msg.payload.type === "JUMP_TO_STATE") { 40 | state = devTools.deserialiseState(JSON.parse(msg.state)); 41 | if (checkError(devTools, state)) { 42 | cb.setState(state.result)(); 43 | } 44 | } else if (msg.payload.type === "RESET") { 45 | cb.reset(); 46 | } else if (msg.payload.type === "COMMIT") { 47 | cb.commit(); 48 | } else if (msg.payload.type === "ROLLBACK") { 49 | state = devTools.deserialiseState(JSON.parse(msg.state)); 50 | if (checkError(devTools, state)) { 51 | cb.rollback(state.result)(); 52 | } 53 | // } else if (msg.payload.type === "TOGGLE_ACTION") { 54 | // cb.toggleAction(msg.payload.id)(devTools.deserialiseState(msg.state))(); 55 | } 56 | } else if (msg.type === "ACTION") { 57 | action = devTools.deserialiseAction(JSON.parse(msg.payload)); 58 | if (checkError(devTools, action)) { 59 | cb.dispatch(action.result)(); 60 | } 61 | } else if (msg.type === "IMPORT") { 62 | liftedState = JSON.parse(msg.state); 63 | state = liftedState.computedStates[liftedState.computedStates.length - 1].state; 64 | state = devTools.deserialiseState(state); 65 | if (checkError(devTools, state)) { 66 | cb.setState(state.result)(); 67 | devTools.connection.send(null, liftedState); 68 | } 69 | // } else { 70 | // console.log("UNHANDLED:", JSON.stringify(msg)); 71 | } 72 | }); 73 | } 74 | }; 75 | }; 76 | }; 77 | 78 | exports.send = function(devTools) { 79 | return function(action) { 80 | return function(state) { 81 | return function() { 82 | if (devTools) { 83 | devTools.connection.send(Object.assign( 84 | {}, devTools.serialiseAction(action), 85 | {"type": (action.constructor && action.constructor.name) 86 | || action.tag || action.toString()} 87 | ), devTools.serialiseState(state)); 88 | } 89 | }; 90 | }; 91 | }; 92 | }; 93 | 94 | exports.init = function(devTools) { 95 | return function(state) { 96 | return function() { 97 | if (devTools) { 98 | devTools.connection.init(devTools.serialiseState(state)); 99 | } 100 | }; 101 | }; 102 | }; 103 | -------------------------------------------------------------------------------- /src/Data/Store/DevTools.purs: -------------------------------------------------------------------------------- 1 | module Data.Store.DevTools 2 | ( connect 3 | , subscribe 4 | , send 5 | , init 6 | , Dispatch 7 | , DevTools 8 | ) where 9 | 10 | import Prelude 11 | import Control.Monad.Eff (Eff) 12 | import Control.Monad.Except (runExcept) 13 | import Data.Array (fromFoldable) 14 | import Data.Either (Either(Left, Right)) 15 | import Data.Foreign (MultipleErrors, Foreign) 16 | import Data.Foreign.Generic (defaultOptions, readGeneric, toForeignGeneric) 17 | import Data.Generic (class Generic) 18 | import Data.Maybe (Maybe(Just, Nothing)) 19 | import Data.Nullable (toNullable, Nullable) 20 | import Data.Store.Types (STORE) 21 | 22 | type Dispatch e a s = 23 | { reset :: Eff e Unit 24 | , commit :: Eff e Unit 25 | , rollback :: s → Eff e Unit 26 | , setState :: s → Eff e Unit 27 | , dispatch :: a → Eff e Unit 28 | } 29 | 30 | foreign import data DevTools :: * → * → * 31 | 32 | type ParseResult a = { error :: Nullable (Array String), result :: Nullable a } 33 | 34 | toParseResultObj :: ∀ a. Either MultipleErrors a → ParseResult a 35 | toParseResultObj (Right a) = 36 | { error: toNullable Nothing 37 | , result: toNullable $ Just a 38 | } 39 | toParseResultObj (Left errors) = 40 | { error: toNullable $ Just $ show <$> fromFoldable errors 41 | , result: toNullable Nothing 42 | } 43 | 44 | connect :: ∀ e a s. (Generic a, Generic s) ⇒ Eff (store :: STORE | e) (DevTools a s) 45 | connect = connectP (toForeignGeneric defaultOptions) (readGeneric defaultOptions >>> runExcept >>> toParseResultObj) (toForeignGeneric defaultOptions) (readGeneric defaultOptions >>> runExcept >>> toParseResultObj) 46 | 47 | foreign import connectP :: ∀ e a s. (a → Foreign) → (Foreign → ParseResult a) → (s → Foreign) → (Foreign → ParseResult s) → Eff (store :: STORE | e) (DevTools a s) 48 | foreign import subscribe :: ∀ e a s. DevTools a s → Dispatch (store :: STORE | e) a s → Eff (store :: STORE | e) Unit 49 | foreign import send :: ∀ e a s. DevTools a s → a → s → Eff (store :: STORE | e) Unit 50 | foreign import init :: ∀ e a s. DevTools a s → s → Eff (store :: STORE | e) Unit 51 | -------------------------------------------------------------------------------- /src/Data/Store/Types.purs: -------------------------------------------------------------------------------- 1 | module Data.Store.Types where 2 | 3 | foreign import data STORE :: ! 4 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | import Test.Unit.Assert as Assert 5 | import Control.Monad.Aff (makeAff, Aff) 6 | import Control.Monad.Aff.AVar (AVAR) 7 | import Control.Monad.Aff.Unsafe (unsafeCoerceAff) 8 | import Control.Monad.Eff (Eff) 9 | import Control.Monad.Eff.Class (liftEff) 10 | import Control.Monad.Eff.Console (CONSOLE) 11 | import Control.Monad.Eff.Unsafe (unsafeCoerceEff) 12 | import Data.Generic (class Generic) 13 | import Data.Store (Store, STORE, createStore) 14 | import Data.Tuple (Tuple(Tuple)) 15 | import Test.Unit (test) 16 | import Test.Unit.Console (TESTOUTPUT) 17 | import Test.Unit.Main (runTest) 18 | 19 | data Action = SuccLeft | PredLeft | SuccRight | PredRight 20 | derive instance genericAction :: Generic Action 21 | 22 | initialState :: Tuple Int Int 23 | initialState = Tuple 0 0 24 | 25 | update :: Action → Tuple Int Int → Tuple Int Int 26 | update SuccLeft (Tuple left right) = Tuple (left + 1) right 27 | update PredLeft (Tuple left right) = Tuple (left - 1) right 28 | update SuccRight (Tuple left right) = Tuple left (right + 1) 29 | update PredRight (Tuple left right) = Tuple left (right - 1) 30 | 31 | onState :: ∀ e a s. Store e a s → Aff (store :: STORE | e) s 32 | onState store = unsafeCoerceAff $ makeAff \_ resolve → 33 | unsafeCoerceEff $ store.subscribe resolve 34 | 35 | main :: forall e. Eff (console :: CONSOLE, testOutput :: TESTOUTPUT, avar :: AVAR, store :: STORE | e) Unit 36 | main = runTest do 37 | test "dispatch and subscribe" do 38 | store ← liftEff $ createStore update initialState 39 | liftEff $ store.dispatch PredLeft 40 | liftEff $ store.dispatch SuccRight 41 | onState store >>= Assert.equal (Tuple (-1) 1) 42 | --------------------------------------------------------------------------------