├── .github ├── FUNDING.yml └── workflows │ └── ci.yml ├── .tidyrc.json ├── example ├── basic-no-action │ ├── NoAction │ │ ├── Store.purs │ │ ├── Main.purs │ │ └── Counter.purs │ ├── README.md │ └── index.html ├── basic │ ├── README.md │ ├── index.html │ └── Basic │ │ ├── Store.purs │ │ ├── Main.purs │ │ └── Counter.purs ├── basic-hooks │ ├── README.md │ ├── index.html │ └── Hooks │ │ ├── Store.purs │ │ ├── Main.purs │ │ └── Counter.purs ├── example.dhall └── redux-todo │ ├── index.html │ ├── README.md │ └── ReduxTodo │ ├── Main.purs │ ├── Store.purs │ ├── Component │ ├── App.purs │ ├── AddTodo.purs │ ├── FilterLink.purs │ └── TodoList.purs │ └── Store │ ├── Visibility.purs │ └── Todos.purs ├── .gitignore ├── packages.dhall ├── .editorconfig ├── spago.dhall ├── package.json ├── shell.nix ├── LICENSE ├── src └── Halogen │ └── Store │ ├── UseSelector.purs │ ├── Select.purs │ ├── Connect.purs │ └── Monad.purs └── README.md /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: [thomashoneyman] 4 | -------------------------------------------------------------------------------- /.tidyrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "indent": 2, 3 | "operatorsFile": null, 4 | "ribbon": 1, 5 | "typeArrowPlacement": "first", 6 | "unicode": "never", 7 | "width": null 8 | } 9 | -------------------------------------------------------------------------------- /example/basic-no-action/NoAction/Store.purs: -------------------------------------------------------------------------------- 1 | module NoAction.Store where 2 | 3 | type Store = { count :: Int } 4 | 5 | initialStore :: Store 6 | initialStore = { count: 0 } 7 | 8 | type Action = Store -> Store 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .* 2 | !.gitignore 3 | !.github 4 | !.editorconfig 5 | !.tidyrc.json 6 | 7 | bower_components 8 | node_modules 9 | 10 | output 11 | generated-docs 12 | 13 | *.lock 14 | 15 | example/**/app.js 16 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20220901/packages.dhall 3 | sha256:f1531b29c21ac437ffe5666c1b6cc76f0a9c29d3c9d107ff047aa2567744994f 4 | 5 | in upstream 6 | -------------------------------------------------------------------------------- /example/basic/README.md: -------------------------------------------------------------------------------- 1 | # Basic Example 2 | 3 | The basic example demonstrates how to set up a small store and connect to it from a single component (a counter). It's a minimal version of the typical architecture for a small application that uses a global state. 4 | -------------------------------------------------------------------------------- /example/basic-hooks/README.md: -------------------------------------------------------------------------------- 1 | # Hooks Example 2 | 3 | The basic-hooks example is yet another alternative to the basic example. It demonstrates how to access a small store from a single component (a counter) using hooks functionality (`useSeletor`) instead of stateful component. -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | # https://editorconfig.org 2 | root = true 3 | 4 | [*] 5 | indent_style = space 6 | indent_size = 2 7 | end_of_line = lf 8 | charset = utf-8 9 | trim_trailing_whitespace = true 10 | insert_final_newline = true 11 | 12 | [*.md] 13 | trim_trailing_whitespace = false 14 | -------------------------------------------------------------------------------- /example/basic-no-action/README.md: -------------------------------------------------------------------------------- 1 | # No Action Example 2 | 3 | The no-action example is an alternative to the basic example. It demonstrates how to set up a small store and connect to it from a single component (a counter) using a `state -> state` function instead of a dedicated action type. 4 | -------------------------------------------------------------------------------- /example/example.dhall: -------------------------------------------------------------------------------- 1 | let conf = ../spago.dhall 2 | in conf // 3 | { dependencies = conf.dependencies # 4 | [ "arrays" 5 | , "const" 6 | , "strings" 7 | , "tuples" 8 | , "variant" 9 | , "web-events" 10 | ] 11 | , sources = conf.sources # 12 | [ "example/**/*.purs" 13 | ] 14 | } 15 | -------------------------------------------------------------------------------- /example/basic/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Halogen Store - Basic 5 | 13 | 14 | 15 | 16 | 17 | 18 | -------------------------------------------------------------------------------- /example/redux-todo/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Halogen Store - Redux Todo 5 | 13 | 14 | 15 | 16 | 17 | 18 | -------------------------------------------------------------------------------- /example/basic-hooks/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Halogen Store - Basic with Hooks 5 | 13 | 14 | 15 | 16 | 17 | 18 | -------------------------------------------------------------------------------- /example/basic-no-action/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Halogen Store - No Action 5 | 13 | 14 | 15 | 16 | 17 | 18 | -------------------------------------------------------------------------------- /example/basic/Basic/Store.purs: -------------------------------------------------------------------------------- 1 | module Basic.Store where 2 | 3 | import Prelude 4 | 5 | type Store = { count :: Int } 6 | 7 | initialStore :: Store 8 | initialStore = { count: 0 } 9 | 10 | data Action 11 | = Increment 12 | | Decrement 13 | 14 | reduce :: Store -> Action -> Store 15 | reduce store = case _ of 16 | Increment -> store { count = store.count + 1 } 17 | Decrement -> store { count = store.count - 1 } 18 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "halogen-store" 2 | , dependencies = 3 | [ "aff" 4 | , "distributive" 5 | , "effect" 6 | , "fork" 7 | , "halogen" 8 | , "halogen-hooks" 9 | , "halogen-subscriptions" 10 | , "maybe" 11 | , "prelude" 12 | , "refs" 13 | , "tailrec" 14 | , "transformers" 15 | , "tuples" 16 | , "unsafe-reference" 17 | ] 18 | , packages = ./packages.dhall 19 | , sources = [ "src/**/*.purs" ] 20 | } 21 | -------------------------------------------------------------------------------- /example/basic-hooks/Hooks/Store.purs: -------------------------------------------------------------------------------- 1 | module Hooks.Store where 2 | 3 | import Prelude 4 | 5 | type Store = { count :: Int } 6 | 7 | initialStore :: Store 8 | initialStore = { count: 0 } 9 | 10 | data Action 11 | = Increment 12 | | Decrement 13 | 14 | reduce :: Store -> Action -> Store 15 | reduce store = case _ of 16 | Increment -> store { count = store.count + 1 } 17 | Decrement -> store { count = store.count - 1 } 18 | -------------------------------------------------------------------------------- /example/redux-todo/README.md: -------------------------------------------------------------------------------- 1 | # Redux Todo Example 2 | 3 | The redux-todo example is a clone of the [official Redux todo list example](https://github.com/reduxjs/redux/tree/master/examples/todos). It demonstrates how to implement multiple independent stores and reducers and how to then combine them together into a single central store and reducer. 4 | 5 | Large real-world applications will likely need to follow an approach similar to the one demonstrated here to keep multiple stores manageable. 6 | -------------------------------------------------------------------------------- /example/basic/Basic/Main.purs: -------------------------------------------------------------------------------- 1 | module Basic.Main where 2 | 3 | import Prelude 4 | 5 | import Basic.Counter as Counter 6 | import Basic.Store as BS 7 | import Effect (Effect) 8 | import Effect.Aff (launchAff_) 9 | import Halogen.Aff as HA 10 | import Halogen.Store.Monad (runStoreT) 11 | import Halogen.VDom.Driver (runUI) 12 | 13 | main :: Effect Unit 14 | main = launchAff_ do 15 | body <- HA.awaitBody 16 | root <- runStoreT BS.initialStore BS.reduce Counter.component 17 | void $ runUI root unit body 18 | -------------------------------------------------------------------------------- /example/basic-hooks/Hooks/Main.purs: -------------------------------------------------------------------------------- 1 | module Hooks.Main where 2 | 3 | import Prelude 4 | 5 | import Hooks.Counter as Counter 6 | import Hooks.Store as HS 7 | import Effect (Effect) 8 | import Effect.Aff (launchAff_) 9 | import Halogen.Aff as HA 10 | import Halogen.Store.Monad (runStoreT) 11 | import Halogen.VDom.Driver (runUI) 12 | 13 | main :: Effect Unit 14 | main = launchAff_ do 15 | body <- HA.awaitBody 16 | root <- runStoreT HS.initialStore HS.reduce Counter.component 17 | void $ runUI root unit body 18 | -------------------------------------------------------------------------------- /example/basic-no-action/NoAction/Main.purs: -------------------------------------------------------------------------------- 1 | module NoAction.Main where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Effect.Aff (launchAff_) 7 | import Halogen.Aff as HA 8 | import Halogen.Store.Monad (runStoreT) 9 | import Halogen.VDom.Driver (runUI) 10 | import NoAction.Counter as Counter 11 | import NoAction.Store as NAS 12 | 13 | main :: Effect Unit 14 | main = launchAff_ do 15 | body <- HA.awaitBody 16 | root <- runStoreT NAS.initialStore (#) Counter.component 17 | void $ runUI root unit body 18 | -------------------------------------------------------------------------------- /example/redux-todo/ReduxTodo/Main.purs: -------------------------------------------------------------------------------- 1 | module ReduxTodo.Main where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Effect.Aff (launchAff_) 7 | import Halogen.Aff as HA 8 | import Halogen.Store.Monad (runStoreT) 9 | import Halogen.VDom.Driver (runUI) 10 | import ReduxTodo.Component.App (app) 11 | import ReduxTodo.Store as Store 12 | 13 | main :: Effect Unit 14 | main = launchAff_ do 15 | body <- HA.awaitBody 16 | root <- runStoreT Store.initialStore Store.reduce app 17 | void $ runUI root unit body 18 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [main] 6 | pull_request: 7 | 8 | jobs: 9 | build: 10 | runs-on: ubuntu-latest 11 | 12 | steps: 13 | - uses: actions/checkout@v2 14 | 15 | - uses: purescript-contrib/setup-purescript@main 16 | with: 17 | purs-tidy: "latest" 18 | 19 | - name: Install esbuild 20 | run: npm install --global esbuild@0.14.38 21 | 22 | - name: Build source 23 | run: npm run build 24 | 25 | - name: Build examples 26 | run: npm run examples 27 | 28 | - name: Verify formatting 29 | run: purs-tidy check src example 30 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "scripts": { 3 | "build": "spago build", 4 | "examples": "npm run examples:basic && npm run examples:basic-no-action && npm run examples:redux-todo", 5 | "examples:basic": "spago -x example/example.dhall bundle-app --main Basic.Main --to example/basic/app.js", 6 | "examples:basic-no-action": "spago -x example/example.dhall bundle-app --main NoAction.Main --to example/basic-no-action/app.js", 7 | "examples:redux-todo": "spago -x example/example.dhall bundle-app --main ReduxTodo.Main --to example/redux-todo/app.js", 8 | "examples:basic-hooks": "spago -x example/example.dhall bundle-app --main Hooks.Main --to example/basic-hooks/app.js" 9 | } 10 | } 11 | -------------------------------------------------------------------------------- /example/redux-todo/ReduxTodo/Store.purs: -------------------------------------------------------------------------------- 1 | module ReduxTodo.Store where 2 | 3 | import Data.Variant (Variant) 4 | import Data.Variant as Variant 5 | import ReduxTodo.Store.Todos as Todos 6 | import ReduxTodo.Store.Visibility as Visibility 7 | 8 | type Store = 9 | { todos :: Todos.Store 10 | , visibility :: Visibility.Store 11 | } 12 | 13 | initialStore :: Store 14 | initialStore = 15 | { todos: Todos.initialStore 16 | , visibility: Visibility.initialStore 17 | } 18 | 19 | type Action = Variant 20 | ( todos :: Todos.Action 21 | , visibility :: Visibility.Action 22 | ) 23 | 24 | reduce :: Store -> Action -> Store 25 | reduce store = Variant.match 26 | { todos: \action -> store { todos = Todos.reduce store.todos action } 27 | , visibility: \action -> store { visibility = Visibility.reduce store.visibility action } 28 | } 29 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | let 2 | pkgs = import (builtins.fetchTarball { 3 | url = "https://github.com/NixOS/nixpkgs/archive/22.05.tar.gz"; 4 | }) { }; 5 | 6 | # To update to a newer version of easy-purescript-nix, run: 7 | # nix-prefetch-git https://github.com/justinwoo/easy-purescript-nix 8 | # 9 | # Then, copy the resulting rev and sha256 here. 10 | pursPkgs = import (pkgs.fetchFromGitHub { 11 | owner = "justinwoo"; 12 | repo = "easy-purescript-nix"; 13 | rev = "5926981701ac781f08b02e31e4705e46b799299d"; 14 | sha256 = "03g9xq451dmrkq8kiz989wnl8k0lmj60ajflz44bhp7cm08hf3bw"; 15 | }) { inherit pkgs; }; 16 | 17 | in pkgs.stdenv.mkDerivation { 18 | name = "halogen-store"; 19 | buildInputs = with pursPkgs; [ 20 | pursPkgs.purs-0_15_4 21 | pursPkgs.spago 22 | pursPkgs.psa 23 | pursPkgs.purs-tidy 24 | pursPkgs.purescript-language-server 25 | 26 | pkgs.nodejs-16_x 27 | pkgs.esbuild 28 | ]; 29 | } 30 | -------------------------------------------------------------------------------- /example/redux-todo/ReduxTodo/Component/App.purs: -------------------------------------------------------------------------------- 1 | module ReduxTodo.Component.App where 2 | 3 | import Prelude 4 | 5 | import Halogen as H 6 | import Halogen.HTML as HH 7 | import Halogen.Store.Monad (class MonadStore) 8 | import ReduxTodo.Component.AddTodo (addTodo) 9 | import ReduxTodo.Component.FilterLink (filterLink) 10 | import ReduxTodo.Component.TodoList (todoList) 11 | import ReduxTodo.Store as Store 12 | import ReduxTodo.Store.Visibility (Visibility(..)) 13 | 14 | app 15 | :: forall query input output m 16 | . MonadStore Store.Action Store.Store m 17 | => H.Component query input output m 18 | app = H.mkComponent 19 | { initialState: identity 20 | , render 21 | , eval: H.mkEval H.defaultEval 22 | } 23 | where 24 | render _ = 25 | HH.div_ 26 | [ addTodo 27 | , todoList 28 | , HH.div_ 29 | [ HH.span_ [ HH.text "Show: " ] 30 | , filterLink 0 All 31 | , filterLink 1 Active 32 | , filterLink 2 Completed 33 | ] 34 | ] 35 | -------------------------------------------------------------------------------- /example/basic-hooks/Hooks/Counter.purs: -------------------------------------------------------------------------------- 1 | module Hooks.Counter where 2 | 3 | import Prelude 4 | 5 | import Hooks.Store as HS 6 | import Data.Maybe (Maybe(..)) 7 | import Halogen as H 8 | import Halogen.HTML as HH 9 | import Halogen.HTML.Events as HE 10 | import Halogen.Hooks as Hooks 11 | import Halogen.Store.Monad (class MonadStore, updateStore) 12 | import Halogen.Store.Select (selectEq) 13 | import Halogen.Store.UseSelector (useSelector) 14 | 15 | component 16 | :: forall query input output m 17 | . MonadStore HS.Action HS.Store m 18 | => H.Component query input output m 19 | component = Hooks.component \_ _ -> Hooks.do 20 | count <- useSelector $ selectEq _.count 21 | Hooks.pure do 22 | case count of 23 | Nothing -> HH.text "" 24 | Just cnt -> 25 | HH.div_ 26 | [ HH.button 27 | [ HE.onClick \_ -> updateStore HS.Increment ] 28 | [ HH.text "Increment" ] 29 | , HH.text $ " Count: " <> show cnt <> " " 30 | , HH.button 31 | [ HE.onClick \_ -> updateStore HS.Decrement ] 32 | [ HH.text "Decrement" ] 33 | ] 34 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Thomas Honeyman 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /example/redux-todo/ReduxTodo/Store/Visibility.purs: -------------------------------------------------------------------------------- 1 | module ReduxTodo.Store.Visibility 2 | ( Visibility(..) 3 | , Store 4 | , initialStore 5 | , Action 6 | , reduce 7 | , Action' 8 | , setVisibility 9 | ) where 10 | 11 | import Prelude 12 | 13 | import Data.Generic.Rep (class Generic) 14 | import Data.Show.Generic (genericShow) 15 | import Data.Variant (Variant) 16 | import Data.Variant as Variant 17 | import Type.Proxy (Proxy(..)) 18 | 19 | data Visibility = All | Completed | Active 20 | 21 | derive instance eqVisibility :: Eq Visibility 22 | derive instance genericVisibility :: Generic Visibility _ 23 | 24 | instance showVisibility :: Show Visibility where 25 | show = genericShow 26 | 27 | type Store = 28 | { visibility :: Visibility 29 | } 30 | 31 | initialStore :: Store 32 | initialStore = 33 | { visibility: All 34 | } 35 | 36 | data Action = SetVisibility Visibility 37 | 38 | reduce :: Store -> Action -> Store 39 | reduce store = case _ of 40 | SetVisibility visibility -> 41 | store { visibility = visibility } 42 | 43 | type Action' v = (visibility :: Action | v) 44 | 45 | injAction :: forall v. Action -> Variant (Action' v) 46 | injAction = Variant.inj (Proxy :: Proxy "visibility") 47 | 48 | setVisibility :: forall v. Visibility -> Variant (Action' v) 49 | setVisibility = injAction <<< SetVisibility 50 | -------------------------------------------------------------------------------- /src/Halogen/Store/UseSelector.purs: -------------------------------------------------------------------------------- 1 | module Halogen.Store.UseSelector where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Data.Tuple.Nested ((/\)) 7 | import Halogen.Hooks (class HookNewtype, type (<>), Hook, UseEffect, UseState) 8 | import Halogen.Hooks as Hooks 9 | import Halogen.Store.Monad (class MonadStore, emitSelected, getStore) 10 | import Halogen.Store.Select (Selector(..)) 11 | 12 | foreign import data UseSelector :: Type -> Type -> Type -> Hooks.HookType 13 | 14 | type UseSelector' :: Type -> Type -> Type -> Hooks.HookType 15 | type UseSelector' act store ctx = UseState (Maybe ctx) <> UseEffect <> Hooks.Pure 16 | 17 | instance HookNewtype (UseSelector act store ctx) (UseSelector' act store ctx) 18 | 19 | useSelector 20 | :: forall m act store ctx 21 | . MonadStore act store m 22 | => Selector store ctx 23 | -> Hook m (UseSelector act store ctx) (Maybe ctx) 24 | useSelector (Selector selector) = Hooks.wrap hook 25 | where 26 | hook :: Hook m (UseSelector' act store ctx) (Maybe ctx) 27 | hook = Hooks.do 28 | ctx /\ ctxId <- Hooks.useState Nothing 29 | 30 | Hooks.useLifecycleEffect do 31 | emitter <- emitSelected (Selector selector) 32 | subscriptionId <- Hooks.subscribe $ map (Hooks.put ctxId <<< Just) emitter 33 | initialCtx <- map selector.select getStore 34 | Hooks.put ctxId $ Just initialCtx 35 | pure $ Just $ Hooks.unsubscribe subscriptionId 36 | 37 | Hooks.pure ctx 38 | -------------------------------------------------------------------------------- /example/redux-todo/ReduxTodo/Store/Todos.purs: -------------------------------------------------------------------------------- 1 | module ReduxTodo.Store.Todos 2 | ( Todo 3 | , Store 4 | , initialStore 5 | , Action 6 | , reduce 7 | , createTodo 8 | , toggleTodo 9 | ) where 10 | 11 | import Prelude 12 | 13 | import Data.Array as Array 14 | import Data.Maybe (fromMaybe) 15 | import Data.Variant (Variant) 16 | import Data.Variant as Variant 17 | import Type.Proxy (Proxy(..)) 18 | 19 | type Todo = 20 | { text :: String 21 | , completed :: Boolean 22 | , id :: Int 23 | } 24 | 25 | type Store = 26 | { todos :: Array Todo 27 | , nextId :: Int 28 | } 29 | 30 | initialStore :: Store 31 | initialStore = { todos: [], nextId: 1 } 32 | 33 | data Action 34 | = CreateTodo String 35 | | ToggleTodo Int 36 | 37 | reduce :: Store -> Action -> Store 38 | reduce store = case _ of 39 | CreateTodo text -> 40 | store 41 | { todos = Array.snoc store.todos { text, completed: false, id: store.nextId } 42 | , nextId = store.nextId + 1 43 | } 44 | 45 | ToggleTodo id -> do 46 | let 47 | toggleCompleted todo = todo { completed = not todo.completed } 48 | newTodos = fromMaybe store.todos do 49 | index <- Array.findIndex (eq id <<< _.id) store.todos 50 | Array.modifyAt index toggleCompleted store.todos 51 | 52 | store { todos = newTodos } 53 | 54 | type Action' v = (todos :: Action | v) 55 | 56 | injAction :: forall v. Action -> Variant (Action' v) 57 | injAction = Variant.inj (Proxy :: Proxy "todos") 58 | 59 | createTodo :: forall v. String -> Variant (Action' v) 60 | createTodo = injAction <<< CreateTodo 61 | 62 | toggleTodo :: forall v. Int -> Variant (Action' v) 63 | toggleTodo = injAction <<< ToggleTodo 64 | -------------------------------------------------------------------------------- /example/basic/Basic/Counter.purs: -------------------------------------------------------------------------------- 1 | module Basic.Counter where 2 | 3 | import Prelude 4 | 5 | import Basic.Store as BS 6 | import Data.Maybe (Maybe(..)) 7 | import Halogen as H 8 | import Halogen.HTML as HH 9 | import Halogen.HTML.Events as HE 10 | import Halogen.Store.Connect (Connected, connect) 11 | import Halogen.Store.Monad (class MonadStore) 12 | import Halogen.Store.Monad as Store 13 | import Halogen.Store.Select (Selector, selectEq) 14 | 15 | type Input = Unit 16 | 17 | type Context = Int 18 | 19 | type State = Int 20 | 21 | data Action 22 | = Increment 23 | | Decrement 24 | | Receive (Connected Context Input) 25 | 26 | deriveState :: Connected Context Input -> State 27 | deriveState { context } = context 28 | 29 | selectCount :: Selector BS.Store Context 30 | selectCount = selectEq _.count 31 | 32 | component 33 | :: forall query output m 34 | . MonadStore BS.Action BS.Store m 35 | => H.Component query Input output m 36 | component = connect selectCount $ H.mkComponent 37 | { initialState: deriveState 38 | , render 39 | , eval: H.mkEval $ H.defaultEval 40 | { handleAction = handleAction 41 | , receive = Just <<< Receive 42 | } 43 | } 44 | where 45 | render count = 46 | HH.div_ 47 | [ HH.button 48 | [ HE.onClick \_ -> Increment ] 49 | [ HH.text "Increment" ] 50 | , HH.text $ " Count: " <> show count <> " " 51 | , HH.button 52 | [ HE.onClick \_ -> Decrement ] 53 | [ HH.text "Decrement" ] 54 | ] 55 | 56 | handleAction = case _ of 57 | Increment -> 58 | Store.updateStore BS.Increment 59 | 60 | Decrement -> 61 | Store.updateStore BS.Decrement 62 | 63 | Receive input -> 64 | H.put $ deriveState input 65 | -------------------------------------------------------------------------------- /example/basic-no-action/NoAction/Counter.purs: -------------------------------------------------------------------------------- 1 | module NoAction.Counter where 2 | 3 | import Prelude 4 | 5 | import NoAction.Store as NAS 6 | import Data.Maybe (Maybe(..)) 7 | import Halogen as H 8 | import Halogen.HTML as HH 9 | import Halogen.HTML.Events as HE 10 | import Halogen.Store.Connect (Connected, connect) 11 | import Halogen.Store.Monad (class MonadStore) 12 | import Halogen.Store.Monad as Store 13 | import Halogen.Store.Select (Selector, selectEq) 14 | 15 | type Input = Unit 16 | 17 | type Context = Int 18 | 19 | type State = Int 20 | 21 | selectState :: Selector NAS.Store Context 22 | selectState = selectEq _.count 23 | 24 | deriveState :: Connected Context Input -> State 25 | deriveState { context } = context 26 | 27 | data Action 28 | = Increment 29 | | Decrement 30 | | Receive (Connected Context Input) 31 | 32 | component 33 | :: forall query output m 34 | . MonadStore NAS.Action NAS.Store m 35 | => H.Component query Input output m 36 | component = connect selectState $ H.mkComponent 37 | { initialState: deriveState 38 | , render 39 | , eval: H.mkEval $ H.defaultEval 40 | { handleAction = handleAction 41 | , receive = Just <<< Receive 42 | } 43 | } 44 | where 45 | render count = 46 | HH.div_ 47 | [ HH.button 48 | [ HE.onClick \_ -> Increment ] 49 | [ HH.text "Increment" ] 50 | , HH.text $ " Count: " <> show count <> " " 51 | , HH.button 52 | [ HE.onClick \_ -> Decrement ] 53 | [ HH.text "Decrement" ] 54 | ] 55 | 56 | handleAction = case _ of 57 | Increment -> 58 | Store.updateStore \store -> store { count = store.count + 1 } 59 | 60 | Decrement -> 61 | Store.updateStore \store -> store { count = store.count - 1 } 62 | 63 | Receive input -> 64 | H.put $ deriveState input 65 | -------------------------------------------------------------------------------- /example/redux-todo/ReduxTodo/Component/AddTodo.purs: -------------------------------------------------------------------------------- 1 | module ReduxTodo.Component.AddTodo (addTodo) where 2 | 3 | import Prelude 4 | 5 | import Data.Const (Const) 6 | import Data.String as String 7 | import Halogen as H 8 | import Halogen.HTML as HH 9 | import Halogen.HTML.Events as HE 10 | import Halogen.HTML.Properties as HP 11 | import Halogen.Store.Monad (class MonadStore, updateStore) 12 | import ReduxTodo.Store as Store 13 | import ReduxTodo.Store.Todos (createTodo) 14 | import Type.Proxy (Proxy(..)) 15 | import Web.Event.Event (Event, preventDefault) 16 | 17 | type Slot id slots = (addTodo :: H.Slot (Const Void) Void id | slots) 18 | 19 | addTodo 20 | :: forall act slots m 21 | . MonadStore Store.Action Store.Store m 22 | => H.ComponentHTML act (Slot Unit slots) m 23 | addTodo = HH.slot_ (Proxy :: Proxy "addTodo") unit component unit 24 | 25 | data Action 26 | = HandleInput String 27 | | HandleSubmit Event 28 | 29 | component 30 | :: forall query input output m 31 | . MonadStore Store.Action Store.Store m 32 | => H.Component query input output m 33 | component = H.mkComponent 34 | { initialState: const "" 35 | , render 36 | , eval: H.mkEval $ H.defaultEval { handleAction = handleAction } 37 | } 38 | where 39 | render state = 40 | HH.div_ 41 | [ HH.form 42 | [ HE.onSubmit HandleSubmit ] 43 | [ HH.input 44 | [ HE.onValueInput HandleInput 45 | , HP.type_ HP.InputText 46 | , HP.value state 47 | ] 48 | , HH.button 49 | [ HP.type_ HP.ButtonSubmit ] 50 | [ HH.text "Add Todo" ] 51 | ] 52 | ] 53 | 54 | handleAction = case _ of 55 | HandleSubmit event -> do 56 | H.liftEffect $ preventDefault event 57 | H.get >>= String.trim >>> case _ of 58 | "" -> 59 | pure unit 60 | value -> do 61 | H.put "" 62 | updateStore $ createTodo value 63 | 64 | HandleInput value -> 65 | H.put value 66 | -------------------------------------------------------------------------------- /example/redux-todo/ReduxTodo/Component/FilterLink.purs: -------------------------------------------------------------------------------- 1 | module ReduxTodo.Component.FilterLink (filterLink) where 2 | 3 | import Prelude 4 | 5 | import Data.Const (Const) 6 | import Data.Maybe (Maybe(..)) 7 | import Halogen as H 8 | import Halogen.HTML as HH 9 | import Halogen.HTML.Events as HE 10 | import Halogen.HTML.Properties as HP 11 | import Halogen.Store.Connect (Connected, connect) 12 | import Halogen.Store.Monad (class MonadStore, updateStore) 13 | import Halogen.Store.Select (Selector, selectEq) 14 | import ReduxTodo.Store as Store 15 | import ReduxTodo.Store.Visibility (Visibility, setVisibility) 16 | import Type.Proxy (Proxy(..)) 17 | 18 | type Slot id slots = (filterLink :: H.Slot (Const Void) Void id | slots) 19 | 20 | filterLink 21 | :: forall action id slots m 22 | . MonadStore Store.Action Store.Store m 23 | => Ord id 24 | => id 25 | -> Input 26 | -> H.ComponentHTML action (Slot id slots) m 27 | filterLink id = HH.slot_ (Proxy :: Proxy "filterLink") id component 28 | 29 | type Input = Visibility 30 | 31 | type Context = Visibility 32 | 33 | type State = 34 | { filter :: Visibility 35 | , active :: Boolean 36 | } 37 | 38 | selectState :: Selector Store.Store Context 39 | selectState = selectEq _.visibility.visibility 40 | 41 | deriveState :: Connected Context Input -> State 42 | deriveState { context, input } = 43 | { filter: input 44 | , active: input == context 45 | } 46 | 47 | data Action 48 | = HandleClick 49 | | Receive (Connected Context Input) 50 | 51 | component 52 | :: forall query output m 53 | . MonadStore Store.Action Store.Store m 54 | => H.Component query Input output m 55 | component = connect selectState $ H.mkComponent 56 | { initialState: deriveState 57 | , render 58 | , eval: H.mkEval $ H.defaultEval 59 | { handleAction = handleAction 60 | , receive = Just <<< Receive 61 | } 62 | } 63 | where 64 | render { filter, active } = 65 | HH.button 66 | [ HE.onClick \_ -> HandleClick 67 | , HP.disabled active 68 | ] 69 | [ HH.text $ show filter ] 70 | 71 | handleAction = case _ of 72 | HandleClick -> do 73 | { filter } <- H.get 74 | updateStore $ setVisibility filter 75 | 76 | Receive input -> 77 | H.put $ deriveState input 78 | -------------------------------------------------------------------------------- /src/Halogen/Store/Select.purs: -------------------------------------------------------------------------------- 1 | module Halogen.Store.Select where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..), maybe) 6 | import Effect.Ref as Ref 7 | import Halogen.Subscription (Emitter) 8 | import Halogen.Subscription as HS 9 | import Unsafe.Reference (unsafeRefEq) 10 | 11 | -- | A `Selector` represents a selection `a` from the store `store`. It is 12 | -- | commonly used with the `connect` and `subscribe` functions when connecting 13 | -- | a component to the store. 14 | -- | 15 | -- | A selector requires both a selection function from `store -> a` and an 16 | -- | equality function for `a`. The equality function is used to make sure 17 | -- | connected components are only notified when the selected state `a` has 18 | -- | changed. 19 | newtype Selector store a = Selector { eq :: a -> a -> Boolean, select :: store -> a } 20 | 21 | -- | Create a `Selector` from an equality function and a function to select a 22 | -- | sub-part of the store. The equality function will be used to determine if 23 | -- | the selected state has changed. 24 | select :: forall store a. (a -> a -> Boolean) -> (store -> a) -> Selector store a 25 | select eq = Selector <<< { eq, select: _ } 26 | 27 | -- | Create a `Selector` from a function to select a sub-part of the store. The 28 | -- | selector will use the `Eq` class to determine if the selected state has 29 | -- | changed. 30 | selectEq :: forall store a. Eq a => (store -> a) -> Selector store a 31 | selectEq = Selector <<< { eq, select: _ } 32 | 33 | -- | Create a `Selector` for the entire store. 34 | selectAll :: forall store. Selector store store 35 | selectAll = Selector { eq: unsafeRefEq, select: identity } 36 | 37 | -- | Apply a `Selector` to an `Emitter` so that the emitter only fires when the 38 | -- | selected value changes, as determined by the selector's equality function. 39 | selectEmitter :: forall store a. Selector store a -> Emitter store -> Emitter a 40 | selectEmitter (Selector selector) emitter = 41 | HS.makeEmitter \push -> do 42 | previousDerivedRef <- Ref.new Nothing 43 | subscription <- HS.subscribe emitter \store -> do 44 | previousDerived <- Ref.read previousDerivedRef 45 | let newDerived = selector.select store 46 | let isUnchanged = maybe false (selector.eq newDerived) previousDerived 47 | unless isUnchanged do 48 | Ref.write (Just newDerived) previousDerivedRef 49 | push newDerived 50 | pure $ HS.unsubscribe subscription 51 | -------------------------------------------------------------------------------- /example/redux-todo/ReduxTodo/Component/TodoList.purs: -------------------------------------------------------------------------------- 1 | module ReduxTodo.Component.TodoList (todoList) where 2 | 3 | import Prelude 4 | 5 | import Data.Array as Array 6 | import Data.Const (Const) 7 | import Data.Maybe (Maybe(..)) 8 | import Data.Tuple (Tuple(..)) 9 | import Halogen as H 10 | import Halogen.HTML as HH 11 | import Halogen.HTML as HP 12 | import Halogen.HTML.Elements.Keyed as HK 13 | import Halogen.HTML.Events as HE 14 | import Halogen.Store.Connect (Connected, connect) 15 | import Halogen.Store.Monad (class MonadStore, updateStore) 16 | import Halogen.Store.Select (Selector, selectEq) 17 | import ReduxTodo.Store as Store 18 | import ReduxTodo.Store.Todos (Todo, toggleTodo) 19 | import ReduxTodo.Store.Visibility (Visibility(..)) 20 | import Type.Proxy (Proxy(..)) 21 | 22 | type Slot id slots = (todoList :: H.Slot (Const Void) Void id | slots) 23 | 24 | todoList 25 | :: forall action slots m 26 | . MonadStore Store.Action Store.Store m 27 | => H.ComponentHTML action (Slot Unit slots) m 28 | todoList = HH.slot_ (Proxy :: Proxy "todoList") unit component unit 29 | 30 | type Context = Array Todo 31 | 32 | type State = Array Todo 33 | 34 | selectState :: Selector Store.Store Context 35 | selectState = selectEq \store -> case store.visibility.visibility of 36 | All -> 37 | store.todos.todos 38 | Completed -> 39 | Array.filter _.completed store.todos.todos 40 | Active -> 41 | Array.filter (not _.completed) store.todos.todos 42 | 43 | deriveState :: Connected Context Unit -> State 44 | deriveState { context: todos } = todos 45 | 46 | data Action 47 | = ToggleTodo Int 48 | | Receive (Connected Context Unit) 49 | 50 | component 51 | :: forall query output m 52 | . MonadStore Store.Action Store.Store m 53 | => H.Component query Unit output m 54 | component = connect selectState $ H.mkComponent 55 | { initialState: deriveState 56 | , render 57 | , eval: H.mkEval $ H.defaultEval 58 | { handleAction = handleAction 59 | , receive = Just <<< Receive 60 | } 61 | } 62 | where 63 | render todos = do 64 | let 65 | mkTodo todo = Tuple (show todo.id) do 66 | HH.li 67 | [ HE.onClick \_ -> ToggleTodo todo.id 68 | , HP.attr (HH.AttrName "style") do 69 | if todo.completed then 70 | "text-decoration: line-through;" 71 | else 72 | "text-decoration: none;" 73 | ] 74 | [ HH.text todo.text ] 75 | 76 | HK.ul_ (map mkTodo todos) 77 | 78 | handleAction = case _ of 79 | ToggleTodo id -> 80 | updateStore $ toggleTodo id 81 | Receive input -> 82 | H.put $ deriveState input 83 | -------------------------------------------------------------------------------- /src/Halogen/Store/Connect.purs: -------------------------------------------------------------------------------- 1 | module Halogen.Store.Connect 2 | ( Connected 3 | , connect 4 | , subscribe 5 | ) where 6 | 7 | import Prelude 8 | 9 | import Data.Maybe (Maybe(..)) 10 | import Effect.Class (class MonadEffect) 11 | import Halogen as H 12 | import Halogen.HTML as HH 13 | import Halogen.Store.Monad (class MonadStore, emitSelected, getStore) 14 | import Halogen.Store.Select (Selector(..)) 15 | import Type.Proxy (Proxy(..)) 16 | import Unsafe.Reference (unsafeRefEq) 17 | 18 | -- | The input type for connected components, containing the selected context 19 | -- | from the store and the component's ordinary Halogen input. 20 | type Connected context input = 21 | { context :: context 22 | , input :: input 23 | } 24 | 25 | data Action context input output 26 | = Initialize 27 | | Receive input 28 | | Update context 29 | | Raise output 30 | 31 | -- | Connect a component to part of the store using a `Selector`. The selected 32 | -- | state will be provided as part of the component's input. Any time the 33 | -- | selected state changes the component will be notified with new input. 34 | connect 35 | :: forall action store context query input output m 36 | . MonadEffect m 37 | => MonadStore action store m 38 | => Selector store context 39 | -> H.Component query (Connected context input) output m 40 | -> H.Component query input output m 41 | connect (Selector selector) component = 42 | H.mkComponent 43 | { initialState 44 | , render 45 | , eval: H.mkEval 46 | { handleAction 47 | , handleQuery: H.query (Proxy :: Proxy "inner") unit 48 | , initialize: Just Initialize 49 | , finalize: Nothing 50 | , receive: Just <<< Receive 51 | } 52 | } 53 | where 54 | initialState input = 55 | { context: Nothing 56 | , initialized: false 57 | , input 58 | } 59 | 60 | render state = case state.context of 61 | Just context -> 62 | -- This should be using `HH.lazy2`, but that's prevented by a bug: 63 | -- https://github.com/purescript-halogen/purescript-halogen/issues/748 64 | -- 65 | -- In the meantime, the equality checks have moved to the `Receive` and 66 | -- `Update` constructors. 67 | renderInner state.input context 68 | _ -> 69 | HH.text "" 70 | 71 | renderInner input context = 72 | HH.slot (Proxy :: Proxy "inner") unit component { input, context } Raise 73 | 74 | handleAction = case _ of 75 | Initialize -> do 76 | subscribe (Selector selector) Update 77 | context <- map selector.select getStore 78 | H.modify_ _ { context = Just context } 79 | 80 | Receive newInput -> do 81 | oldInput <- H.gets _.input 82 | unless (unsafeRefEq oldInput newInput) do 83 | H.modify_ _ { input = newInput } 84 | 85 | Update newContext -> 86 | H.gets _.context >>= case _ of 87 | Just oldContext | unsafeRefEq oldContext newContext -> pure unit 88 | _ -> H.modify_ _ { context = Just newContext } 89 | 90 | Raise output -> 91 | H.raise output 92 | 93 | -- | Subscribe to changes in the selected state by providing an action to run 94 | -- | any time the state updates. This can be used to connect components to the 95 | -- | store with more manual control than `connect` provides. 96 | subscribe 97 | :: forall storeAction store context state action slots output m 98 | . MonadStore storeAction store m 99 | => Selector store context 100 | -> (context -> action) 101 | -> H.HalogenM state action slots output m Unit 102 | subscribe selector action = do 103 | emitter <- emitSelected selector 104 | void $ H.subscribe $ map action emitter 105 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Halogen Store 2 | 3 | [![CI](https://github.com/thomashoneyman/purescript-halogen-store/workflows/CI/badge.svg?branch=main)](https://github.com/thomashoneyman/purescript-halogen-store/actions?query=workflow%3ACI+branch%3Amain) 4 | [![Latest release](http://img.shields.io/github/release/thomashoneyman/purescript-halogen-store.svg)](https://github.com/thomashoneyman/purescript-halogen-store/releases) 5 | [![Maintainer: thomashoneyman](https://img.shields.io/badge/maintainer-thomashoneyman-teal.svg)](http://github.com/thomashoneyman) 6 | 7 | Global state management for Halogen. For a Hooks-first state management library, please see [Helix](https://github.com/katsujukou/purescript-halogen-helix). 8 | 9 | ## Installation 10 | 11 | Install `halogen-store` with Spago: 12 | 13 | ```purs 14 | spago install halogen-store 15 | ``` 16 | 17 | ## Quick Start 18 | 19 | This library provides global state management for Halogen applications. A global or central state can help when many components need access to the same information, and threading those values through components via their inputs is either tedious or leads to an explosion of unnecessary fields in state. 20 | 21 | Writing applications with `halogen-store` comes down to three major steps, detailed in the next three sections: 22 | 23 | 1. [Creating the store](#creating-the-store) 24 | 2. [Using the store](#using-the-store) 25 | 3. [Running the application](#running-the-application) 26 | 27 | ### Creating the store 28 | 29 | First, we should create a central state for our application. This is called a "store" by convention. 30 | 31 | ```purs 32 | module Basic.Store where 33 | 34 | type Store = { count :: Int } 35 | 36 | initialStore :: Store 37 | initialStore = { count: 0 } 38 | ``` 39 | 40 | In the same module we'll create an action type that represents an update to our store. This action type is similar to the action type you define in each of your Halogen components. 41 | 42 | ```purs 43 | data Action = Increment | Decrement 44 | ``` 45 | 46 | Finally, we should create a reducer: a function of type `store -> action -> store` that updates our central state when it receives an action. It's somewhat similar to the `handleAction` function you define in your Halogen components, but it can't perform effects. 47 | 48 | ```purs 49 | reduce :: Store -> Action -> Store 50 | reduce store = case _ of 51 | Increment -> store { count = store.count + 1 } 52 | Decrement -> store { count = store.count - 1 } 53 | ``` 54 | 55 | If you need to perform effects before or after updating the central state, then you can do that in the Halogen component which is performing the update. 56 | 57 | As a brief aside: actions introduce some boilerplate to your application. If you want to stay bare-bones, then you can define your action type as a function `Store -> Store`, and then you can implement your reducer as function application: 58 | 59 | ```purs 60 | type Action = Store -> Store 61 | 62 | reduce :: Store -> Action -> Store 63 | reduce store k = k store 64 | ``` 65 | 66 | This lets you write arbitrary `store -> store` functions and send them to your central state. 67 | 68 | ### Using the store 69 | 70 | We can now use our store in our Halogen components. A component with access to the central store is called a "connected" component; a connected component can read, update, and subscribe to the store. 71 | 72 | A connected component requires a `MonadStore` constraint which specifies the store, action, and underlying monad types. We already defined our store and action types in the `Basic.Store` module, so we can reuse that in our component definition: 73 | 74 | ```purs 75 | import Basic.Store as BS 76 | import Halogen.Store.Monad (class MonadStore) 77 | 78 | component 79 | :: forall q i o m 80 | . MonadStore BS.Action BS.Store m 81 | => H.Component q i o m 82 | ``` 83 | 84 | The `MonadStore` class provides three methods: 85 | 86 | 1. `getStore` retrieves the current value of the store. 87 | 2. `updateStore` applies an action to the store to produce a new store, using our reducer. 88 | 3. `emitSelected` produces an `Emitter` from the `halogen-subscriptions` library that will notify subscribers of the store's new value when it changes. 89 | 90 | We can now use these methods anywhere we write `HalogenM` code -- for instance, in our `handleAction` function: 91 | 92 | ```purs 93 | import Basic.Store as BS 94 | import Halogen.Store.Monad (updateStore) 95 | 96 | handleAction = case _ of 97 | Clicked -> 98 | -- This will increment our central store's count. 99 | updateStore BS.Increment 100 | ``` 101 | 102 | In practice it's common to send actions to the store with `updateStore`, but it's somewhat rare to use `getStore` or `emitSelected`. That's because there's an easy way to subscribe a component to the store and always keep its state in sync with the central store: the `connect` function. 103 | 104 | A component that uses `connect` function will receive the central state as part of its component input. That means it can use the central state with `initialState` and stay subscribed to all future state updates via the receiver. This is the easiest way to stay in sync with the store over time. 105 | 106 | For example, the component below will receive the store's current value when it initializes and will receive the store's new value each time it changes: 107 | 108 | ```purs 109 | import Basic.Store as BS 110 | import Data.Maybe (Maybe(..)) 111 | import Halogen as H 112 | import Halogen.Store.Connect (Connected, connect) 113 | import Halogen.Store.Select (selectAll) 114 | 115 | type Input = Unit 116 | 117 | type State = { count :: Int } 118 | 119 | deriveState :: Connected BS.Store Input -> State 120 | deriveState { context, input } = { count: context.count } 121 | 122 | data Action 123 | = Receive (Connected BS.Store Input) 124 | 125 | component 126 | :: forall query input output m 127 | . MonadStore BS.Action BS.Store m 128 | => H.Component query input output m 129 | component = connect selectAll $ H.mkComponent 130 | { initialState: deriveState 131 | , render: \{ count } -> ... 132 | , eval: H.mkEval $ H.defaultEval 133 | { handleAction = handleAction 134 | , receive = Just <<< Receive 135 | } 136 | } 137 | where 138 | handleAction = case _ of 139 | Receive input -> 140 | H.put $ deriveState input 141 | ``` 142 | 143 | In the real world we can't afford to update every connected component any time the central state changes; this would be incredibly inefficient. Instead, we want to only updated connected components when the bit of state they are concerned with has changed. 144 | 145 | We can use a `Selector` to retrieve part of our central state and only be notified when the state we've selected has changed. In the previous example we used `selectAll` to just grab the entire store, but usually we'd write our own selector. 146 | 147 | Imagine that our store actually contained dozens of fields in addition to the `count` field we've implemented, but we only want to subscribe to that field. Let's do that by adjusting our component from the last section. 148 | 149 | ```purs 150 | import Halogen.Store.Select (Selector, selectEq) 151 | 152 | -- We are no longer connected to the entire store; we're only connected to 153 | -- the `count` field, which is of type `Int` for our new context. 154 | type Context = Int 155 | 156 | deriveState :: Connected Context Input -> State 157 | deriveState { context, input } = { count: context } 158 | 159 | selectCount :: Selector BS.Store Context 160 | selectCount = selectEq \store -> store.count 161 | 162 | data Action 163 | = Receive (Connected Context Input) 164 | 165 | component 166 | :: forall query input output m 167 | . MonadStore BS.Action BS.Store m 168 | => H.Component query input output m 169 | component = connect selectCount $ H.mkComponent 170 | { initialState: deriveState 171 | , ... 172 | } 173 | ``` 174 | 175 | Now, even if other fields in our state are regularly changing, this component will only receive new input when the `count` field has changed. 176 | 177 | ### Running the application 178 | 179 | When we run our application we'll need to satisfy our `MonadStore` constraints. Halogen components must always be run using the `Aff` monad, but our application needs to use a monad that supports `MonadStore`. 180 | 181 | To solve this issue, we can use the `StoreT` transformer as the monad for our application, and then use `runStoreT` to transform it into `Aff`. (You're also welcome to define your own application monad, though I'd recommend defining it in terms of `StoreT`.) 182 | 183 | We don't need to explicitly use `StoreT` in our component types; all we need to do is call `runStoreT` and supply an initial store, our reducer, and the component that requires the store. Let's see it in action: 184 | 185 | ```purs 186 | module Main where 187 | 188 | import Prelude 189 | 190 | import Basic.Counter as Counter 191 | import Basic.Store as BS 192 | import Effect (Effect) 193 | import Effect.Aff (launchAff_) 194 | import Halogen.Aff as HA 195 | import Halogen.Store.Monad (runStoreT) 196 | import Halogen.VDom.Driver (runUI) 197 | 198 | main :: Effect Unit 199 | main = launchAff_ do 200 | body <- HA.awaitBody 201 | root <- runStoreT BS.initialStore BS.reduce Counter.component 202 | runUI root unit body 203 | ``` 204 | 205 | ### Using `halogen-store` with `halogen-hooks` 206 | 207 | If you want to write your component with [Halogen Hooks](https://github.com/thomashoneyman/purescript-halogen-hooks) ,then you can use the `useSelector` hook to access the store. 208 | 209 | ```purs 210 | module Main where 211 | 212 | import Prelude 213 | 214 | import Halogen.Hooks as Hooks 215 | import Halogen.Store.Select (selectAll) 216 | import Halogen.Store.UseSelector (useSelector) 217 | 218 | component 219 | :: forall q i o m 220 | . MonadStore BS.Action BS.Store m 221 | => H.Component q i o m 222 | component = Hooks.component \_ _ -> Hooks.do 223 | context <- useSelector selectAll 224 | Hooks.pure do 225 | ... 226 | ``` 227 | 228 | Unlike `connect`, the context returned by `useSelector` has the type `Maybe store` because the hook does not have access to the store before it is initialized. 229 | -------------------------------------------------------------------------------- /src/Halogen/Store/Monad.purs: -------------------------------------------------------------------------------- 1 | module Halogen.Store.Monad where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Cont (class MonadCont, ContT) 6 | import Control.Monad.Error.Class (class MonadError, class MonadThrow) 7 | import Control.Monad.Except (ExceptT) 8 | import Control.Monad.Fork.Class (class MonadBracket, class MonadFork, class MonadKill, bracket, kill, never, uninterruptible) 9 | import Control.Monad.Identity.Trans (IdentityT) 10 | import Control.Monad.Maybe.Trans (MaybeT) 11 | import Control.Monad.RWS (RWST) 12 | import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT(..), ask, lift, local, mapReaderT, runReaderT) 13 | import Control.Monad.Rec.Class (class MonadRec) 14 | import Control.Monad.State (class MonadState, StateT) 15 | import Control.Monad.Trans.Class (class MonadTrans) 16 | import Control.Monad.Writer (class MonadTell, class MonadWriter, WriterT) 17 | import Data.Distributive (class Distributive) 18 | import Effect.Aff (Aff) 19 | import Effect.Aff.Class (class MonadAff) 20 | import Effect.Class (class MonadEffect, liftEffect) 21 | import Effect.Ref (Ref) 22 | import Effect.Ref as Ref 23 | import Halogen (HalogenM, hoist) 24 | import Halogen as H 25 | import Halogen.Hooks as Hooks 26 | import Halogen.Store.Select (Selector, selectEmitter) 27 | import Halogen.Subscription (Emitter, Listener) 28 | import Halogen.Subscription as HS 29 | 30 | -- | The `MonadStore` class captures monads which implement a stored value, 31 | -- | along with methods to get, update (via an action type, `a`), or subscribe 32 | -- | to changes in the stored value. 33 | -- | 34 | -- | An instance is provided for `StoreT`, which is the standard way to use 35 | -- | the `MonadStore` class. 36 | class MonadEffect m <= MonadStore a s m | m -> s a where 37 | getStore :: m s 38 | updateStore :: a -> m Unit 39 | emitSelected :: forall s'. Selector s s' -> m (Emitter s') 40 | 41 | type HalogenStore a s = 42 | { value :: Ref s 43 | , emitter :: Emitter s 44 | , listener :: Listener s 45 | , reducer :: s -> a -> s 46 | } 47 | 48 | -- | The `StoreT` monad transformer is the standard way to use the `MonadStore` 49 | -- | class. It extends the base monad with a global action `a` used to update 50 | -- | a global state `s`. 51 | -- | 52 | -- | The `MonadStore` type class describes the operations supported by this monad. 53 | newtype StoreT :: Type -> Type -> (Type -> Type) -> Type -> Type 54 | newtype StoreT a s m b = StoreT (ReaderT (HalogenStore a s) m b) 55 | 56 | derive newtype instance Functor m => Functor (StoreT a s m) 57 | derive newtype instance Apply m => Apply (StoreT a s m) 58 | derive newtype instance Applicative m => Applicative (StoreT a s m) 59 | derive newtype instance Bind m => Bind (StoreT a s m) 60 | derive newtype instance Monad m => Monad (StoreT a s m) 61 | derive newtype instance MonadEffect m => MonadEffect (StoreT a s m) 62 | derive newtype instance MonadAff m => MonadAff (StoreT a s m) 63 | derive newtype instance MonadThrow e m => MonadThrow e (StoreT a s m) 64 | derive newtype instance MonadError e m => MonadError e (StoreT a s m) 65 | derive newtype instance MonadTell w m => MonadTell w (StoreT a s m) 66 | derive newtype instance MonadWriter w m => MonadWriter w (StoreT a s m) 67 | derive newtype instance MonadState s m => MonadState s (StoreT a s m) 68 | derive newtype instance MonadCont m => MonadCont (StoreT a s m) 69 | derive newtype instance MonadRec m => MonadRec (StoreT a s m) 70 | derive newtype instance MonadFork f m => MonadFork f (StoreT a s m) 71 | 72 | -- Can't use generalized newtype deriving because it produces unverifiable 73 | -- superclass constraint warnings 74 | instance MonadKill e f m => MonadKill e f (StoreT a s m) where 75 | kill e = lift <<< kill e 76 | 77 | -- Can't use generalized newtype deriving because it produces unverifiable 78 | -- superclass constraint warnings 79 | instance MonadBracket e f m => MonadBracket e f (StoreT a s m) where 80 | bracket (StoreT acquire) release run = StoreT $ bracket 81 | acquire 82 | (\c a -> case release c a of StoreT r -> r) 83 | (\a -> case run a of StoreT r -> r) 84 | uninterruptible (StoreT r) = StoreT $ uninterruptible r 85 | never = lift never 86 | 87 | derive newtype instance Distributive g => Distributive (StoreT a s g) 88 | derive newtype instance MonadTrans (StoreT a s) 89 | 90 | instance MonadAsk r m => MonadAsk r (StoreT a s m) where 91 | ask = lift ask 92 | 93 | instance MonadReader r m => MonadReader r (StoreT a s m) where 94 | local f (StoreT (ReaderT r)) = StoreT $ ReaderT $ local f <<< r 95 | 96 | instance MonadEffect m => MonadStore a s (StoreT a s m) where 97 | getStore = StoreT do 98 | store <- ask 99 | liftEffect do 100 | Ref.read store.value 101 | 102 | updateStore action = StoreT do 103 | store <- ask 104 | liftEffect do 105 | current <- Ref.read store.value 106 | let newStore = store.reducer current action 107 | Ref.write newStore store.value 108 | HS.notify store.listener newStore 109 | 110 | emitSelected selector = 111 | StoreT $ ReaderT $ pure <<< selectEmitter selector <<< _.emitter 112 | 113 | instance monadStoreHalogenM :: MonadStore a s m => MonadStore a s (HalogenM st act slots out m) where 114 | getStore = lift getStore 115 | updateStore = lift <<< updateStore 116 | emitSelected = lift <<< emitSelected 117 | 118 | instance monadStoreHookM :: MonadStore a s m => MonadStore a s (Hooks.HookM m) where 119 | getStore = lift getStore 120 | updateStore = lift <<< updateStore 121 | emitSelected = lift <<< emitSelected 122 | 123 | instance MonadStore a s m => MonadStore a s (ContT r m) where 124 | getStore = lift getStore 125 | updateStore = lift <<< updateStore 126 | emitSelected = lift <<< emitSelected 127 | 128 | instance MonadStore a s m => MonadStore a s (ExceptT e m) where 129 | getStore = lift getStore 130 | updateStore = lift <<< updateStore 131 | emitSelected = lift <<< emitSelected 132 | 133 | instance MonadStore a s m => MonadStore a s (IdentityT m) where 134 | getStore = lift getStore 135 | updateStore = lift <<< updateStore 136 | emitSelected = lift <<< emitSelected 137 | 138 | instance MonadStore a s m => MonadStore a s (MaybeT m) where 139 | getStore = lift getStore 140 | updateStore = lift <<< updateStore 141 | emitSelected = lift <<< emitSelected 142 | 143 | instance (MonadStore a s m, Monoid w) => MonadStore a s (RWST r w s m) where 144 | getStore = lift getStore 145 | updateStore = lift <<< updateStore 146 | emitSelected = lift <<< emitSelected 147 | 148 | instance MonadStore a s m => MonadStore a s (ReaderT r m) where 149 | getStore = lift getStore 150 | updateStore = lift <<< updateStore 151 | emitSelected = lift <<< emitSelected 152 | 153 | instance MonadStore a s m => MonadStore a s (StateT s m) where 154 | getStore = lift getStore 155 | updateStore = lift <<< updateStore 156 | emitSelected = lift <<< emitSelected 157 | 158 | instance (MonadStore a s m, Monoid w) => MonadStore a s (WriterT w m) where 159 | getStore = lift getStore 160 | updateStore = lift <<< updateStore 161 | emitSelected = lift <<< emitSelected 162 | 163 | -- | Run a component in the `StoreT` monad. 164 | -- | 165 | -- | Requires an initial value for the store, `s`, and a reducer that updates 166 | -- | the store in response to an action, `a`. 167 | -- | 168 | -- | This can be used directly on the root component of your application to 169 | -- | produce a component that Halogen can run, so long as the base monad can 170 | -- | be fixed to `Aff`. 171 | -- | 172 | -- | ```purs 173 | -- | main = launchAff_ do 174 | -- | body <- Halogen.Aff.awaitBody 175 | -- | root <- runStoreT initialStore reducer rootComponent 176 | -- | runUI root unit body 177 | -- | ``` 178 | runStoreT 179 | :: forall a s q i o m 180 | . Monad m 181 | => s 182 | -> (s -> a -> s) 183 | -> H.Component q i o (StoreT a s m) 184 | -> Aff (H.Component q i o m) 185 | runStoreT initialStore reducer component = 186 | _.component <$> runAndEmitStoreT initialStore reducer component 187 | 188 | -- | Run a component in the `StoreT` monad. 189 | -- | 190 | -- | Requires an initial value for the store, `s`, and a reducer that updates 191 | -- | the store in response to an action, `a`. 192 | -- | 193 | -- | This can be used directly on the root component of your application to 194 | -- | produce a component that Halogen can run, so long as the base monad can 195 | -- | be fixed to `Aff`. 196 | -- | 197 | -- | Returns a component that can be run with `runUI` and an emitter with can 198 | -- | be used to react to store changes. This can be used, for example, to 199 | -- | persist parts of the store to local storage or some other persistence 200 | -- | mechanism, allowing you to push these concerns to the boundaries of the 201 | -- | application, outside of the component. 202 | -- | 203 | -- | ```purs 204 | -- | main = do 205 | -- | -- load initial store values from local storage. 206 | -- | field <- LocalStorage.getItem "field" 207 | -- | let initialStore = mkStore field 208 | -- | launchAff_ do 209 | -- | body <- Halogen.Aff.awaitBody 210 | -- | { emitter, component } <- runAndEmitStoreT initialStore reducer rootComponent 211 | -- | runUI component unit body 212 | -- | let selectField = selectEq _.field 213 | -- | liftEffect do 214 | -- | -- save new store values to local storage as they change 215 | -- | void $ H.subscribe $ selectEmitter selectField emitter $ LocalStorage.setItem "field" 216 | -- | ``` 217 | runAndEmitStoreT 218 | :: forall a s q i o m 219 | . Monad m 220 | => s 221 | -> (s -> a -> s) 222 | -> H.Component q i o (StoreT a s m) 223 | -> Aff ({ emitter :: Emitter s, component :: H.Component q i o m }) 224 | runAndEmitStoreT initialStore reducer component = do 225 | hs <- liftEffect do 226 | value <- Ref.new initialStore 227 | { emitter, listener } <- HS.create 228 | pure { value, emitter, listener, reducer } 229 | pure 230 | { emitter: hs.emitter 231 | , component: hoist (\(StoreT m) -> runReaderT m hs) component 232 | } 233 | 234 | -- | Change the type of the result in a `StoreT` monad. 235 | mapStoreT :: forall a s m1 m2 b c. (m1 b -> m2 c) -> StoreT a s m1 b -> StoreT a s m2 c 236 | mapStoreT f (StoreT m) = StoreT (mapReaderT f m) 237 | --------------------------------------------------------------------------------