├── .github ├── CONTRIBUTING.md ├── FUNDING.yml └── workflows │ └── ci.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── docs ├── 01-Hooks-At-A-Glance.md ├── 02-State-Hook.md ├── 03-Effect-Hook.md ├── 04-Query-Hook.md ├── 05-HookM.md ├── 06-Writing-Hooks.md ├── 07-Hooks-API.md ├── 08-Hooks-FAQ.md ├── 09-Hooks-Internals.md └── README.md ├── examples ├── Example │ ├── Halogen │ │ ├── Basic │ │ │ └── Button.purs │ │ ├── Components │ │ │ ├── Button.purs │ │ │ └── Container.purs │ │ ├── ComponentsInputs │ │ │ ├── Container.purs │ │ │ └── Display.purs │ │ ├── Effects │ │ │ └── Random.purs │ │ └── InputRef │ │ │ └── Component.purs │ ├── Hooks │ │ ├── Components.purs │ │ ├── UseDebouncer.purs │ │ ├── UseInitializer.purs │ │ ├── UseLocalStorage.purs │ │ ├── UsePrevious.purs │ │ ├── UseStateFn.purs │ │ └── UseWindowWidth.purs │ └── Main.purs ├── README.md ├── Storybook.css ├── examples.dhall └── index.html ├── flake.lock ├── flake.nix ├── package-lock.json ├── package.json ├── packages.dhall ├── spago.dhall ├── src └── Halogen │ ├── Hooks.purs │ └── Hooks │ ├── Component.purs │ ├── Hook.purs │ ├── HookM.purs │ ├── Internal │ ├── Eval.purs │ ├── Eval │ │ └── Types.purs │ ├── Types.js │ ├── Types.purs │ └── UseHookF.purs │ └── Types.purs └── test ├── Performance ├── Main.purs ├── Setup │ ├── Measure.purs │ ├── Puppeteer.js │ └── Puppeteer.purs ├── Snapshot.purs ├── Snapshot │ ├── StateTest.js │ ├── StateTest.purs │ ├── TodoTest.js │ ├── TodoTest.purs │ └── Write.purs └── Test │ ├── App.purs │ ├── State │ ├── Component.purs │ ├── Hook.purs │ ├── README.md │ └── Shared.purs │ ├── Todo │ ├── Component.purs │ ├── Hook.purs │ ├── README.md │ └── Shared.purs │ └── Types.purs ├── README.md ├── Test ├── Hooks │ ├── Spec.purs │ ├── UseLifecycleEffect.purs │ ├── UseMemo.purs │ ├── UseRef.purs │ ├── UseState.purs │ └── UseTickEffect.purs ├── Integration │ ├── Issue5.purs │ ├── Issue73.purs │ └── Spec.purs ├── Main.purs └── Setup │ ├── Eval.purs │ ├── Log.purs │ └── Types.purs ├── run-snapshot.mjs ├── run-test.mjs ├── test.dhall ├── test.html └── test.performance.dhall /.github/CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contribution 2 | 3 | Thank you for your interest in contributing to Halogen Hooks! This is a short, sweet introduction to help you get started contributing. 4 | 5 | ## Getting Started 6 | 7 | ### Do I belong here? 8 | 9 | Everyone is welcome! People of all experience levels can join, begin contributing, and feel comfortable and safe making mistakes. People of all backgrounds belong here so long as they treat others with dignity and respect and do not harass or belittel others. 10 | 11 | ### What is the correct way to ask a question? 12 | 13 | Feel free to ask questions by opening an issue on the relevant library. Maintainers are also active on: 14 | 15 | - The [PureScript Discourse](https://discourse.purescript.org) (the most popular option and best for detailed questions) 16 | - The [PureScript Discord server](https://purescript.org/chat) (best for quick, informal questions) 17 | 18 | ### I'd like to help, how do I pick something to work on? 19 | 20 | Any open issue that is not yet assigned to someone is good to work on! If it's your first time contributing it's probably best to pick an issue marked `good first issue`. In general: 21 | 22 | 1. Issues marked `good first issue` are good for beginners and/or new contributors to the library. 23 | 2. Issues marked `help wanted` signal that anyone can take the issue and it's a desired addition to the library. 24 | 3. Issues marked `document me` are requests for documentation and are often a great first issue to take on. 25 | 26 | The easiest way you can help is by contributing documentation, whether via looking for issues marked `document me` or by adding new documentation of your own. If you'd like to contribute documentation I suggest [reading about the four kinds of documentation](https://documentation.divio.com). 27 | 28 | ### How big should my contribution be? 29 | 30 | Your contribution can be as small as copypasting instructions from an issue into the project documentation! Everything is welcome, including very small changes and quality of life improvements. 31 | 32 | In general, pull requests which improve the performance and ergonomics of the library are welcome, but I am unlikely to expand the core API or merge additions which I believe make the library more complicated to use. If you would like to contribute a particularly large or a breaking change, you may want to open an issue proposing the change before you implement it. That helps me ensure your time is not wasted. 33 | 34 | ## Contributing Code 35 | 36 | ### Developer Environments 37 | 38 | If you would like to contribute code to Halogen Hooks, you can enter a development environment with common PureScript tooling available at the same versions I use via Nix. Just run this command in the root of the project: 39 | 40 | ```sh 41 | nix-shell 42 | ``` 43 | 44 | You will also need to install development dependencies from the `package.json` file if you are working on the tests. That file also contains scripts helpful for building tests and examples. 45 | 46 | ### Proposing changes 47 | 48 | If you would like to contribute code, tests, or documentation, please feel free to open a pull request for small changes. For large changes we recommend you first open an issue to propose your change. 49 | -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: [ thomashoneyman ] 4 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [main] 6 | pull_request: 7 | branches: [main] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | 13 | steps: 14 | - uses: actions/checkout@v2 15 | 16 | - uses: purescript-contrib/setup-purescript@main 17 | 18 | - name: Cache PureScript dependencies 19 | uses: actions/cache@v2 20 | with: 21 | key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }} 22 | path: | 23 | .spago 24 | output 25 | 26 | - uses: actions/setup-node@v1 27 | with: 28 | node-version: "12.x" 29 | 30 | - name: Cache node modules 31 | uses: actions/cache@v2 32 | env: 33 | cache-name: cache-node-modules 34 | with: 35 | # npm cache files are stored in `~/.npm` on Linux/macOS 36 | path: ~/.npm 37 | key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/package-lock.json') }} 38 | restore-keys: | 39 | ${{ runner.os }}-build-${{ env.cache-name }}- 40 | ${{ runner.os }}-build- 41 | ${{ runner.os }}- 42 | 43 | - name: Install test dependencies 44 | run: npm ci 45 | 46 | - name: Build source 47 | run: npm run build 48 | 49 | - name: Build examples 50 | run: npm run build:examples 51 | 52 | - name: Build tests 53 | run: npm run build:test 54 | 55 | - name: Run tests 56 | run: npm run test 57 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .* 2 | !.gitignore 3 | !.github 4 | !.editorconfig 5 | !.purs.json 6 | 7 | # Dependencies 8 | bower_components 9 | node_modules 10 | 11 | # Generated files 12 | output 13 | output-es 14 | generated-docs 15 | test-results 16 | 17 | # Lockfiles 18 | *.lock 19 | 20 | # Extra files 21 | examples/app.js 22 | test/test.js 23 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | Notable changes to Hooks are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). 4 | 5 | ## [Unreleased] 6 | 7 | Breaking changes (😱!!!): 8 | 9 | New features: 10 | 11 | Bugfixes: 12 | 13 | Other improvements: 14 | 15 | ## [0.6.0] - 2022-05-02 16 | 17 | Breaking changes (😱!!!): 18 | 19 | - **Add support for PureScript 0.15 and Halogen 7, dropping support for previous versions of the compiler and Halogen.** (#74 by @CarstenKoenig) 20 | This is a breaking change because of the upgrade in dependencies only. The code continues to work as-is. 21 | 22 | ## [0.5.0] - 2021-03-15 23 | 24 | Breaking changes (😱!!!): 25 | 26 | - **Add support for PureScript 0.14 and Halogen 6, dropping support for previous versions of the compiler and Halogen.** (#71 by @CarstenKoenig, #72 by @thomashoneyman) 27 | 28 | - **Move to a single index for hook types.** (#32 by @thomashoneyman) 29 | 30 | Using a single index for Hook types simplifies the Hooks implementation and makes defining your own Hooks easier and less confusing. It also allows the library to drop its dependency on `indexed-monad`. 31 | 32 | Previously, Hooks were defined as an indexed monad with parameters to track the before and after state of a Hook bind: 33 | 34 | ```purs 35 | -- Old approach 36 | type Hook m (newHooks :: Type -> Type) a = 37 | forall hooks. Hooked m hooks (newHooks hooks) a 38 | 39 | newtype Hooked m hooks newHooks a = 40 | Hooked (Indexed (Free (UseHookF m)) hooks newHooks a) 41 | 42 | bind 43 | :: forall a b x y z m 44 | . Hooked m hooks hooks' a 45 | -> (a -> Hooked m hooks' newHooks b) 46 | -> Hooked m hooks newHooks b 47 | ``` 48 | 49 | Now, Hooks are defined with a custom `HookType` and each bind produces a new, single index made up of all the hook types in use. 50 | 51 | ```purs 52 | -- New approach 53 | data HookType 54 | 55 | newtype Hook m (h :: HookType) a = Hook (Free (UseHookF m) a) 56 | 57 | foreign import data Hooked :: HookType -> HookType -> HookType 58 | infixr 1 type Hooked as <> 59 | 60 | bind 61 | :: forall h h' m a b 62 | . Hook m h a 63 | -> (a -> Hook m h' b) 64 | -> Hook m (h <> h') b 65 | ``` 66 | 67 | This is a breaking change because it changes how you define your Hook types in Halogen Hooks. First, Hooks are now written in the order they occur. 68 | 69 | ```purs 70 | -- Assume UseState, then UseEffect, then UseRef in the code 71 | 72 | -- Previously: this reads backwards, as state transitions 'away from' the 73 | -- hooks type variable 74 | UseRef Int 75 | (UseEffect 76 | (UseState Int hooks)) 77 | 78 | -- Now: this reads in the order hooks are applied in the code, where 79 | -- `Pure` represents the call to `pure` 80 | UseState Int 81 | <> UseEffect 82 | <> UseRef Int 83 | <> Hooks.Pure 84 | ``` 85 | 86 | Second, you no longer use a newtype to define Hooks. Instead, you'll foreign import a data type to represent your Hook type and use the `HookNewtype` type class. 87 | 88 | ```purs 89 | -- Before 90 | type UseX' hooks = UseState Int (UseEffect hooks) 91 | 92 | newtype UseX hooks = UseX (UseX' hooks) 93 | 94 | derive instance newtypeUseX :: Newtype (UseX hooks) _ 95 | 96 | -- After 97 | type UseX' = UseEffect <> UseState Int <> Hooks.Pure 98 | 99 | foreign import data UseX :: Hooks.HookType 100 | 101 | instance newtypeUseX :: HookNewtype UseX UseX' 102 | ``` 103 | 104 | New features: 105 | 106 | Bugfixes: 107 | 108 | Other improvements: 109 | 110 | - Docs: Added technical documentation that covers the main concepts used in the internal implementation (#59 by @thomashoneyman). 111 | - Docs: Added a changelog to record changes to the library over time (#62 by @thomashoneyman). 112 | - Tests: Added performance tests to measure the performance impact of changes (#53 by @thomashoneyman, #56 by @thomashoneyman). 113 | - Updated the Nix shell to use PureScript 0.14 tooling 114 | 115 | ## [0.4.3] - 2020-06-17 116 | 117 | This release ensures that state-modifying `HookM` code can't be passed from one component to another without throwing an immediate exception. `HookM` code that modifies state which is written in one component must be evaluated in that component. 118 | 119 | Bugfixes: 120 | 121 | - Throw exception if state-modifying `HookM` code passed between components ([#44](https://github.com/thomashoneyman/purescript-halogen-hooks/pull/44)). 122 | 123 | Other improvements: 124 | 125 | - Updates Spago package set and generated Bowerfile 126 | 127 | ## [0.4.1] - 2020-06-04 128 | 129 | This release updates module exports. 130 | 131 | Bugfixes: 132 | 133 | - Re-export `memoComponent` from the main `Hooks` module ([#43](https://github.com/thomashoneyman/purescript-halogen-hooks/pull/43)). 134 | 135 | ## [0.4.1] - 2020-05-18 136 | 137 | This release includes small internal performance improvements. 138 | 139 | Improvements: 140 | 141 | - Use `substFree` instead of `foldFree` internally ([#33](https://github.com/thomashoneyman/purescript-halogen-hooks/pull/33)). 142 | Using `foldFree` is convenient, but it incurs some overhead due to a `MonadRec` constraint on the monad you interpret into. Switching to `substFree` eliminates this overhead, giving the library a modest performance improvement. 143 | 144 | ## [0.4.0] - 2020-05-14 145 | 146 | This release changes how users update state in Hooks. 147 | 148 | Breaking changes (😱!!!): 149 | 150 | - **Return to state identifiers instead of returning just a modify function ([#31](https://github.com/thomashoneyman/purescript-halogen-hooks/pull/31)).** 151 | 152 | The previous release replaced state tokens with a simply `modify` function returned by the `useState` hook. For a variety of reasons this turned out to be not a change worth making, and it has now been reverted. See #30 for more details on why this happened. 153 | 154 | If you liked using a modify function instead of a token, you can still do that: 155 | 156 | ```purs 157 | state /\ modifyState <- map Hooks.modify_ <$> Hooks.useState 0 158 | let handleClick = modifyState (_ + 1) 159 | Hooks.pure ... 160 | ``` 161 | 162 | ## [0.3.0] - 2020-05-07 163 | 164 | This release changes how users update state in Hooks. 165 | 166 | Breaking changes (😱!!!): 167 | 168 | - **Replace state tokens with a modify function ([#29](https://github.com/thomashoneyman/purescript-halogen-hooks/pull/29)).** 169 | 170 | The previous versions of Hooks returned a state token from the `useState` hook, which could then be passed to the `put`, `modify`, `modify_`, and `get` functions we're all used to from HalogenM. Now, the `useState` hook returns a modify function directly which can be used to update the state. See #29 for more details on why this matters. 171 | 172 | This code from v0.2.1: 173 | 174 | ```purs 175 | state /\ stateToken <- Hooks.useState 0 176 | let handleClick = Hooks.modify_ stateToken (_ + 1) 177 | Hooks.pure ... 178 | ``` 179 | 180 | Would now be written like this: 181 | 182 | ```purs 183 | state /\ modifyState <- Hooks.useState 0 184 | let handleClick = modifyState (_ + 1) 185 | Hooks.pure ... 186 | ``` 187 | 188 | Now that there isn't a `get` function, if you need to get the most up-to-date state in an asynchronous function, you should copy the relevant part of state to a mutable reference so the function can read the reference during its execution. This is the same pattern you should use if you need to do the same with component input. #29 also introduces a `useGet` example Hook which makes this easy and convenient. 189 | 190 | ## [0.2.0] - 2020-04-30 191 | 192 | This release fixes several bugs and changes some types used in the Halogen Hooks library. 193 | 194 | Breaking changes (😱!!!): 195 | 196 | - **Introduce tokens for all component-only features, not just queries ([#22](https://github.com/thomashoneyman/purescript-halogen-hooks/pull/22)).** 197 | 198 | Hooks support writing functions for stateful logic, which are then interpreted by a Halogen component. However, some component features do not make sense in the context of Hooks alone (queries, slot types, and output messages). 199 | 200 | The first version of Hooks made queries available in a Hook only via a query 'token', which was provided by the `componentWithQuery` function. This approach has been extended to slot types and output messages as well. With this change Hook types no longer carry around slot or output types, which cleans up type signatures for the vast majority of cases, but they are still able to support child components and sending messages once used with the `component` function. 201 | 202 | This includes several breaking changes, all of which are simple to adjust to the new version (no features have been removed). In summary, any Hook types that previously accepted a slot and output type will no longer have them, and any Hook functions that use these types will now use a token as their first argument. Here's the full list of changes: 203 | 204 | - `Hook ps o m hooks a` is now `Hook m hooks a` 205 | - `Hooked ps o m hooksPre hooksPost a` is now `Hooked m hooksPre hooksPost a` 206 | - `HookM ps o m a` is now `HookM m a` 207 | - The `component` function has been updated to take as its first argument a record containing the query token, slot token, and output token that can be used to enable component features in a Hook. Any usage of `component \input -> ...` can be replaced with `component \_ input -> ...`. 208 | - The `componentWithQuery` function has been removed, as it is now covered by `component`. Any usage of `componentWithQuery \queryToken _ -> ...` can be replaced by `component \{ queryToken } _ -> ...`. 209 | - The `HookM` function `raise` now takes as its first argument an `OutputToken`. Any use of `Hooks.raise output` can be replaced by `component \{ outputToken } _ -> ... Hooks.raise outputToken output`. 210 | - The `HookM` functions `query` and `queryAll` now take as their first argument a `SlotToken`. Any use of `Hooks.query ...` can be replaced by `component \{ slotToken } _ -> ... Hooks.query slotToken ...`. 211 | 212 | Bugfixes: 213 | 214 | - Memo values could get out of sync with their indices in state ([#11](https://github.com/thomashoneyman/purescript-halogen-hooks/pull/11)). 215 | - Effect cleanup for useTickEffect would not run until the component finalized, running all cleanup functions together at the end ([#12](https://github.com/thomashoneyman/purescript-halogen-hooks/pull/12)). 216 | - State changes triggered by effects would not cause hooks to be re-evaluated ([#20](https://github.com/thomashoneyman/purescript-halogen-hooks/pull/20)). 217 | 218 | Other improvements: 219 | 220 | - Tests: add automated tests for Hooks ([#19](https://github.com/thomashoneyman/purescript-halogen-hooks/pull/19)). 221 | - Tests: add continuous integration to the repository via GitHub Actions. 222 | - Docs: update the documentation to make it clear when getting state vs. using the state from `useState` is necessary ([#7](https://github.com/thomashoneyman/purescript-halogen-hooks/pull/17)). 223 | - Docs: update all public documentation to use new types and remove mention of `componentWithQuery`. 224 | 225 | ## [0.1.0] - 2020-04-30 226 | 227 | Initial release of the Halogen Hooks library. 228 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Halogen Hooks 2 | 3 | [![CI](https://github.com/thomashoneyman/purescript-halogen-hooks/workflows/CI/badge.svg?branch=main)](https://github.com/thomashoneyman/purescript-halogen-hooks/actions?query=workflow%3ACI+branch%3Amain) 4 | [![Latest release](http://img.shields.io/github/release/thomashoneyman/purescript-halogen-hooks.svg)](https://github.com/thomashoneyman/purescript-halogen-hooks/releases) 5 | 6 | Reusable stateful logic for [Halogen](https://github.com/purescript-halogen/purescript-halogen/), inspired by [React Hooks](https://reactjs.org/docs/hooks-intro.html). 7 | 8 | Hooks offer a simpler mental model for writing stateful code in Halogen. They are a better alternative to higher-order and renderless components and offer a more convenient way to write most ordinary components. They can be incrementally adopted and require no changes to existing components in your application. 9 | 10 | > **Note:** Hooks can be used in production code today, but Hooks are not as performant as regular Halogen components. A Hooks-based component is typically 1.5x slower and uses 1.75x the memory of an equivalent Halogen component. In most use cases this performance difference is not noticeable, but keep this in mind if you are using Hooks in a large, performance-sensitive application. Please feel free to contribute performance improvements! 11 | 12 | Learn more about Hooks: 13 | 14 | 1. [Read the blog post introducing Halogen Hooks](https://thomashoneyman.com/articles/introducing-halogen-hooks) 15 | 2. [Read the Halogen Hooks documentation](./docs) 16 | 3. [View the component and custom hook examples](./examples) 17 | 4. [View the Hooks recipes in the PureScript Cookbook](https://github.com/JordanMartinez/purescript-cookbook) 18 | 19 | ## Installation 20 | 21 | You can install Halogen Hooks with Spago: 22 | 23 | ```sh 24 | spago install halogen-hooks 25 | ``` 26 | 27 | If Halogen Hooks is not available in your package set, add it to your project's `packages.dhall` file: 28 | 29 | ```dhall 30 | let additions = 31 | { halogen-hooks = 32 | { dependencies = [ "halogen" ] 33 | , repo = "https://github.com/thomashoneyman/purescript-halogen-hooks.git" 34 | , version = "main" 35 | } 36 | } 37 | ``` 38 | 39 | ## Quick start 40 | 41 | All types and functions available in Hooks are exported from the `Halogen.Hooks` module, so you can access the entirety of Hooks with one import: 42 | 43 | ```purs 44 | import Halogen.Hooks as Hooks 45 | ``` 46 | 47 | Halogen Hooks ensures Hooks are always evaluated in the same order. For that reason you should use `do`, `bind`, and `pure` as qualified imports from the `Halogen.Hooks` module. You will see compile-time errors if you forget! 48 | 49 | This code replicates the Halogen basic button example which renders a count that is incremented on click: 50 | 51 | ```purs 52 | myComponent = Hooks.component \_ input -> Hooks.do 53 | count /\ countId <- Hooks.useState 0 54 | 55 | Hooks.pure do 56 | HH.button 57 | [ HE.onClick \_ -> Hooks.modify_ countId (_ + 1) ] 58 | [ HH.text $ show count ] 59 | ``` 60 | 61 | ## Documentation 62 | 63 | There are several resources to help you learn about Hooks: 64 | 65 | - **Introducing Hooks** 66 | 67 | The [blog post which introduces Halogen Hooks](https://thomashoneyman.com/articles/introducing-halogen-hooks) helps you understand what Hooks are, why they're important, and how to use them. 68 | 69 | - **The Hooks Documentation** 70 | 71 | The [documentation directory](./docs) in this repository contains a deep dive into Hooks and how to use them, including an API reference for each hook and a FAQ (feel free to open an issue if you have questions of your own you'd like answered). 72 | 73 | - **Hooks Examples** 74 | 75 | The [Hooks examples directory](./examples) in this repository replicates a number of example components from the official Halogen repository and demonstrates several custom Hooks you could write for yourself. Feel free to use these in your own code! 76 | 77 | ## Contributing 78 | 79 | You can contribute to Halogen Hooks in many ways: 80 | 81 | - If you encounter an issue or have a question, please open an issue on the repository and I will work with you to resolve or answer it. 82 | 83 | - If you have suggestions for the documentation, please open an issue or pull request. 84 | 85 | - If you would like to contribute code to the library, please make sure to read the [Hooks Internals](./docs/09-Hooks-Internals.md) documentation and the [Contributors Guidelines](./.github/CONTRIBUTING.md), which includes advice on setting up your development environment. 86 | 87 | - If you have written a custom hook, a tutorial, or another resource on top of Halogen Hooks I encourage you to share it on the [PureScript Discourse](https://discourse.purescript.org)! Implementing your own hooks and writing your own guides and resources are a great way to help Halogen Hooks grow. 88 | -------------------------------------------------------------------------------- /docs/01-Hooks-At-A-Glance.md: -------------------------------------------------------------------------------- 1 | # Hooks at a Glance 2 | 3 | Hooks are a new library for Halogen. This page provides an overview of using Hooks for experienced Halogen users. If you haven't read it yet, you should [read Introducing Halogen Hooks](https://thomashoneyman.com/articles/introducing-halogen-hooks) to understand the motivation for Hooks. You may also be interested in the Hooks recipes in the [PureScript Cookbook](https://github.com/JordanMartinez/purescript-cookbook) to see some common tasks implemented with Hooks. 4 | 5 | This is a fast-paced overview. If you're new to Halogen you should take time to get familiar with essential Halogen concepts like input, state, and `HalogenM` before you read this. 6 | 7 | ## No Breaking Changes 8 | 9 | One more thing: before we move on, I'd like to note that Hooks are: 10 | 11 | - **Built on Halogen**. Hooks are implemented on top of Halogen, with no breaking changes to the underlying library. 12 | - **Incrementaly adoptable**. You can begin using Halogen Hooks in a few components without rewriting existing code. You can adopt Hooks as quickly or as slowly, as completely or as piecemeal as you would like. 13 | - **Compatible with components**. Halogen is based on components, and components are here to stay. Hooks are a more convenient way to define stateful logic in your applications, and they are sufficient to define components as well, but they don't remove the need for components. 14 | 15 | Hooks provide a more direct API to the Halogen concepts you already know: input, state, queries, lifecycles, and side effects. Hooks are also a more flexible way to combine these features without boilerplate. 16 | 17 | ## The State Hook 18 | 19 | This example renders a counter. When you click the button, it increments the value: 20 | 21 | ```purs 22 | import Data.Tuple.Nested ((/\)) 23 | import Halogen.HTML as HH 24 | import Halogen.HTML.Events as HE 25 | import Halogen.Hooks as Hooks 26 | 27 | example = Hooks.component \_ _ -> Hooks.do 28 | -- Declare a new state variable, which we'll call "count" 29 | count /\ countId <- Hooks.useState 0 30 | 31 | Hooks.pure do 32 | HH.div_ 33 | [ HH.p_ [ HH.text $ "You clicked " <> show count <> " times" ] 34 | , HH.button 35 | [ HE.onClick \_ -> Hooks.modify_ countId (_ + 1) ] 36 | [ HH.text "Click me" ] 37 | ] 38 | ``` 39 | 40 | `useState` is a Hook. We call it inside a Hooks function to add some local state to it. Halogen will preserve this state between re-renders. `useState` returns a tuple: the _current_ state value and a unique identifier you can use with state update functions including `get`, `put`, `modify_`, and `modify`. 41 | 42 | The update function runs in the `HookM` monad, which is also the action type that all HTML functions in Hooks use. That means you can use this update function directly in your HTML, or combine it with any other `HookM` code. We'll see how to use this monad later in this page, but it also has [its own documentation section](./05-HookM.md) if you're ready for a deep dive. 43 | 44 | The `useState` hook requires an initial state as its only argument. In this example, the initial state starts our counter at `0`. The initial state argument is only used on the first render. 45 | 46 | ### Declaring multiple states 47 | 48 | You can use the State Hook more than once in a single component: 49 | 50 | ```purs 51 | manyStates = Hooks.do 52 | -- Declare multiple state variables! 53 | age /\ ageId <- Hooks.useState 42 54 | fruit /\ fruitId <- Hooks.useState "banana" 55 | todos /\ todosId <- Hooks.useState [ { text: "Learn Hooks" } ] 56 | -- ... 57 | ``` 58 | 59 | We're destructuring the tuple that `useState` returns using the tuple operator `(/\)`, which allows us to name our state value and identifier whatever we want. 60 | 61 | ### Using a modify function instead of an identifier 62 | 63 | If you prefer your `useState` Hook to return a modify function directly, instead of an identifier, you can use the `Functor` instance for Hooks to apply a state function to the identifier returned by the hook as seen in the example below (`useStateFn`, as well as variants like `useModifyState`, are available in the [halogen-hooks-extra](https://github.com/JordanMartinez/purescript-halogen-hooks-extra) package). 64 | 65 | ```purs 66 | -- You can provide any of the Hooks state functions to this function. 67 | useStateFn :: forall s m a. (StateId s -> a) -> s -> Hook m (UseState s) (s /\ a) 68 | useStateFn fn initial = map (map fn) (Hooks.useState initial) 69 | 70 | manyStates = Hooks.do 71 | -- Return a modify function instead of an identifier! 72 | age /\ modifyAge <- useStateFn Hooks.modify_ 42 73 | fruit /\ setFruit <- useStateFn Hooks.put "banana" 74 | 75 | let 76 | handler :: HookM _ Unit 77 | handler = do 78 | -- instead of Hooks.modify_ ageId \n -> n + 10 79 | modifyAge \n -> n + 10 80 | -- instead of Hooks.put fruitId "strawberry" 81 | setFruit "strawberry" 82 | ``` 83 | 84 | ### What is a Hook? 85 | 86 | Hooks are functions that let you "hook into" Halogen state and lifecycle features without a component. Hooks ultimately must be run by a component; Halogen has no concept of Hooks built in to the library. You can turn a Hook which returns `ComponentHTML` (as our examples so far have done) into a component using the `Hooks.component` function. 87 | 88 | Halogen Hooks provides a few built-in Hooks like `useState`. You can also implement your own Hooks to reuse stateful behavior among different components. 89 | 90 | ## The Effect Hook 91 | 92 | Requests, subscriptions, and queries are all examples of side effects that components run all the time. In a regular Halogen component these effects must be run in `HalogenM`, usually as part of the `handleAction` or `handleQuery` functions used to construct the component. They can't be run during rendering. 93 | 94 | In a Hooks function you write side effects in `HookM`, a monad almost identical to `HalogenM`. You can run these side effects in the body of the hook with `useLifecycleEffect` or `useTickEffect`, two implementations of the Effect Hook. This hook replaces component initializers and finalizers and also introduces the ability to run an effect after every render, not just the first and last one. 95 | 96 | For example, this component will log the current count every time the state updates (ie. a render occurs): 97 | 98 | ```purs 99 | example = Hooks.component \_ _ -> Hooks.do 100 | count /\ countId <- Hooks.useState 0 101 | 102 | -- On initialize and each subsequent render, log the current count state to 103 | -- the console. 104 | Hooks.captures {} Hooks.useTickEffect do 105 | Console.logShow count 106 | -- Before each run of the effect we can perform some cleanup (for example: 107 | -- ending a subscription, or cleaning up an event handler). Here, we don't 108 | -- need to, so we return `Nothing`. 109 | pure Nothing 110 | 111 | Hooks.pure do 112 | HH.div_ 113 | [ HH.p_ [ HH.text $ "You clicked " <> show count <> " times" ] 114 | , HH.button 115 | [ HE.onClick \_ -> Hooks.modify_ countId (_ + 1) ] 116 | ] 117 | ``` 118 | 119 | The two implementations of this Hook differ in important ways: 120 | 121 | - `useLifecycleEffect` will run after the first render (initialization) and can return an effect to run when the component is finalizing. It won't be run for subsequent renders in between these two. That means it directly replaces initializers and finalizers in regular components. 122 | - `useTickEffect` will run after every render, including initialization. Some effects, like subscriptions to a data source provided as input or in state, need to update any time that source changes, not just at component initialization. 123 | 124 | ## Building Your Own Hooks 125 | 126 | We often want to reuse some stateful logic between components. Traditionally, there were two solutions to this problem: higher-order and renderless components. Custom Hooks let you share stateful logic without the boilerplate and complexity of these patterns and without adding more components to your tree. 127 | 128 | See [Implementing UseWindowWidth](https://thomashoneyman.com/articles/introducing-halogen-hooks/#implementing-usewindowwidth) for information on implementing a custom Hook of your own. 129 | 130 | ## Other Hooks 131 | 132 | There are other built-in Hooks you may find useful. For example, you can use the `useRef` hook to acquire a reference to mutable state, `useQuery` to enable a request/response pattern for your component, or `useMemo` to memoize expensive values in your render code. You can see a full listing in the [Hooks API reference](./07-Hooks-API.md). 133 | 134 | ## Hooks and Ordering 135 | 136 | Hooks must always be called in the same order each time they are evaluated. You will receive a compile-time error if you try to rearrange Hooks between evaluations (by calling Hooks within branching logic like `if` or `case` statements, for instance). 137 | 138 | This restriction exists because Hooks are internally implemented in a Halogen component which stores the Hooks and their data in arrays. If Hooks are run out of order, then their array indices will no longer match, potentially causing a runtime crash. This implementation matches with the same approach used in React and React Basic Hooks. 139 | 140 | In practice, it's rare to encounter this compile-time error. However, it's good to know that the restriction exists in case you do find yourself trying to order Hooks contingently. 141 | -------------------------------------------------------------------------------- /docs/02-State-Hook.md: -------------------------------------------------------------------------------- 1 | # The State Hook (useState) 2 | 3 | This chapter hasn't been written yet, but you can read the corresponding entry in [the Hooks API reference](./07-Hooks-API.md). 4 | 5 | It will offer a detailed walkthrough of using the state hook, along with a comparison to the equivalent Halogen component code. It will also include tips on avoiding stale state and notes on using state within `HookM`. 6 | 7 | In the meantime, you can see the [examples](../examples/Example/Hooks) to see this hook in action. 8 | -------------------------------------------------------------------------------- /docs/03-Effect-Hook.md: -------------------------------------------------------------------------------- 1 | # The Effect Hook (useLifecycleEffect, useTickEffect) 2 | 3 | This chapter hasn't been written yet, but you can read the corresponding entry in [the Hooks API reference](./07-Hooks-API.md). 4 | 5 | It will offer a detailed walkthrough of using the lifecycle / tickEffect hooks, along with a comparison to the equivalent Halogen component code using initializers, finalizers,`handleAction`, and `handleQuery`. It will also demonstrate how actions and `handleAction` can be entirely replaced using `HookM`, and how you can recreate this action pattern in your code if you enjoy it. 6 | 7 | In the meantime, you can see the [examples](../examples/Example/Hooks) to see this hook in action. 8 | -------------------------------------------------------------------------------- /docs/04-Query-Hook.md: -------------------------------------------------------------------------------- 1 | # The Query Hook (useQuery) 2 | 3 | This chapter hasn't been written yet, but you can read the corresponding entry in [the Hooks API reference](./07-Hooks-API.md). 4 | 5 | It will offer a detailed walkthrough of using the query hook, which enables Halogen's querying feature for components. 6 | 7 | In the meantime, you can see the [examples](../examples/Example/Hooks) to see this hook in action. 8 | -------------------------------------------------------------------------------- /docs/05-HookM.md: -------------------------------------------------------------------------------- 1 | # HookM 2 | 3 | This chapter hasn't been written yet. 4 | 5 | It will offer a detailed explanation of the `HookM` monad, which is largely equivalent to `HalogenM` but with a slightly different approach to state. It will also describe why `HookM` is used as the action type in Hook components' HTML. 6 | 7 | In the meantime, you can see the [examples](../examples/Example/Hooks) to see this type in action. There are also some tips available in [the Hooks API reference](./07-Hooks-API.md). 8 | 9 | You may also wish to read the [Implementing UseWindowWidth](https://thomashoneyman.com/articles/introducing-halogen-hooks/#implementing-usewindowwidth) section of the introduction to Halogen Hooks for more information. 10 | -------------------------------------------------------------------------------- /docs/06-Writing-Hooks.md: -------------------------------------------------------------------------------- 1 | # Writing Your Own Hooks 2 | 3 | This chapter is partially complete. You can learn how to write your own Hook types here, but for more details on writing Hooks please [see the section on implementing your own Hooks](https://thomashoneyman.com/articles/introducing-halogen-hooks#implementing-usewindowwidth) in Introducing Halogen Hooks. 4 | 5 | ## How do I write a new Hook type? 6 | 7 | Hooks are uniquely identified by a type of the kind `HookType`. All primitive Hooks in this library have this kind, but what about when you want to write your own? Let's walk through how to define your own hook types. We'll use a small example for demonstration. 8 | 9 | Let's say we want to define a Hook which, given a value, returns the value from the _previous_ evaluation. This can be useful to manually check if a value has changed between renders, for example. 10 | 11 | ```purs 12 | import Data.Maybe (Maybe(..)) 13 | import Data.Tuple.Nested ((/\)) 14 | import Effect.Aff.Class (class MonadAff) 15 | import Effect.Class (liftEffect) 16 | import Effect.Ref as Ref 17 | import Halogen.Hooks (type (<>), Hook, UseEffect, UseRef) 18 | import Halogen.Hooks as Hooks 19 | 20 | type UsePrevious a = UseRef (Maybe a) <> UseEffect <> Hooks.Pure 21 | 22 | usePrevious :: forall m a. MonadAff m => Eq a => a -> Hook m (UsePrevious a) (Maybe a) 23 | usePrevious value = Hooks.do 24 | prev /\ ref <- Hooks.useRef Nothing 25 | 26 | Hooks.captures { } Hooks.useTickEffect do 27 | liftEffect $ Ref.write (Just value) ref 28 | pure Nothing 29 | 30 | Hooks.pure prev 31 | ``` 32 | 33 | This custom Hook compiles. The type synonym indicates that our Hook uses a mutable reference, then an effect, and then produces a value via `Hooks.pure`. We use the type `<>` to list Hooks in order. 34 | 35 | Our type synonym is adequate to implement the Hook, but it isn't a best practice. Instead, almost all custom Hooks should implement their own custom `HookType`. `UseRef`, `UseState`, `Pure`, and the other primitives from Halogen Hooks are each unique `HookType`s. Here's why: 36 | 37 | 1. If there were a compile-time error involving this Hook then the error message would contain the full list of Hooks; in the real world, with Hooks that contain other Hooks, this can lead to unreadable error messages. 38 | 2. Hooks must always run in the same order in each evaluation, which is checked by ensuring the evaluation uses the same hook types in order. If you have two Hooks that have an identical list of Hook types, but which do different things, then you can subvert this check accidentally. This is admittedly quite unlikely, but it's a reason to rely on custom Hook types instead of the structure of the Hook's internals. 39 | 40 | Let's adjust this example so that it uses a custom Hook type: 41 | 42 | ```purs 43 | import Halogen.Hooks (class HookNewtype, type (<>), Hook, UseEffect, UseRef) 44 | 45 | foreign import data UsePrevious :: Type -> Hooks.HookType 46 | 47 | instance newtypeUsePrevious 48 | :: HookNewtype (UsePrevious a) (UseRef (Maybe a) <> UseEffect <> Hooks.Pure) 49 | 50 | usePrevious :: forall m a. MonadAff m => Eq a => a -> Hook m (UsePrevious a) (Maybe a) 51 | usePrevious value = Hooks.wrap hook 52 | where 53 | hook :: Hook m (UseRef (Maybe a) <> UseEffect <> Hooks.Pure) (Maybe a) 54 | hook = Hooks.do ... 55 | ``` 56 | 57 | We can implement a custom Hook type in three steps: 58 | 59 | 1. Use a foreign import to get a new data type of the kind `HookType`, which should follow the naming convention `Use`. Here, we named it `UsePrevious` and gave it the kind `Type -> HookType`, indicating that this Hook type takes an argument. 60 | 2. Use the `HookNewtype` type to indicate what Hooks this `HookType` uses internally. Here, we indicated that `UsePrevious a` is a custom Hook type for `UseRef (Maybe a) <> UseEffect <> Pure`. 61 | 3. Use the `Hooks.wrap` function to turn a Hook using the right internal Hooks into a Hook which uses your new custom `HookType`. Here, we've written our Hook implementation in a `where` block with a type signature that shows the Hooks we're using internally. I recommend writing Hook implementations in `where` blocks with type signatures to aid the compiler with type inference. 62 | 63 | Once again, we have a Hook that compiles. This time, though, our worries about unreadable errors and revealing Hook internals are gone. Still, we can improve things: we've written out our Hook internals twice: once in our `HookNewtype` and once again in the implementation. 64 | 65 | Let's clean things up by writing our internal Hook types in a type synonym. In PureScript 0.14: 66 | 67 | ```purs 68 | foreign import data UsePrevious :: Type -> Hooks.HookType 69 | 70 | type UsePrevious' a = UseRef (Maybe a) <> UseEffect <> Hooks.Pure 71 | 72 | instance newtypeUsePrevious :: HookNewtype (UsePrevious a) (UsePrevious' a) 73 | 74 | usePrevious :: forall m a. MonadAff m => Eq a => a -> Hook m (UsePrevious a) (Maybe a) 75 | usePrevious value = Hooks.wrap hook 76 | where 77 | hook :: Hook m (UsePrevious' a) (Maybe a) 78 | hook = Hooks.do ... 79 | ``` 80 | 81 | This is much better! In PureScript 0.14 this is the best practice for how to write a Hook like this one. However, in PureScript 0.13.x you cannot write the `HookNewtype` instance for a type synonym. Instead, you'll first have to use the `HookEquals` class to say that the type synonym is equivalent to some type `h`, and then write the `HookNewtype` instance for that type. 82 | 83 | Here's the same Hook implemented in PureScript v0.13.x: 84 | 85 | ```purs 86 | import Halogen.Hooks (class HookEquals, class HookNewtype, type (<>), Hook, UseEffect, UseRef) 87 | 88 | foreign import data UsePrevious :: Type -> Hooks.HookType 89 | 90 | type UsePrevious' a = UseRef (Maybe a) <> UseEffect <> Hooks.Pure 91 | 92 | instance newtypeUsePrevious 93 | :: HookEquals (UsePrevious' a) h => HookNewtype (UsePrevious a) h 94 | 95 | usePrevious :: forall m a. MonadAff m => Eq a => a -> Hook m (UsePrevious a) (Maybe a) 96 | usePrevious value = Hooks.wrap hook 97 | where 98 | hook :: Hook m (UsePrevious' a) (Maybe a) 99 | hook = Hooks.do ... 100 | ``` 101 | -------------------------------------------------------------------------------- /docs/07-Hooks-API.md: -------------------------------------------------------------------------------- 1 | # The Hooks API 2 | 3 | The Hooks API consists of 6 primitive Hooks you can use to implement components or custom Hooks. 4 | 5 | This chapter is still a work in progress, but it contains enough information on each primitive Hook for you to get started using them in your own code. 6 | 7 | ## Table of Contents 8 | 9 | 1. [useState](#usestate) 10 | 2. [useLifecycleEffect](#uselifecycleeffect) 11 | 3. [useTickEffect](#usetickeffect) 12 | 4. [useQuery](#usequery) 13 | 5. [useMemo](#usememo) 14 | 6. [useRef](#useref) 15 | 16 | ## useState 17 | 18 | The `useState` Hook allows you to create an independent state. It requires the initial state as an argument, and it returns the current value of that state and a unique identifier you can use with state functions to update that state. 19 | 20 | ```purs 21 | Hooks.do 22 | -- Create one or more states with `useState`. On each render the hook will 23 | -- return the current state and a unique identifier you can use to update 24 | -- the state. 25 | state /\ stateId <- Hooks.useState initialState 26 | count /\ countId <- Hooks.useState 0 27 | 28 | let 29 | update :: HookM _ Unit 30 | update = do 31 | -- Use the modify function to update the state, which will cause all hooks 32 | -- to run again and a new render to occur. 33 | Hooks.modify_ countId (_ + 10) 34 | -- ... 35 | 36 | Hooks.useLifecycleEffect do 37 | Hooks.modify_ countId (_ + 10) 38 | pure Nothing 39 | 40 | Hooks.pure do 41 | HH.div 42 | [ HE.onClick \_ -> update ] 43 | [ HH.text $ show count ] -- Use state values directly in your render code 44 | ``` 45 | 46 | In a regular Halogen component, any time your state updates your component will re-render. Hooks operate in a similar fashion: any time one of your state cells updates, your Hooks will re-run. 47 | 48 | Most of the time you only need the `modify_` function for your state. It can be convenient to have the `useState` hook just return a function to modify the state instead of returning a `StateId`; if you prefer that, you can implement a helper function like `useStateFn` in the example below (`useStateFn` and other helpers are available in the [halogen-hooks-extra](https://github.com/JordanMartinez/purescript-halogen-hooks-extra) package): 49 | 50 | ```purs 51 | -- To allow using any state function 52 | useStateFn :: forall s m a. (StateId s -> a) -> s -> Hook m (UseState s) (s /\ a) 53 | useStateFn fn initial = map (map fn) (Hooks.useState initial) 54 | 55 | -- To specifically use `modify_` 56 | useState :: forall s m. s -> Hook m (UseState s) (s /\ ((s -> s) -> HookM m Unit) 57 | useState = useStateFn Hooks.modify_ 58 | 59 | Hooks.do 60 | state /\ modifyState <- useState initialState 61 | 62 | let 63 | handler :: HookM _ Unit 64 | handler = do 65 | modifyState \st -> ... 66 | ``` 67 | 68 | ## useLifecycleEffect 69 | 70 | The `useLifecycleEffect` Hook allows you to run an effect the first time your Hooks are run, similar to a component initializer. This effect can optionally return another effect which will run when your Hooks are finalized. This second effect should be used to perform any necessary cleanup, like removing event listeners. 71 | 72 | This Hook is useful when you need to perform effects which are not driven by user interactions, like loading resources, starting subscriptions and timers, and more. As with all effects in Hooks this code will run in the `HookM` monad. 73 | 74 | If you would like to run your effect after every render, not just the initializer and finalizer, please see `useTickEffect`. 75 | 76 | ```purs 77 | Hooks.do 78 | width /\ modifyWidth <- Hooks.useState Nothing 79 | 80 | Hooks.useLifecycleEffect do 81 | -- This code will all be run after the first render, which is akin to 82 | -- component initialization. 83 | let readWidth = modifyWidth <<< const <<< Just <=< liftEffect <<< Window.innerWidth 84 | 85 | window <- liftEffect HTML.window 86 | subscriptionId <- Hooks.subscribe do 87 | HS.eventListener 88 | (EventType "resize") 89 | (Window.toEventTarget window) 90 | (Event.target >>> map (fromEventTarget >>> readWidth)) 91 | 92 | readWidth window 93 | 94 | -- This effect can return another effect to run when these Hooks are removed; 95 | -- here, we unsubscribe from window resize events. 96 | pure $ Just $ Hooks.unsubscribe subscriptionId 97 | 98 | Hooks.pure width 99 | ``` 100 | 101 | Note: Asynchronous functions (functions defined during one Hooks evaluation, but run after another) should not reference `state` or `input` directly. Instead, any state or input they need access to should be copied into a mutable reference so that the function can read the reference when it runs, guaranteeing it has up-to-date values. In ordinary Hooks usage this mainly applies to the effect cleanup functions. 102 | 103 | For a convenient Hook which does this for you, see the `useGet` Hook in the [examples](../examples/Example/Hooks). 104 | 105 | ## useTickEffect 106 | 107 | The `useTickEffect` Hook lets you run an effect after every render, including the first time your Hooks are run, and optionally return another effect to run after the last time your Hooks are run. This second effect should be used to clean up any resources acquired with prior effects. 108 | 109 | This Hook is used the largely the same way as the `useLifecycleEffect` Hook. However, because it runs after every render, there is more potential for it to become a performance bottleneck. 110 | 111 | For that reason, this Hook is designed to only run again if particular values it depends on have changed. You must provide these dependencies via the `Hooks.captures` or `Hooks.capturesWith` functions. For example: 112 | 113 | ```purs 114 | -- This effect will run after every render 115 | Hooks.captures {} Hooks.useTickEffect do 116 | -- ... your effect body 117 | pure Nothing -- ... if no cleanup is required before the next run of the effect 118 | pure $ Just do -- ... if cleanup is required before the next run of the effect 119 | 120 | -- This effect will run after the first render and after any render in which the 121 | -- values `memoA` or `memoB` have changed: 122 | Hooks.captures { memoA, memoB } Hooks.useTickEffect do 123 | -- ... your effect, which depends on memoA or memoB 124 | pure Nothing 125 | ``` 126 | 127 | It is easy to forget to include dependencies. If you forget a dependency, and then its value changes, then your effect will not re-run even though it should. To avoid this situation I recommend defining all code which relies on `captures` inside a `where` block. This prevents you from inadvertently using values in your effect which are in scope in your Hooks block. 128 | 129 | ```purs 130 | Hooks.do 131 | count /\ _ <- Hooks.useState 0 132 | size /\ _ <- Hooks.useState 100.0 133 | _ <- useMyEffect { count, size } 134 | -- ... rest of your implementation 135 | where 136 | -- this code cannot accidentally forget to include `count` or `size` in its 137 | -- dependencies because they are not in scope. 138 | useMyEffect deps@{ count, size } = Hooks.captures deps Hooks.useTickEffect do 139 | -- ... use count and size 140 | pure Nothing 141 | ``` 142 | 143 | ## useQuery 144 | 145 | The `useQuery` Hook enables you to write components which can receive and evaluate queries from a parent component. This Hook is only usable in components constructed with the `Hooks.component` function, because the request/response nature of queries means they only make sense within components. Queries don't make sense in arbitrary Hooks, so they're disallowed. 146 | 147 | The resulting component can be queried like any other Halogen component via the `Hooks.query`, `Hooks.queryAll`, `Hooks.tell` or `Hooks.request` functions. 148 | 149 | If this Hook is used multiple times, then only the last use will take effect. 150 | 151 | ```purs 152 | data Query a = IsOn (Boolean -> a) 153 | 154 | component :: forall i o m. H.Component HH.HTML Query i o m 155 | component = Hooks.component \{ queryToken } _ -> Hooks.do 156 | enabled /\ modifyEnabled <- Hooks.useState false 157 | 158 | -- You can only use the useQuery Hook with a token, which must come from the 159 | -- `component` function 160 | Hooks.useQuery queryToken case _ of 161 | -- You can write a handler the same way you would write `handleQuery` in a 162 | -- Halogen component. The handler is updated on each Hooks evaluation, so 163 | -- you can refer to state or input values directly without them becoming stale. 164 | IsOn reply -> do 165 | pure (Just (reply enabled)) 166 | 167 | Hooks.pure -- ...your render code 168 | ``` 169 | 170 | ## useMemo 171 | 172 | The `useMemo` Hook lets you preserve a value between runs of your Hooks, so long as the values used to compute it have not changed. This Hook is purely a performance optimization. 173 | 174 | When you define values in let bindings in the body of a Hook they will be redefined each time the Hook's body is evaluated, which is to say on every render. For many values this doesn't matter, but for values that are expensive to compute this can become a performance bottleneck. 175 | 176 | This is the same situation as exists in Halogen components: you should avoid computing expensive values within your render function. Instead, you should define these values outside the component, or if the values can be updated only within effectful code, then you can try caching them in state so re-renders don't require re-computing them. 177 | 178 | However, sometimes you will have to compute an expensive value within the body of your Hooks code. In this case, you can use the `useMemo` hook to only recompute the value if a value it depends on has changed. 179 | 180 | All values used to compute the value you want to memoize must be provided to the `Hooks.captures` or `Hooks.capturesWith` function. As with `useTickEffect`, you should define your `useMemo` Hook in a `where` clause so you don't use values that are in scope in your Hooks block without including them as a dependency. 181 | 182 | ```purs 183 | -- this value will be computed on every render: 184 | Hooks.do 185 | x /\ _ <- Hooks.useState 0 186 | y /\ _ <- Hooks.useState "" 187 | let expensiveValue = expensiveFunction x y 188 | -- ... 189 | 190 | -- this value will only be computed if `x` or `y` have changed in the last render 191 | Hooks.do 192 | x /\ _ <- Hooks.useState 0 193 | y /\ _ <- Hooks.useState "" 194 | expensiveValue <- useExpensive { x, y } 195 | -- ... 196 | where 197 | useExpensive deps@{ x, y } = Hooks.captures deps $ flip Hooks.useMemo \_ -> 198 | expensiveFunction x y 199 | ``` 200 | 201 | ## useRef 202 | 203 | The `useRef` Hook lets you use a mutable reference in the body of a Hook. The Hook returns the value of the reference at the time the Hook was run, and the reference itself you can use to manipulate the value. 204 | 205 | As with all state, you should only use the returned value in rendering code or as a return value from your Hook. If you are using the value in effectful code, then you should always use `Ref.read` on the reference to get the current value at the time your effect is run. Otherwise you run the risk of stale state. 206 | 207 | Mutable references should be used sparingly, but they are necessary to manage values which change often but do not relate directly to rendering (for example, running a debouncer). 208 | 209 | ```purs 210 | import Effect.Ref as Ref 211 | 212 | Hooks.do 213 | value /\ ref <- Hooks.useRef 0 214 | 215 | -- use the reference for reading and writing when in effectful code 216 | Hooks.captures {} Hooks.useTickEffect do 217 | current <- liftEffect $ Ref.read ref 218 | -- ... use the current value 219 | 220 | -- use the returned value when in pure code, like the render function 221 | Hooks.pure $ HH.text (show value) 222 | ``` 223 | -------------------------------------------------------------------------------- /docs/README.md: -------------------------------------------------------------------------------- 1 | # Hooks Documentation 2 | 3 | Halogen Hooks is a new library for Halogen, but Hooks as a concept were originally pioneered by React. The structure of this documentation is adapted from the [React Hooks documentation](https://reactjs.org/docs/hooks-intro.html) and many of the core ideas are the same. 4 | 5 | You should read [Introducing Halogen Hooks](https://thomashoneyman.com/articles/introducing-halogen-hooks) before diving in to this documentation. 6 | 7 | If you reach a portion of this documentation which is incomplete, you may benefit from reading a similar section in the React documentation. I also encourage you to reach out on this repository's issue tracker about the information you wanted to know but couldn't find in this documentation. 8 | 9 | The [Hooks Internals](./09-Hooks-Internals.md) documentation can help you if you would like to contribute to this library and need to understand its design decisions. 10 | 11 | ## Table of Contents 12 | 13 | 1. [Hooks At a Glance](./01-Hooks-At-A-Glance.md) 14 | 2. [The State Hook (useState)](./02-State-Hook.md) 15 | 3. [The Effect Hook (useLifecycleEffect, useTickEffect)](./03-Effect-Hook.md) 16 | 4. [The Query Hook (useQuery)](./04-Query-Hook.md) 17 | 5. [HookM](./05-HookM.md) 18 | 6. [Writing Your Own Hooks](./06-Writing-Hooks.md) 19 | 7. [The Hooks API](./07-Hooks-API.md) 20 | 8. [Hooks FAQ](./08-Hooks-FAQ.md) 21 | 9. [Hooks Internals](./09-Hooks-Internals.md) 22 | -------------------------------------------------------------------------------- /examples/Example/Halogen/Basic/Button.purs: -------------------------------------------------------------------------------- 1 | module Example.Halogen.Basic.Button where 2 | 3 | import Prelude 4 | 5 | import Data.Tuple.Nested ((/\)) 6 | import Halogen as H 7 | import Halogen.HTML as HH 8 | import Halogen.HTML.Events as HE 9 | import Halogen.HTML.Properties as HP 10 | import Halogen.Hooks as Hooks 11 | 12 | component :: forall q i o m. H.Component q i o m 13 | component = Hooks.component \_ _ -> Hooks.do 14 | enabled /\ enabledId <- Hooks.useState false 15 | 16 | let 17 | label = if enabled then "On" else "Off" 18 | handleClick = Hooks.modify_ enabledId not 19 | 20 | Hooks.pure do 21 | HH.button 22 | [ HP.title label 23 | , HE.onClick \_ -> handleClick 24 | ] 25 | [ HH.text label ] 26 | -------------------------------------------------------------------------------- /examples/Example/Halogen/Components/Button.purs: -------------------------------------------------------------------------------- 1 | module Example.Halogen.Components.Button (Slot, Query(..), Message(..), component) where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Data.Tuple.Nested ((/\)) 7 | import Effect.Class (class MonadEffect) 8 | import Halogen as H 9 | import Halogen.HTML as HH 10 | import Halogen.HTML.Events as HE 11 | import Halogen.HTML.Properties as HP 12 | import Halogen.Hooks as Hooks 13 | 14 | type Slot = H.Slot Query Message 15 | 16 | data Query a = IsOn (Boolean -> a) 17 | 18 | data Message = Toggled Boolean 19 | 20 | type Tokens = Hooks.ComponentTokens Query () Message 21 | 22 | component :: forall i m. MonadEffect m => H.Component Query i Message m 23 | component = Hooks.component \(tokens :: Tokens) _ -> Hooks.do 24 | enabled /\ enabledId <- Hooks.useState false 25 | 26 | Hooks.useQuery tokens.queryToken case _ of 27 | IsOn reply -> do 28 | pure (Just (reply enabled)) 29 | 30 | let 31 | label = if enabled then "On" else "Off" 32 | 33 | handleClick = do 34 | enabled' <- Hooks.modify enabledId not 35 | Hooks.raise tokens.outputToken (Toggled enabled') 36 | 37 | Hooks.pure do 38 | HH.button 39 | [ HP.title label 40 | , HE.onClick \_ -> handleClick 41 | ] 42 | [ HH.text label ] 43 | -------------------------------------------------------------------------------- /examples/Example/Halogen/Components/Container.purs: -------------------------------------------------------------------------------- 1 | module Example.Halogen.Components.Container (component) where 2 | 3 | import Prelude 4 | 5 | import Data.Foldable (fold) 6 | import Data.Maybe (Maybe(..), maybe) 7 | import Data.Tuple.Nested ((/\)) 8 | import Effect.Class (class MonadEffect) 9 | import Example.Halogen.Components.Button as Button 10 | import Halogen as H 11 | import Halogen.HTML as HH 12 | import Halogen.HTML.Events as HE 13 | import Halogen.Hooks as Hooks 14 | import Type.Proxy (Proxy(..)) 15 | 16 | _button :: Proxy "button" 17 | _button = Proxy 18 | 19 | component :: forall q i o m. MonadEffect m => H.Component q i o m 20 | component = Hooks.component \{ slotToken } _ -> Hooks.do 21 | count /\ countId <- Hooks.useState 0 22 | buttonStatus /\ buttonStatusId <- Hooks.useState Nothing 23 | 24 | let 25 | handleButton (Button.Toggled enabled) = do 26 | when enabled do 27 | Hooks.modify_ countId (_ + 1) 28 | 29 | handleClick = do 30 | status <- Hooks.request slotToken _button unit Button.IsOn 31 | Hooks.put buttonStatusId status 32 | 33 | Hooks.pure do 34 | HH.div_ 35 | [ HH.slot _button unit Button.component unit handleButton 36 | , HH.p_ 37 | [ HH.text $ "Button has been toggled 'on' " <> show count <> " time(s)" ] 38 | , HH.p_ 39 | [ HH.text $ fold 40 | [ "Last time I checked, the button was: " 41 | , maybe "(not checked yet)" (if _ then "on" else "off") buttonStatus 42 | , ". " 43 | ] 44 | , HH.button 45 | [ HE.onClick \_ -> handleClick ] 46 | [ HH.text "Check now" ] 47 | ] 48 | ] 49 | -------------------------------------------------------------------------------- /examples/Example/Halogen/ComponentsInputs/Container.purs: -------------------------------------------------------------------------------- 1 | module Example.Halogen.ComponentsInputs.Container where 2 | 3 | import Prelude 4 | 5 | import Data.Tuple.Nested ((/\)) 6 | import Effect.Class (class MonadEffect) 7 | import Example.Halogen.ComponentsInputs.Display as Display 8 | import Halogen as H 9 | import Halogen.HTML as HH 10 | import Halogen.HTML.Events as HE 11 | import Halogen.Hooks as Hooks 12 | import Type.Proxy (Proxy(..)) 13 | 14 | _display = Proxy :: Proxy "display" 15 | 16 | component :: forall q i o m. MonadEffect m => H.Component q i o m 17 | component = Hooks.component \_ _ -> Hooks.do 18 | count /\ countId <- Hooks.useState 1 19 | 20 | let 21 | decrement = Hooks.modify_ countId (_ - 1) 22 | increment = Hooks.modify_ countId (_ + 1) 23 | 24 | Hooks.pure do 25 | HH.div_ 26 | [ HH.ul_ 27 | [ HH.slot _display 1 Display.component count absurd 28 | , HH.slot _display 2 Display.component (count * 2) absurd 29 | , HH.slot _display 3 Display.component (count * 3) absurd 30 | , HH.slot _display 4 Display.component (count * 10) absurd 31 | , HH.slot _display 5 Display.component (count * count) absurd 32 | ] 33 | , HH.button 34 | [ HE.onClick \_ -> decrement ] 35 | [ HH.text "- 1" ] 36 | , HH.button 37 | [ HE.onClick \_ -> increment ] 38 | [ HH.text "+ 1" ] 39 | ] 40 | -------------------------------------------------------------------------------- /examples/Example/Halogen/ComponentsInputs/Display.purs: -------------------------------------------------------------------------------- 1 | module Example.Halogen.ComponentsInputs.Display where 2 | 3 | import Prelude 4 | 5 | import Halogen as H 6 | import Halogen.HTML as HH 7 | import Halogen.Hooks as Hooks 8 | 9 | type Input = Int 10 | 11 | component :: forall q o m. H.Component q Input o m 12 | component = Hooks.component \_ input -> Hooks.pure do 13 | HH.div_ 14 | [ HH.text "My input value is: " 15 | , HH.strong_ [ HH.text $ show input ] 16 | ] 17 | -------------------------------------------------------------------------------- /examples/Example/Halogen/Effects/Random.purs: -------------------------------------------------------------------------------- 1 | module Example.Halogen.Effects.Random where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..), maybe) 6 | import Data.Tuple.Nested ((/\)) 7 | import Effect.Class (class MonadEffect) 8 | import Effect.Random (random) 9 | import Halogen as H 10 | import Halogen.HTML as HH 11 | import Halogen.HTML.Events as HE 12 | import Halogen.Hooks as Hooks 13 | 14 | type State = Maybe Number 15 | 16 | component :: forall q i o m. MonadEffect m => H.Component q i o m 17 | component = Hooks.component \_ _ -> Hooks.do 18 | state /\ stateId <- Hooks.useState Nothing 19 | 20 | let 21 | value = maybe "No number generated yet" show state 22 | 23 | handleClick = do 24 | newNumber <- H.liftEffect random 25 | Hooks.put stateId (Just newNumber) 26 | 27 | Hooks.pure do 28 | HH.div_ 29 | [ HH.h1_ 30 | [ HH.text "Random number" ] 31 | , HH.p_ 32 | [ HH.text $ "Current value: " <> value ] 33 | , HH.button 34 | [ HE.onClick \_ -> handleClick ] 35 | [ HH.text "Generate new number" ] 36 | ] 37 | -------------------------------------------------------------------------------- /examples/Example/Halogen/InputRef/Component.purs: -------------------------------------------------------------------------------- 1 | module Example.Halogen.InputRef.Component where 2 | 3 | import Prelude 4 | 5 | import Data.Foldable (traverse_) 6 | import Effect.Class (class MonadEffect) 7 | import Halogen (liftEffect) 8 | import Halogen as H 9 | import Halogen.HTML as HH 10 | import Halogen.HTML.Events as HE 11 | import Halogen.HTML.Properties as HP 12 | import Halogen.Hooks (HookM) 13 | import Halogen.Hooks as Hooks 14 | import Web.HTML.HTMLElement (focus) 15 | 16 | component :: forall q i o m. MonadEffect m => H.Component q i o m 17 | component = Hooks.component \_ _ -> Hooks.do 18 | let 19 | refLabel :: H.RefLabel 20 | refLabel = H.RefLabel "inputElement" 21 | 22 | handleButtonClick :: HookM m Unit 23 | handleButtonClick = do 24 | Hooks.getHTMLElementRef refLabel >>= traverse_ (focus >>> liftEffect) 25 | 26 | Hooks.pure do 27 | HH.div_ 28 | [ HH.input 29 | [ HP.type_ HP.InputText 30 | , HP.ref refLabel 31 | ] 32 | , HH.button 33 | [ HE.onClick \_ -> handleButtonClick ] 34 | [ HH.text "Focus the input" ] 35 | ] 36 | -------------------------------------------------------------------------------- /examples/Example/Hooks/Components.purs: -------------------------------------------------------------------------------- 1 | module Example.Hooks.Components where 2 | 3 | import Prelude 4 | 5 | import Data.Argonaut (decodeJson, encodeJson, printJsonDecodeError) 6 | import Data.Either (Either(..), either) 7 | import Data.Lens (_Right, over) 8 | import Data.Maybe (maybe) 9 | import Data.Time.Duration (Milliseconds(..)) 10 | import Data.Tuple.Nested ((/\)) 11 | import Effect.Aff.Class (class MonadAff) 12 | import Effect.Class (class MonadEffect) 13 | import Example.Hooks.UseDebouncer (useDebouncer) 14 | import Example.Hooks.UseLocalStorage (Key(..), useLocalStorage) 15 | import Example.Hooks.UsePrevious (usePrevious) 16 | import Example.Hooks.UseStateFn (useStateFn) 17 | import Example.Hooks.UseWindowWidth (useWindowWidth) 18 | import Halogen as H 19 | import Halogen.HTML as HH 20 | import Halogen.HTML.Events as HE 21 | import Halogen.Hooks as Hooks 22 | 23 | windowWidth :: forall q i o m. MonadAff m => H.Component q i o m 24 | windowWidth = Hooks.component \_ _ -> Hooks.do 25 | width <- useWindowWidth 26 | Hooks.pure do 27 | HH.div_ 28 | [ HH.h4_ [ HH.text "Window Width" ] 29 | , HH.p_ [ HH.text "This example demonstrates a hook which subscribes to resize events on the window and returns its width on change." ] 30 | , HH.text $ "Current width: " <> maybe "" show width 31 | ] 32 | 33 | previousValue :: forall q i o m. MonadAff m => H.Component q i o m 34 | previousValue = Hooks.component \_ _ -> Hooks.do 35 | state /\ modifyState <- useStateFn Hooks.modify_ 0 36 | prevState <- usePrevious state 37 | 38 | Hooks.pure do 39 | HH.div_ 40 | [ HH.h4_ [ HH.text "Previous Value" ] 41 | , HH.p_ [ HH.text "This example demonstrates a hook to persist a value from the previous render." ] 42 | , HH.text $ "The previous value of the state 'count' was: " <> show prevState 43 | , HH.br_ 44 | , HH.button 45 | [ HE.onClick \_ -> modifyState (_ + 1) ] 46 | [ HH.text $ "Increment (" <> show state <> ")" ] 47 | ] 48 | 49 | localStorage :: forall q i o m. MonadEffect m => H.Component q i o m 50 | localStorage = Hooks.component \_ _ -> Hooks.do 51 | state /\ modifyState <- useLocalStorage 52 | { defaultValue: 0 53 | , fromJson: decodeJson 54 | , toJson: encodeJson 55 | , key: Key "intStorageExample" 56 | } 57 | 58 | let 59 | clearCount = 60 | modifyState \_ -> Right 0 61 | 62 | increment = 63 | modifyState (over _Right (_ + 1)) 64 | 65 | Hooks.pure do 66 | HH.div_ 67 | [ HH.text "Click on the button to clear from local storage" 68 | , HH.button 69 | [ HE.onClick \_ -> clearCount ] 70 | [ HH.text "Clear" ] 71 | , HH.br_ 72 | , HH.text $ "You have " <> either printJsonDecodeError show state <> " at the intStorageExample key in local storage." 73 | , HH.button 74 | [ HE.onClick \_ -> increment ] 75 | [ HH.text "Increment" ] 76 | ] 77 | 78 | debouncer :: forall q i o m. MonadAff m => H.Component q i o m 79 | debouncer = Hooks.component \_ _ -> Hooks.do 80 | text /\ setText <- useStateFn Hooks.put "" 81 | debouncedText /\ setDebouncedText <- useStateFn Hooks.put "" 82 | 83 | debouncedHandleInput <- 84 | useDebouncer (Milliseconds 300.0) setDebouncedText 85 | 86 | let 87 | handleInput str = do 88 | setText str 89 | debouncedHandleInput str 90 | 91 | Hooks.pure do 92 | HH.div_ 93 | [ HH.h4_ 94 | [ HH.text "Debounced Input" ] 95 | , HH.p_ 96 | [ HH.text "This hook demonstrates debouncing an effectful function." ] 97 | , HH.input 98 | [ HE.onValueInput handleInput ] 99 | , HH.p_ 100 | [ HH.text $ "You entered: " <> text ] 101 | , HH.p_ 102 | [ HH.text $ "You entered (debounced): " <> debouncedText ] 103 | ] 104 | -------------------------------------------------------------------------------- /examples/Example/Hooks/UseDebouncer.purs: -------------------------------------------------------------------------------- 1 | module Example.Hooks.UseDebouncer 2 | ( useDebouncer 3 | , UseDebouncer 4 | ) where 5 | 6 | import Prelude 7 | 8 | import Data.Foldable (traverse_) 9 | import Data.Maybe (Maybe(..)) 10 | import Data.Tuple.Nested ((/\)) 11 | import Effect.Aff (Fiber, Milliseconds, delay, error, forkAff, killFiber) 12 | import Effect.Aff.AVar (AVar) 13 | import Effect.Aff.AVar as AVar 14 | import Effect.Aff.Class (class MonadAff, liftAff) 15 | import Effect.Class (liftEffect) 16 | import Effect.Ref as Ref 17 | import Halogen.Hooks (class HookNewtype, type (<>), Hook, HookM, UseRef) 18 | import Halogen.Hooks as Hooks 19 | 20 | foreign import data UseDebouncer :: Type -> Hooks.HookType 21 | 22 | type UseDebouncer' a = UseRef (Maybe Debouncer) <> UseRef (Maybe a) <> Hooks.Pure 23 | 24 | instance HookNewtype (UseDebouncer a) (UseDebouncer' a) 25 | 26 | type Debouncer = { var :: AVar Unit, fiber :: Fiber Unit } 27 | 28 | useDebouncer 29 | :: forall m a 30 | . MonadAff m 31 | => Milliseconds 32 | -> (a -> HookM m Unit) 33 | -> Hook m (UseDebouncer a) (a -> HookM m Unit) 34 | useDebouncer ms fn = Hooks.wrap hook 35 | where 36 | hook :: Hook m (UseDebouncer' a) (a -> HookM m Unit) 37 | hook = Hooks.do 38 | _ /\ debounceRef <- Hooks.useRef Nothing 39 | _ /\ valRef <- Hooks.useRef Nothing 40 | 41 | let 42 | debounceFn x = do 43 | debouncer <- liftEffect do 44 | Ref.write (Just x) valRef 45 | Ref.read debounceRef 46 | 47 | case debouncer of 48 | Nothing -> do 49 | var <- liftAff AVar.empty 50 | fiber <- liftAff $ forkAff do 51 | delay ms 52 | AVar.put unit var 53 | 54 | _ <- Hooks.fork do 55 | _ <- liftAff $ AVar.take var 56 | val <- liftEffect do 57 | Ref.write Nothing debounceRef 58 | Ref.read valRef 59 | traverse_ fn val 60 | 61 | liftEffect do 62 | Ref.write (Just { var, fiber }) debounceRef 63 | 64 | Just db -> do 65 | let var = db.var 66 | fiber <- liftAff do 67 | killFiber (error "Time's up!") db.fiber 68 | forkAff do 69 | delay ms 70 | AVar.put unit var 71 | 72 | liftEffect $ Ref.write (Just { var, fiber }) debounceRef 73 | 74 | Hooks.pure debounceFn 75 | -------------------------------------------------------------------------------- /examples/Example/Hooks/UseInitializer.purs: -------------------------------------------------------------------------------- 1 | module Example.Hooks.UseInitializer 2 | ( useInitializer 3 | , UseInitializer 4 | ) where 5 | 6 | import Prelude 7 | 8 | import Data.Maybe (Maybe(..)) 9 | import Halogen.Hooks (class HookNewtype, Hook, HookM, UseEffect) 10 | import Halogen.Hooks as Hooks 11 | 12 | foreign import data UseInitializer :: Hooks.HookType 13 | 14 | instance HookNewtype UseInitializer UseEffect 15 | 16 | useInitializer :: forall m. HookM m Unit -> Hook m UseInitializer Unit 17 | useInitializer initializer = Hooks.wrap hook 18 | where 19 | hook :: Hook m UseEffect Unit 20 | hook = Hooks.useLifecycleEffect (initializer *> pure Nothing) 21 | -------------------------------------------------------------------------------- /examples/Example/Hooks/UseLocalStorage.purs: -------------------------------------------------------------------------------- 1 | module Example.Hooks.UseLocalStorage 2 | ( useLocalStorage 3 | , UseLocalStorage 4 | , Key(..) 5 | , StorageInterface 6 | ) where 7 | 8 | import Prelude 9 | 10 | import Data.Argonaut (Json, JsonDecodeError, parseJson, stringify) 11 | import Data.Either (Either(..)) 12 | import Data.Foldable (for_) 13 | import Data.Maybe (Maybe(..), maybe) 14 | import Data.Tuple (Tuple(..)) 15 | import Data.Tuple.Nested ((/\), type (/\)) 16 | import Effect.Class (class MonadEffect, liftEffect) 17 | import Example.Hooks.UseInitializer (UseInitializer, useInitializer) 18 | import Halogen.Hooks (class HookNewtype, type (<>), Hook, HookM, UseEffect, UseState) 19 | import Halogen.Hooks as Hooks 20 | import Web.HTML (window) 21 | import Web.HTML.Window (localStorage) 22 | import Web.Storage.Storage (getItem, setItem) 23 | 24 | foreign import data UseLocalStorage :: Type -> Hooks.HookType 25 | 26 | type UseLocalStorage' a = 27 | UseState (Either JsonDecodeError a) 28 | <> UseInitializer 29 | <> UseEffect 30 | <> Hooks.Pure 31 | 32 | instance HookNewtype (UseLocalStorage a) h 33 | 34 | type StorageInterface a = 35 | { key :: Key 36 | , defaultValue :: a 37 | , toJson :: a -> Json 38 | , fromJson :: Json -> Either JsonDecodeError a 39 | } 40 | 41 | -- | A key for a cell in local storage 42 | newtype Key = Key String 43 | 44 | derive newtype instance Eq Key 45 | 46 | useLocalStorage 47 | :: forall m a 48 | . MonadEffect m 49 | => Eq a 50 | => StorageInterface a 51 | -> Hook m (UseLocalStorage a) (Either JsonDecodeError a /\ ((Either JsonDecodeError a -> Either JsonDecodeError a) -> HookM m Unit)) 52 | useLocalStorage { key, defaultValue, toJson, fromJson } = Hooks.wrap hook 53 | where 54 | hook :: Hook m (UseLocalStorage' a) _ 55 | hook = Hooks.do 56 | state /\ stateId <- Hooks.useState (Right defaultValue) 57 | let Key k = key 58 | 59 | useInitializer do 60 | storage <- liftEffect (localStorage =<< window) 61 | mbItem <- liftEffect (getItem k storage) 62 | mbItem # maybe 63 | (liftEffect $ setItem k (stringify (toJson defaultValue)) storage) 64 | (\item -> Hooks.modify_ stateId \_ -> parseJson item >>= fromJson) 65 | 66 | useWriteStorage { value: state, key: k } 67 | 68 | Hooks.pure (Tuple state (Hooks.modify_ stateId)) 69 | where 70 | useWriteStorage deps = Hooks.captures deps Hooks.useTickEffect do 71 | liftEffect do 72 | storage <- localStorage =<< window 73 | for_ deps.value \v -> setItem deps.key (stringify (toJson v)) storage 74 | pure Nothing 75 | -------------------------------------------------------------------------------- /examples/Example/Hooks/UsePrevious.purs: -------------------------------------------------------------------------------- 1 | module Example.Hooks.UsePrevious 2 | ( usePrevious 3 | , UsePrevious 4 | ) where 5 | 6 | import Prelude 7 | 8 | import Data.Maybe (Maybe(..)) 9 | import Data.Tuple.Nested ((/\)) 10 | import Effect.Aff.Class (class MonadAff) 11 | import Effect.Class (liftEffect) 12 | import Effect.Ref as Ref 13 | import Halogen.Hooks (class HookNewtype, type (<>), Hook, UseEffect, UseRef) 14 | import Halogen.Hooks as Hooks 15 | 16 | foreign import data UsePrevious :: Type -> Hooks.HookType 17 | 18 | type UsePrevious' a = UseRef (Maybe a) <> UseEffect <> Hooks.Pure 19 | 20 | instance HookNewtype (UsePrevious a) (UsePrevious' a) 21 | 22 | usePrevious :: forall m a. MonadAff m => Eq a => a -> Hook m (UsePrevious a) (Maybe a) 23 | usePrevious value = Hooks.wrap hook 24 | where 25 | hook :: Hook m (UsePrevious' a) _ 26 | hook = Hooks.do 27 | prev /\ ref <- Hooks.useRef Nothing 28 | 29 | Hooks.captures {} Hooks.useTickEffect do 30 | liftEffect $ Ref.write (Just value) ref 31 | pure Nothing 32 | 33 | Hooks.pure prev 34 | -------------------------------------------------------------------------------- /examples/Example/Hooks/UseStateFn.purs: -------------------------------------------------------------------------------- 1 | module Example.Hooks.UseStateFn (useStateFn) where 2 | 3 | import Prelude 4 | 5 | import Data.Tuple.Nested (type (/\)) 6 | import Halogen.Hooks (Hook, StateId, UseState) 7 | import Halogen.Hooks as Hooks 8 | 9 | useStateFn 10 | :: forall state m a 11 | . (StateId state -> a) 12 | -> state 13 | -> Hook m (UseState state) (state /\ a) 14 | useStateFn fn initial = map (map fn) (Hooks.useState initial) 15 | -------------------------------------------------------------------------------- /examples/Example/Hooks/UseWindowWidth.purs: -------------------------------------------------------------------------------- 1 | module Example.Hooks.UseWindowWidth 2 | ( useWindowWidth 3 | , UseWindowWidth 4 | ) where 5 | 6 | import Prelude 7 | 8 | import Data.Maybe (Maybe(..)) 9 | import Data.Tuple.Nested ((/\)) 10 | import Effect.Aff.Class (class MonadAff) 11 | import Effect.Class (liftEffect) 12 | import Halogen as H 13 | import Halogen.Hooks (class HookNewtype, type (<>), Hook, HookM, UseEffect, UseState) 14 | import Halogen.Hooks as Hooks 15 | import Halogen.Query.Event as HE 16 | import Web.Event.Event (EventType(..)) 17 | import Web.Event.Event as Event 18 | import Web.HTML as HTML 19 | import Web.HTML.Window as Window 20 | 21 | foreign import data UseWindowWidth :: Hooks.HookType 22 | 23 | type UseWindowWidth' = UseState (Maybe Int) <> UseEffect <> Hooks.Pure 24 | 25 | instance HookNewtype UseWindowWidth UseWindowWidth' 26 | 27 | useWindowWidth :: forall m. MonadAff m => Hook m UseWindowWidth (Maybe Int) 28 | useWindowWidth = Hooks.wrap hook 29 | where 30 | hook :: Hook m UseWindowWidth' _ 31 | hook = Hooks.do 32 | width /\ widthId <- Hooks.useState Nothing 33 | 34 | Hooks.useLifecycleEffect do 35 | subscription <- subscribeToWindow (Hooks.put widthId) 36 | pure $ Just $ Hooks.unsubscribe subscription 37 | 38 | Hooks.pure width 39 | where 40 | subscribeToWindow :: (Maybe Int -> HookM m Unit) -> HookM m H.SubscriptionId 41 | subscribeToWindow setWidth = do 42 | let readWidth = setWidth <<< Just <=< liftEffect <<< Window.innerWidth 43 | 44 | window <- liftEffect HTML.window 45 | subscriptionId <- Hooks.subscribe do 46 | HE.eventListener 47 | (EventType "resize") 48 | (Window.toEventTarget window) 49 | (Event.target >=> Window.fromEventTarget >>> map readWidth) 50 | 51 | readWidth window 52 | pure subscriptionId 53 | -------------------------------------------------------------------------------- /examples/Example/Main.purs: -------------------------------------------------------------------------------- 1 | module Example.Main where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Data.Tuple.Nested ((/\)) 7 | import Effect (Effect) 8 | import Effect.Aff (Aff) 9 | import Example.Halogen.Basic.Button as Halogen.Basic 10 | import Example.Halogen.Components.Container as Halogen.Components.Container 11 | import Example.Halogen.ComponentsInputs.Container as Halogen.ComponentsInputs.Container 12 | import Example.Halogen.Effects.Random as Halogen.Effects.Random 13 | import Example.Halogen.InputRef.Component as Halogen.InputRef 14 | import Example.Hooks.Components as HookComponents 15 | import Foreign.Object as Object 16 | import Halogen as H 17 | import Halogen.Aff as HA 18 | import Halogen.HTML as HH 19 | import Halogen.HTML.Properties as HP 20 | import Halogen.Hooks as Hooks 21 | import Halogen.Storybook (Stories, runStorybook) 22 | 23 | main :: Effect Unit 24 | main = HA.runHalogenAff do 25 | HA.awaitBody >>= runStorybook 26 | { stories: examples 27 | , logo: Just $ HH.text "Halogen Hooks Examples" 28 | } 29 | 30 | examples :: Stories Aff 31 | examples = 32 | Object.fromFoldable 33 | [ "" /\ index 34 | 35 | -- Examples of writing hooks 36 | , "Hooks|useWindowWidth" /\ HookComponents.windowWidth 37 | , "Hooks|usePreviousValue" /\ HookComponents.previousValue 38 | , "Hooks|useLocalStorage" /\ HookComponents.localStorage 39 | , "Hooks|useDebouncer" /\ HookComponents.debouncer 40 | 41 | -- Examples from the existing Halogen documentation 42 | , "Halogen|Basic" /\ Halogen.Basic.component 43 | , "Halogen|Components" /\ Halogen.Components.Container.component 44 | , "Halogen|Components: Inputs" /\ Halogen.ComponentsInputs.Container.component 45 | , "Halogen|Effects: Random" /\ Halogen.Effects.Random.component 46 | 47 | -- Not quite the Ace component, but the code for Ace is very old and I had 48 | -- trouble getting it to run properly. Still, the point is to demonstrate refs 49 | -- , subscriptions, and queries, and the latter two are covered elsewhere. 50 | , "Halogen|InputRef" /\ Halogen.InputRef.component 51 | ] 52 | where 53 | index :: forall q i o m. H.Component q i o m 54 | index = Hooks.component \_ _ -> Hooks.pure do 55 | HH.div_ 56 | [ HH.h1_ 57 | [ HH.text "Halogen Hooks" ] 58 | , HH.p_ 59 | [ HH.text "See the Halogen Hooks " 60 | , HH.a 61 | [ HP.href "https://github.com/thomashoneyman/purescript-halogen-hooks" ] 62 | [ HH.text "README" ] 63 | , HH.text " for details." 64 | ] 65 | ] 66 | -------------------------------------------------------------------------------- /examples/README.md: -------------------------------------------------------------------------------- 1 | # Halogen Hook Examples 2 | 3 | The examples in this directory demonstrate how to use hooks to build ordinary Halogen components, and also demonstrate a few examples of what you can do with hooks that you couldn't do with regular components. 4 | 5 | ## View live examples 6 | 7 | You can view and test the examples by bundling the project. Run these commands from 8 | the root of the repository: 9 | 10 | ```sh 11 | # Ensure you have installed dependencies 12 | npm install 13 | 14 | # Bundle the examples to ./example/app.js 15 | npm run bundle:examples 16 | ``` 17 | 18 | Open `./examples/index.html` to view the live examples. 19 | 20 | ## Contributing 21 | 22 | I'd love to expand these examples in two ways: 23 | 24 | - Direct comparisons between Hooks-based and ordinary Halogen components 25 | - New custom hooks which showcase Hooks functionality 26 | 27 | Please focus on comparisons and Hooks features that aren't already covered by the existing examples to help prevent these examples from becoming a maintenance burden. 28 | -------------------------------------------------------------------------------- /examples/Storybook.css: -------------------------------------------------------------------------------- 1 | body { 2 | margin: 0; 3 | font-family: sans-serif; 4 | } 5 | 6 | .Storybook { 7 | height: 100vh; 8 | display: grid; 9 | grid-template-areas: 10 | "logo main" 11 | "nav main"; 12 | grid-template-columns: 20rem 1fr; 13 | grid-template-rows: 4rem 1fr; 14 | } 15 | 16 | .Storybook-logo { 17 | grid-area: logo; 18 | display: flex; 19 | align-items: center; 20 | padding-left: 2rem; 21 | text-decoration: none; 22 | background-color: #fafafa; 23 | color: #282828; 24 | border-right: 1px solid rgba(0, 0, 0, 0.08); 25 | border-bottom: 1px solid rgba(0, 0, 0, 0.08); 26 | } 27 | 28 | .Storybook-nav { 29 | grid-area: nav; 30 | overflow-y: auto; 31 | font-size: 0.875rem; 32 | background-color: #fafafa; 33 | border-right: 1px solid rgba(0, 0, 0, 0.08); 34 | } 35 | 36 | .Storybook-nav-list { 37 | list-style: none; 38 | margin: 0; 39 | padding: 0; 40 | } 41 | 42 | .Storybook-nav-section { 43 | margin: 1rem 0; 44 | } 45 | 46 | .Storybook-nav-section-title { 47 | color: #3a3a3a; 48 | text-transform: uppercase; 49 | font-weight: bold; 50 | padding: 0.625rem 2rem; 51 | } 52 | 53 | .Storybook-link { 54 | display: block; 55 | text-decoration: none; 56 | padding: 0.625rem 2rem; 57 | word-wrap: break-word; 58 | color: #282828; 59 | } 60 | 61 | .Storybook-link:hover, 62 | .Storybook-link.is-active { 63 | color: #008cff; 64 | } 65 | 66 | .Storybook-main { 67 | grid-area: main; 68 | padding: 2rem; 69 | overflow: auto; 70 | } 71 | -------------------------------------------------------------------------------- /examples/examples.dhall: -------------------------------------------------------------------------------- 1 | let conf = ../spago.dhall 2 | in conf // 3 | { dependencies = 4 | conf.dependencies # 5 | [ "argonaut" 6 | , "avar" 7 | , "datetime" 8 | , "effect" 9 | , "either" 10 | , "halogen-storybook" 11 | , "profunctor-lenses" 12 | , "random" 13 | , "web-events" 14 | , "web-storage" 15 | ] 16 | , sources = 17 | conf.sources # 18 | [ "examples/**/*.purs" 19 | ] 20 | } 21 | -------------------------------------------------------------------------------- /examples/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | Halogen Hooks 8 | 9 | 10 | 11 | 61 | 62 | 63 | 64 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "easy-purescript-nix": { 4 | "flake": false, 5 | "locked": { 6 | "lastModified": 1661176895, 7 | "narHash": "sha256-fA0HEajsXLgI+dRJBYysFExELU8o/TgRnrm2UAju6Q0=", 8 | "owner": "justinwoo", 9 | "repo": "easy-purescript-nix", 10 | "rev": "5926981701ac781f08b02e31e4705e46b799299d", 11 | "type": "github" 12 | }, 13 | "original": { 14 | "owner": "justinwoo", 15 | "repo": "easy-purescript-nix", 16 | "type": "github" 17 | } 18 | }, 19 | "flake-utils": { 20 | "locked": { 21 | "lastModified": 1659877975, 22 | "narHash": "sha256-zllb8aq3YO3h8B/U0/J1WBgAL8EX5yWf5pMj3G0NAmc=", 23 | "owner": "numtide", 24 | "repo": "flake-utils", 25 | "rev": "c0e246b9b83f637f4681389ecabcb2681b4f3af0", 26 | "type": "github" 27 | }, 28 | "original": { 29 | "owner": "numtide", 30 | "repo": "flake-utils", 31 | "type": "github" 32 | } 33 | }, 34 | "nixpkgs": { 35 | "locked": { 36 | "lastModified": 1662046477, 37 | "narHash": "sha256-4vAIkR0ZaV6M8hhUOCc0m9u/RIV+yM0dgzhkS6lSCI0=", 38 | "owner": "nixos", 39 | "repo": "nixpkgs", 40 | "rev": "907f78efd7547dcf0cec2b50974a3e1ccc6068f8", 41 | "type": "github" 42 | }, 43 | "original": { 44 | "owner": "nixos", 45 | "ref": "release-22.05", 46 | "repo": "nixpkgs", 47 | "type": "github" 48 | } 49 | }, 50 | "root": { 51 | "inputs": { 52 | "easy-purescript-nix": "easy-purescript-nix", 53 | "flake-utils": "flake-utils", 54 | "nixpkgs": "nixpkgs" 55 | } 56 | } 57 | }, 58 | "root": "root", 59 | "version": 7 60 | } 61 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "Halogen Hooks"; 3 | 4 | inputs = { 5 | nixpkgs.url = "github:nixos/nixpkgs/release-22.05"; 6 | flake-utils = { 7 | url = "github:numtide/flake-utils"; 8 | }; 9 | easy-purescript-nix = { 10 | url = "github:justinwoo/easy-purescript-nix"; 11 | flake = false; 12 | }; 13 | }; 14 | 15 | outputs = { self, nixpkgs, easy-purescript-nix, flake-utils, ... }: let 16 | name = "halogen-hooks"; 17 | supportedSystems = ["aarch64-darwin" "x86_64-darwin" "x86_64-linux"]; 18 | in 19 | flake-utils.lib.eachSystem supportedSystems ( 20 | system: let 21 | pkgs = import nixpkgs {inherit system;}; 22 | pursPkgs = import easy-purescript-nix {inherit pkgs;}; 23 | in { 24 | devShells = { 25 | default = pkgs.mkShell { 26 | inherit name; 27 | packages = [ 28 | pkgs.nodejs-16_x 29 | pkgs.esbuild 30 | 31 | pkgs.nodePackages.bower 32 | 33 | pursPkgs.purs 34 | pursPkgs.spago 35 | pursPkgs.purs-tidy 36 | ]; 37 | }; 38 | }; 39 | } 40 | ); 41 | } 42 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "halogen-hooks", 3 | "private": true, 4 | "version": "0.0.1", 5 | "description": "Hooks for Halogen", 6 | "repository": "https://github.com/thomashoneyman/purescript-halogen-hooks", 7 | "author": "Thomas Honeyman ", 8 | "license": "MIT", 9 | "scripts": { 10 | "postinstall": "node node_modules/puppeteer/install.js", 11 | "build": "spago build", 12 | "build:examples": "spago -x examples/examples.dhall build", 13 | "build:test": "spago -x test/test.dhall build", 14 | "snapshot": "npm run bundle:performance && node test/run-snapshot.mjs", 15 | "test": "spago -x test/test.dhall test", 16 | "test:performance": "npm run bundle:performance && node test/run-test.mjs", 17 | "bundle:examples": "spago -x examples/examples.dhall bundle-app --minify --main Example.Main --to examples/app.js", 18 | "bundle:performance": "spago -x test/test.performance.dhall build && purs-backend-es bundle-app --no-build --minify --main Performance.Test.App --to test/test.js" 19 | }, 20 | "devDependencies": { 21 | "filter-console": "^0.1.1", 22 | "headless-devtools": "^2.0.1", 23 | "puppeteer": "^13.7.0", 24 | "purs-backend-es": "^1.1.0", 25 | "tracealyzer": "^0.10.3" 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20220924/packages.dhall 3 | sha256:81067801c9959b544ac870b392b8520d516b32bddaf9c98b32d40037200c071f 4 | 5 | let additions = 6 | { halogen-storybook = 7 | { dependencies = [ "halogen", "routing", "foreign-object" ] 8 | , repo = "https://github.com/rnons/purescript-halogen-storybook.git" 9 | , version = "v2.0.0" 10 | } 11 | } 12 | 13 | in upstream // additions 14 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "halogen-hooks" 2 | , license = "MIT" 3 | , repository = "https://github.com/thomashoneyman/purescript-halogen-hooks" 4 | , dependencies = 5 | [ "aff" 6 | , "arrays" 7 | , "bifunctors" 8 | , "effect" 9 | , "exceptions" 10 | , "foldable-traversable" 11 | , "foreign-object" 12 | , "free" 13 | , "freeap" 14 | , "halogen" 15 | , "halogen-subscriptions" 16 | , "maybe" 17 | , "newtype" 18 | , "ordered-collections" 19 | , "parallel" 20 | , "partial" 21 | , "prelude" 22 | , "refs" 23 | , "tailrec" 24 | , "transformers" 25 | , "tuples" 26 | , "unsafe-coerce" 27 | , "unsafe-reference" 28 | , "web-dom" 29 | , "web-html" 30 | ] 31 | , packages = ./packages.dhall 32 | , sources = [ "src/**/*.purs" ] 33 | } 34 | -------------------------------------------------------------------------------- /src/Halogen/Hooks.purs: -------------------------------------------------------------------------------- 1 | -- | This module implements the entire Halogen Hooks library. It's implemented as 2 | -- | a monolithic module so that only types and functions meant for users are 3 | -- | exported. 4 | module Halogen.Hooks 5 | ( -- Hook API 6 | useState 7 | , UseState 8 | , useLifecycleEffect 9 | , useTickEffect 10 | , UseEffect 11 | , useQuery 12 | , UseQuery 13 | , useMemo 14 | , UseMemo 15 | , useRef 16 | , UseRef 17 | 18 | -- Hook types and helpers 19 | , module Halogen.Hooks.Component 20 | , module Halogen.Hooks.Hook 21 | , module Halogen.Hooks.HookM 22 | , module Halogen.Hooks.Types 23 | 24 | -- Helpers 25 | , captures 26 | , capturesWith 27 | , wrap 28 | ) where 29 | 30 | import Halogen.Hooks.HookM 31 | 32 | import Data.Maybe (Maybe(..)) 33 | import Data.Tuple (Tuple(..)) 34 | import Data.Tuple.Nested ((/\), type (/\)) 35 | import Effect.Ref (Ref) 36 | import Halogen.Hooks.Component (component, memoComponent) 37 | import Halogen.Hooks.Hook (class HookNewtype, type (<>), Hook, HookAppend, Pure, bind, discard, pure) 38 | import Halogen.Hooks.Hook as Hook 39 | import Halogen.Hooks.Internal.Types (MemoValue, QueryValue, RefValue, StateValue, fromMemoValue, fromQueryValue, fromRefValue, fromStateValue, toMemoValue, toMemoValues, toMemoValuesImpl, toRefValue, toStateValue) 40 | import Halogen.Hooks.Internal.UseHookF (UseHookF(..)) 41 | import Halogen.Hooks.Types (ComponentTokens, HookType, MemoValues, OutputToken, QueryToken, SlotToken, StateId) 42 | import Prelude (class Eq, Unit, unit, ($), (<<<), (==)) 43 | import Unsafe.Coerce (unsafeCoerce) 44 | 45 | foreign import data UseState :: Type -> HookType 46 | 47 | -- | A Hook providing an independent state and a unique identifier usable with 48 | -- | the state functions `get`, `put`, `modify`, and `modify_` to update the state. 49 | -- | 50 | -- | ```purs 51 | -- | Hooks.do 52 | -- | -- Create a new state with `useState` 53 | -- | state /\ stateId <- Hooks.useState 0 54 | -- | 55 | -- | -- Perform state updates in `HookM` 56 | -- | let 57 | -- | update :: HookM m Unit 58 | -- | update = 59 | -- | Hooks.modify_ stateId \st -> st + 10 60 | -- | ``` 61 | useState :: forall state m. state -> Hook m (UseState state) (state /\ StateId state) 62 | useState initialState = Hook.unsafeToHook $ UseState initialState' interface 63 | where 64 | initialState' :: StateValue 65 | initialState' = toStateValue initialState 66 | 67 | interface :: Tuple StateValue (StateId StateValue) -> Tuple state (StateId state) 68 | interface (Tuple value id) = Tuple (fromStateValue value) (unsafeCoerce id) 69 | 70 | foreign import data UseEffect :: HookType 71 | 72 | -- | A Hook providing the ability to run an effect the first time the hook is run, 73 | -- | which can return another effect to run the last time the hook is run. This 74 | -- | is equivalent to component initializers and finalizers. 75 | -- | 76 | -- | If you would like to run your effect after every render, see `useTickEffect`. 77 | useLifecycleEffect :: forall m. HookM m (Maybe (HookM m Unit)) -> Hook m UseEffect Unit 78 | useLifecycleEffect fn = Hook.unsafeToHook $ UseEffect Nothing fn unit 79 | 80 | -- | A Hook providing the ability to run an effect after every render, which 81 | -- | includes the first time the hook is run. 82 | -- | 83 | -- | This Hook can be given an array of memo values as a performance optimization. 84 | -- | If the provided array is empty, the effect will run on every render. If the 85 | -- | array contains values, then the effect will only run on renders in which one 86 | -- | or more of the memo values have changed. 87 | -- | 88 | -- | To run an effect on every render: 89 | -- | 90 | -- | ```purs 91 | -- | Hooks.captures {} Hooks.useTickEffect do 92 | -- | ... 93 | -- | ``` 94 | -- | 95 | -- | To run an effect on the first render and when a particular value has changed: 96 | -- | 97 | -- | ```purs 98 | -- | Hooks.captures { memoA, memoB } Hooks.useTickEffect do 99 | -- | ... 100 | -- | ``` 101 | useTickEffect :: forall m. MemoValues -> HookM m (Maybe (HookM m Unit)) -> Hook m UseEffect Unit 102 | useTickEffect memos fn = Hook.unsafeToHook $ UseEffect (Just memos) fn unit 103 | 104 | foreign import data UseQuery :: HookType 105 | 106 | -- | A Hook providing the ability to receive and evaluate queries from a parent 107 | -- | component. Only usable in components constructed with `component`, 108 | -- | not in arbitrary hooks; the request/response nature of queries means they 109 | -- | only make sense in the context of a component. 110 | -- | 111 | -- | If this Hook is used multiple times in a single component definition, only 112 | -- | the last use will take effect. 113 | useQuery 114 | :: forall query m 115 | . QueryToken query 116 | -> (forall a. query a -> HookM m (Maybe a)) 117 | -> Hook m UseQuery Unit 118 | useQuery token handler = Hook.unsafeToHook $ UseQuery token' handler' unit 119 | where 120 | token' :: QueryToken QueryValue 121 | token' = unsafeCoerce token 122 | 123 | handler' :: forall a. QueryValue a -> HookM m (Maybe a) 124 | handler' = handler <<< fromQueryValue 125 | 126 | foreign import data UseMemo :: Type -> HookType 127 | 128 | -- | A Hook providing the ability to memoize a particular value. 129 | -- | 130 | -- | When values are used in let bindings within the body of a Hook they are 131 | -- | recomputed each time the Hook's body is evaluated (on every render). For 132 | -- | values which are expensive to compute, you can either cache them in state 133 | -- | (as you would with an ordinary Halogen component) or you can use `useMemo`. 134 | -- | 135 | -- | All dependencies used to compute the memoized value should be provided to 136 | -- | the `captures` or `capturesWith` function. Consider defining your `useMemo` 137 | -- | Hook in a `where` clause to ensure you don't omit something by accident, 138 | -- | which will lead to stale values. 139 | -- | 140 | -- | ```purs 141 | -- | -- before, computed on every render: 142 | -- | Hooks.do 143 | -- | x /\ _ <- Hooks.useState 0 144 | -- | y /\ _ <- Hooks.useState "" 145 | -- | let expensiveValue = expensiveFunction x y 146 | -- | 147 | -- | -- after, computed only if `x` or `y` have changed: 148 | -- | Hooks.do 149 | -- | x /\ _ <- useState 0 150 | -- | y /\ _ <- useState "" 151 | -- | expensiveValue <- useExpensive x y 152 | -- | ... 153 | -- | where 154 | -- | useExpensive deps@{ x, y } = Hooks.captures deps $ flip Hooks.useMemo \_ -> 155 | -- | expensiveFunction x y 156 | -- | ``` 157 | useMemo :: forall m a. MemoValues -> (Unit -> a) -> Hook m (UseMemo a) a 158 | useMemo memos fn = Hook.unsafeToHook $ UseMemo memos to from 159 | where 160 | to :: Unit -> MemoValue 161 | to = toMemoValue <<< fn 162 | 163 | from :: MemoValue -> a 164 | from = fromMemoValue 165 | 166 | foreign import data UseRef :: Type -> HookType 167 | 168 | -- | A Hook providing the ability to use a mutable reference. 169 | -- | 170 | -- | This Hook returns the value of the mutable reference at the time the Hook 171 | -- | was run, and the reference itself which can be read at any time. The value 172 | -- | of the reference can be used for rendering, but any effectful computations 173 | -- | in `HookM` should read the value of the reference to guarantee an up-to-date 174 | -- | value. 175 | -- | 176 | -- | ```purs 177 | -- | value /\ ref <- Hooks.useRef initialValue 178 | -- | 179 | -- | -- Read and write the ref in effectful code 180 | -- | Hooks.captures {} Hooks.useTickEffect do 181 | -- | current <- liftEffect $ Ref.read ref 182 | -- | -- ... use the current value 183 | -- | 184 | -- | -- Use the last-read value directly in render code 185 | -- | Hooks.pure $ HH.text (show value) 186 | -- | ``` 187 | useRef :: forall m a. a -> Hook m (UseRef a) (a /\ Ref a) 188 | useRef initialValue = Hook.unsafeToHook $ UseRef initialValue' interface 189 | where 190 | initialValue' :: RefValue 191 | initialValue' = toRefValue initialValue 192 | 193 | interface :: RefValue /\ Ref RefValue -> a /\ Ref a 194 | interface (value /\ ref) = fromRefValue value /\ (unsafeCoerce :: Ref RefValue -> Ref a) ref 195 | 196 | -- | Used to improve performance for hooks which may be expensive to run on 197 | -- | many renders (like `useTickEffect` and `useMemo`). Uses a value equality 198 | -- | check to verify values have changed before re-running a function. 199 | -- | 200 | -- | Some values may be expensive to check for value equality. You can optimize 201 | -- | this by only checking a sub-part of your captured values using `capturesWith` 202 | captures :: forall memos a. Eq (Record memos) => Record memos -> (MemoValues -> a) -> a 203 | captures memos fn = fn $ toMemoValues $ toMemoValuesImpl { eq: (==), memos } 204 | 205 | -- | Like `captures`, but without an `Eq` constraint. Use when you only want to 206 | -- | check part of a captured value for equality or when your captured values 207 | -- | don't have Eq instances. 208 | -- | 209 | -- | This function can recreate the usual `captures`: 210 | -- | 211 | -- | ```purs 212 | -- | Hooks.captures { memoA, memoB } == Hooks.capturesWith eq { memoA, memoB } 213 | -- | ``` 214 | -- | 215 | -- | You can also choose to improve performance by testing only a sub-part 216 | -- | of your memoized values. Remember that this equality check is used to 217 | -- | decide whether to re-run your effect or function, so make sure to test 218 | -- | everything in your captures list. 219 | -- | 220 | -- | ```purs 221 | -- | let 222 | -- | customEq memoA memoB = 223 | -- | memoA.user.id == memoB.user.id && memoA.data == memoB.data 224 | -- | 225 | -- | Hooks.capturesWith customEq { user, data } 226 | -- | ``` 227 | capturesWith 228 | :: forall memos a 229 | . (Record memos -> Record memos -> Boolean) 230 | -> Record memos 231 | -> (MemoValues -> a) 232 | -> a 233 | capturesWith memosEq memos fn = 234 | fn $ toMemoValues $ toMemoValuesImpl { eq: memosEq, memos } 235 | 236 | -- | Make a stack of hooks opaque to improve error messages and ensure internal 237 | -- | types like state are not leaked outside the module where the hook is defined. 238 | -- | 239 | -- | We recommend using this for any custom hooks you define. 240 | -- | 241 | -- | ```purs 242 | -- | foreign import data MyHook :: HookType 243 | -- | 244 | -- | instance newtypeMyHook :: HookNewtype MyHook (UseState Int <> Pure) 245 | -- | 246 | -- | useMyHook :: forall m. Hook m MyHook Int 247 | -- | useMyHook = Hooks.wrap Hooks.do 248 | -- | ... -- hook definition goes here 249 | -- | ``` 250 | wrap :: forall h h' m a. HookNewtype h' h => Hook m h a -> Hook m h' a 251 | wrap = unsafeCoerce -- only necessary because we can't use `Newtype` 252 | -------------------------------------------------------------------------------- /src/Halogen/Hooks/Component.purs: -------------------------------------------------------------------------------- 1 | module Halogen.Hooks.Component where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Free (substFree) 6 | import Data.Maybe (Maybe(..)) 7 | import Data.Newtype (over) 8 | import Effect.Ref as Ref 9 | import Effect.Unsafe (unsafePerformEffect) 10 | import Halogen as H 11 | import Halogen.HTML as HH 12 | import Halogen.Hooks.Hook (Hook, unsafeFromHook) 13 | import Halogen.Hooks.HookM (HookM) 14 | import Halogen.Hooks.Internal.Eval as Eval 15 | import Halogen.Hooks.Internal.Eval.Types (HookState(..), toHalogenM) 16 | import Halogen.Hooks.Types (ComponentRef, ComponentTokens, OutputToken, QueryToken, SlotToken) 17 | import Unsafe.Coerce (unsafeCoerce) 18 | 19 | -- | Produces a Halogen component from a `Hook` which returns `ComponentHTML`. 20 | -- | If you need to control whether Hooks evaluate when new input is received, 21 | -- | see `memoComponent`. 22 | -- | 23 | -- | Tokens are provided which enable access to component-only features like 24 | -- | queries, output messages, and child slots, which don't make sense in a pure 25 | -- | Hook context. 26 | -- | 27 | -- | ```purs 28 | -- | myComponent :: forall q i o m. H.Component q i o m 29 | -- | myComponent = Hooks.component \tokens input -> Hooks.do 30 | -- | ... hook implementation 31 | -- | ``` 32 | -- | 33 | -- | If you don't need to use tokens or input, you can use underscores to throw 34 | -- | away those arguments. 35 | -- | 36 | -- | ```purs 37 | -- | myComponent :: forall q i o m. H.Component q i o m 38 | -- | myComponent = Hooks.component \_ _ -> Hooks.do 39 | -- | ... hook implementation 40 | -- | ``` 41 | -- | 42 | -- | If you are using tokens provided by the `component` function, you will have 43 | -- | better type inference if you annotate the token type: 44 | -- | 45 | -- | ```purs 46 | -- | type Tokens = Hooks.ComponentTokens MyQuery MySlots MyOutput 47 | -- | 48 | -- | myComponent :: forall i m. H.Component MyQuery i MyOutput m 49 | -- | myComponent = Hooks.component \(tokens :: Tokens) _ -> Hooks.do 50 | -- | ... hook implementation 51 | -- | 52 | -- | Use type variables to substitue unused token types: 53 | -- | 54 | -- | ```purs 55 | -- | type Tokens s o = Hooks.ComponentTokens MyQuery s o 56 | -- | 57 | -- | myComponent :: forall i o m. H.Component MyQuery i o m 58 | -- | myComponent = Hooks.component \(tokens :: Tokens _ o) _ -> Hooks.do 59 | -- | ... hook implementation 60 | -- | ``` 61 | component 62 | :: forall hooks q i s o m 63 | . (ComponentTokens q s o -> i -> Hook m hooks (H.ComponentHTML (HookM m Unit) s m)) 64 | -> H.Component q i o m 65 | component = memoComponent (\_ _ -> false) 66 | 67 | -- | A version of `component` which allows you to decide whether or not to send 68 | -- | new input to the hook function based on an equality predicate. Halogen 69 | -- | components send input to children on each render, which can cause a 70 | -- | performance issue in some cases. 71 | -- | 72 | -- | ```purs 73 | -- | myComponent :: forall q o m. H.Component q Int o m 74 | -- | myComponent = Hooks.memoComponent eq \tokens input -> Hooks.do 75 | -- | -- This hook implementation will not run when it receives new input 76 | -- | -- unless the `Int` has changed. 77 | -- | ``` 78 | -- | 79 | -- | Some input data may be more expensive to compute equality for than to simply 80 | -- | send input again. In these cases you may want to write a more sophisticated 81 | -- | equality function -- for example, only checking by a unique ID. 82 | -- | 83 | -- | ```purs 84 | -- | type User = { uuid :: Int, info :: HugeObject } 85 | -- | 86 | -- | eqUser :: User -> User -> Boolean 87 | -- | eqUser userA userB = userA.uuid == userB.uuid 88 | -- | 89 | -- | myComponent :: forall q o m. H.Component q User o m 90 | -- | myComponent = Hooks.memoComponent eqUser \_ input -> Hooks.do 91 | -- | -- This hook implementation will not run when it receives new input 92 | -- | -- unless the `User`'s id has changed. 93 | -- | ``` 94 | memoComponent 95 | :: forall hooks q i s o m 96 | . (i -> i -> Boolean) 97 | -> (ComponentTokens q s o -> i -> Hook m hooks (H.ComponentHTML (HookM m Unit) s m)) 98 | -> H.Component q i o m 99 | memoComponent eqInput inputHookFn = do 100 | let 101 | queryToken = unsafeCoerce {} :: QueryToken q 102 | slotToken = unsafeCoerce {} :: SlotToken s 103 | outputToken = unsafeCoerce {} :: OutputToken o 104 | hookFn = inputHookFn { queryToken, slotToken, outputToken } 105 | 106 | -- WARNING: If you update this function, make sure to apply the same update 107 | -- to the tests, which use their own version of this function. The test function 108 | -- should be identical, except with the addition of logging. 109 | evalHook reason = do 110 | HookState { stateRef } <- H.get 111 | 112 | let 113 | eval = Eval.evalHook Eval.evalHookM evalHook reason stateRef 114 | { input } = unsafePerformEffect $ Ref.read stateRef 115 | hookF = unsafeFromHook (hookFn input) 116 | 117 | a <- H.HalogenM (substFree eval hookF) 118 | 119 | H.modify_ (over HookState _ { result = a }) 120 | pure a 121 | 122 | H.mkComponent 123 | { initialState 124 | , render: \(HookState { result }) -> result 125 | , eval: toHalogenM slotToken outputToken <<< Eval.mkEval eqInput Eval.evalHookM evalHook 126 | } 127 | where 128 | initialState input = 129 | HookState 130 | { result: HH.text "" 131 | , stateRef: unsafePerformEffect $ Ref.new 132 | { input 133 | , componentRef: unsafeCoerce {} :: ComponentRef 134 | , queryFn: Nothing 135 | , stateCells: { queue: [], index: 0 } 136 | , effectCells: { queue: [], index: 0 } 137 | , memoCells: { queue: [], index: 0 } 138 | , refCells: { queue: [], index: 0 } 139 | , evalQueue: [] 140 | , stateDirty: false 141 | } 142 | } 143 | -------------------------------------------------------------------------------- /src/Halogen/Hooks/Hook.purs: -------------------------------------------------------------------------------- 1 | module Halogen.Hooks.Hook 2 | ( Hook 3 | , HookAppend 4 | , type (<>) 5 | , Pure 6 | , class HookNewtype 7 | , bind 8 | , discard 9 | , pure 10 | , unsafeFromHook 11 | , unsafeToHook 12 | ) where 13 | 14 | import Prelude hiding (bind, discard, pure) 15 | 16 | import Control.Applicative as Applicative 17 | import Control.Monad.Free (Free, liftF) 18 | import Halogen.Hooks.Internal.UseHookF (UseHookF) 19 | import Halogen.Hooks.Types (HookType) 20 | 21 | -- | A function which has access to primitive and custom hooks like UseState, 22 | -- | UseEffect, UseRef, and UseMemo. Hook functions can be used to implement 23 | -- | reusable, stateful logic and to implement Halogen components. 24 | -- | 25 | -- | Functions of this type should be constructed using the Hooks API exposed 26 | -- | by `Halogen.Hooks`. 27 | newtype Hook :: (Type -> Type) -> HookType -> Type -> Type 28 | newtype Hook m h a = Hook (Free (UseHookF m) a) 29 | 30 | type role Hook representational nominal representational 31 | 32 | derive instance Functor (Hook m h) 33 | 34 | unsafeToHook :: forall m h a. UseHookF m a -> Hook m h a 35 | unsafeToHook = Hook <<< liftF 36 | 37 | unsafeFromHook :: forall m h a. Hook m h a -> Free (UseHookF m) a 38 | unsafeFromHook (Hook hookF) = hookF 39 | 40 | -- | A type for listing several Hook types in order. Typically this is used via 41 | -- | the operator `<>`. 42 | -- | 43 | -- | ```purs` 44 | -- | import Halogen.Hooks (type (<>)) 45 | -- | 46 | -- | type UseStateEffect = UseState Int <> UseEffect <> Pure 47 | -- | 48 | -- | -- using to the 49 | -- | type UseStateEffect = HookAppend (UseState Int) (HookAppend UseEffect Nil) 50 | -- | ``` 51 | foreign import data HookAppend :: HookType -> HookType -> HookType 52 | 53 | -- | `HookAppend` as an infix operator 54 | infixr 1 type HookAppend as <> 55 | 56 | -- | The `HookType` used for `pure`, which lifts an arbitrary value into `Hook`. 57 | -- | 58 | -- | ```purs` 59 | -- | type UseX = UseState Int <> UseEffect <> Pure 60 | -- | ``` 61 | foreign import data Pure :: HookType 62 | 63 | -- | A class for asserting that one `HookType` can be "unwrapped" to produce 64 | -- | the other. This class is used to turn a list of Hooks into a new opaque 65 | -- | Hook in conjunction with `wrap`: 66 | -- | 67 | -- | ```purs 68 | -- | foreign import data UseX :: HookType 69 | -- | 70 | -- | instance newtypeUseX :: HookNewtype UseX (UseState Int <> UseEffect <> Pure) 71 | -- | 72 | -- | useX :: forall m. Hook m UseX Int 73 | -- | useX = Hooks.wrap Hooks.do 74 | -- | -- ... use useState, useEffect in the implementation 75 | -- | ``` 76 | class HookNewtype (a :: HookType) (b :: HookType) | a -> b 77 | 78 | -- | For use with qualified-do. 79 | -- | 80 | -- | ```purs 81 | -- | import Halogen.Hooks as Hooks 82 | -- | 83 | -- | useMyHook = Hooks.do 84 | -- | -- bind is necessary to use do-syntax with Hooks 85 | -- | ... <- Hooks.useState ... 86 | -- | ``` 87 | bind :: forall h h' m a b. Hook m h a -> (a -> Hook m h' b) -> Hook m (h <> h') b 88 | bind (Hook ma) f = Hook $ ma >>= \a -> case f a of Hook mb -> mb 89 | 90 | -- | For use with qualified-do. 91 | -- | 92 | -- | ```purs 93 | -- | import Halogen.Hooks as Hooks 94 | -- | 95 | -- | useMyHook = Hooks.do 96 | -- | ... 97 | -- | -- discard is necessary to use do-syntax with Hooks 98 | -- | Hooks.useLifecycleEffect ... 99 | -- | ``` 100 | discard :: forall h h' m a. Hook m h Unit -> (Unit -> Hook m h' a) -> Hook m (h <> h') a 101 | discard = bind 102 | 103 | -- | For use with qualified-do: 104 | -- | 105 | -- | ```purs 106 | -- | import Halogen.Hooks as Hooks 107 | -- | 108 | -- | useMyHook = Hooks.do 109 | -- | ... 110 | -- | Hooks.pure ... 111 | -- | ``` 112 | pure :: forall h m a. a -> Hook m h a 113 | pure = Hook <<< Applicative.pure 114 | -------------------------------------------------------------------------------- /src/Halogen/Hooks/HookM.purs: -------------------------------------------------------------------------------- 1 | -- | A replacement for `Halogen.Query.HalogenM` which supports a near-identical 2 | -- | API, but adjusted for compatibility with hooks. All functions available in 3 | -- | `HalogenM` are still available here, but some have modified behavior (for 4 | -- | example, the state functions `get`, `put`, and `modify` take a state 5 | -- | identifier as their first argument). 6 | module Halogen.Hooks.HookM where 7 | 8 | import Prelude 9 | 10 | import Control.Applicative.Free (FreeAp, liftFreeAp) 11 | import Control.Monad.Error.Class (class MonadThrow, throwError) 12 | import Control.Monad.Free (Free, liftF) 13 | import Control.Monad.Reader (class MonadAsk, class MonadTrans, ask) 14 | import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM) 15 | import Control.Monad.Writer (class MonadTell) 16 | import Control.Monad.Writer as MR 17 | import Control.Parallel (class Parallel) 18 | import Data.FoldableWithIndex (foldrWithIndex) 19 | import Data.Map (Map) 20 | import Data.Map as Map 21 | import Data.Maybe (Maybe(..), maybe) 22 | import Data.Newtype (class Newtype) 23 | import Data.Symbol (class IsSymbol) 24 | import Data.Traversable (traverse) 25 | import Effect.Aff.Class (class MonadAff, liftAff) 26 | import Effect.Class (class MonadEffect, liftEffect) 27 | import Halogen (Request, Tell, mkRequest, mkTell) 28 | import Halogen as H 29 | import Halogen.Data.Slot as Slot 30 | import Halogen.Hooks.Internal.Types (OutputValue, SlotType, StateValue, fromStateValue, toOutputValue, toStateValue) 31 | import Halogen.Hooks.Types (OutputToken, SlotToken, StateId) 32 | import Halogen.Query.ChildQuery as CQ 33 | import Halogen.Subscription as HS 34 | import Prim.Row as Row 35 | import Type.Proxy (Proxy) 36 | import Unsafe.Coerce (unsafeCoerce) 37 | import Web.DOM as DOM 38 | import Web.HTML as HTML 39 | import Web.HTML.HTMLElement as HTMLElement 40 | 41 | -- | A DSL compatible with HalogenM which is used to write effectful code 42 | -- | for Hooks. 43 | data HookF m a 44 | = Modify (StateId StateValue) (StateValue -> StateValue) (StateValue -> a) 45 | | Subscribe (H.SubscriptionId -> HS.Emitter (HookM m Unit)) (H.SubscriptionId -> a) 46 | | Unsubscribe H.SubscriptionId a 47 | | Lift (m a) 48 | | ChildQuery (CQ.ChildQueryBox SlotType a) 49 | | Raise OutputValue a 50 | | Par (HookAp m a) 51 | | Fork (HookM m Unit) (H.ForkId -> a) 52 | | Kill H.ForkId a 53 | | GetRef H.RefLabel (Maybe DOM.Element -> a) 54 | 55 | derive instance Functor m => Functor (HookF m) 56 | 57 | -- | The Hook effect monad, used to write effectful code in Hooks functions. 58 | -- | This monad is fully compatible with `HalogenM`, meaning all functionality 59 | -- | available for `HalogenM` is available in `HookM`. 60 | newtype HookM m a = HookM (Free (HookF m) a) 61 | 62 | derive newtype instance Functor (HookM m) 63 | derive newtype instance Apply (HookM m) 64 | derive newtype instance Applicative (HookM m) 65 | derive newtype instance Bind (HookM m) 66 | derive newtype instance Monad (HookM m) 67 | derive newtype instance Semigroup a => Semigroup (HookM m a) 68 | derive newtype instance Monoid a => Monoid (HookM m a) 69 | 70 | instance MonadEffect m => MonadEffect (HookM m) where 71 | liftEffect = HookM <<< liftF <<< Lift <<< liftEffect 72 | 73 | instance MonadAff m => MonadAff (HookM m) where 74 | liftAff = HookM <<< liftF <<< Lift <<< liftAff 75 | 76 | instance MonadTrans HookM where 77 | lift = HookM <<< liftF <<< Lift 78 | 79 | instance MonadRec (HookM m) where 80 | tailRecM k a = k a >>= case _ of 81 | Loop x -> tailRecM k x 82 | Done y -> pure y 83 | 84 | instance MonadAsk r m => MonadAsk r (HookM m) where 85 | ask = HookM $ liftF $ Lift ask 86 | 87 | instance MonadTell w m => MonadTell w (HookM m) where 88 | tell = HookM <<< liftF <<< Lift <<< MR.tell 89 | 90 | instance MonadThrow e m => MonadThrow e (HookM m) where 91 | throwError = HookM <<< liftF <<< Lift <<< throwError 92 | 93 | -- | An applicative-only version of `HookM` to allow for parallel evaluation. 94 | newtype HookAp m a = HookAp (FreeAp (HookM m) a) 95 | 96 | derive instance Newtype (HookAp m a) _ 97 | derive newtype instance Functor (HookAp m) 98 | derive newtype instance Apply (HookAp m) 99 | derive newtype instance Applicative (HookAp m) 100 | 101 | instance Parallel (HookAp m) (HookM m) where 102 | parallel = HookAp <<< liftFreeAp 103 | sequential = HookM <<< liftF <<< Par 104 | 105 | -- | Get a piece of state using an identifier received from the `useState` hook. 106 | -- | 107 | -- | ```purs 108 | -- | _ /\ countId :: StateId Int <- Hooks.useState 0 109 | -- | 110 | -- | let 111 | -- | onClick = do 112 | -- | count :: Int <- Hooks.get countId 113 | -- | ... 114 | -- | ``` 115 | get :: forall state m. StateId state -> HookM m state 116 | get identifier = modify identifier identity 117 | 118 | -- | Modify a piece of state using an identifier received from the `useState` hook. 119 | -- | 120 | -- | ```purs 121 | -- | _ /\ countId :: StateId Int <- Hooks.useState 0 122 | -- | 123 | -- | let 124 | -- | onClick = do 125 | -- | Hooks.modify_ countId (_ + 10) 126 | -- | ``` 127 | modify_ :: forall state m. StateId state -> (state -> state) -> HookM m Unit 128 | modify_ identifier = map (const unit) <<< modify identifier 129 | 130 | -- | Modify a piece of state using an identifier received from the `useState` hook, 131 | -- | returning the new state. 132 | -- | 133 | -- | ```purs 134 | -- | _ /\ countId :: StateId Int <- Hooks.useState 0 135 | -- | 136 | -- | let 137 | -- | onClick = do 138 | -- | count :: Int <- Hooks.modify countId (_ + 10) 139 | -- | ... 140 | -- | ``` 141 | modify :: forall state m. StateId state -> (state -> state) -> HookM m state 142 | modify identifier f = HookM $ liftF $ Modify identifier' f' state 143 | where 144 | identifier' :: StateId StateValue 145 | identifier' = unsafeCoerce identifier 146 | 147 | f' :: StateValue -> StateValue 148 | f' = toStateValue <<< f <<< fromStateValue 149 | 150 | state :: StateValue -> state 151 | state = fromStateValue 152 | 153 | -- | Overwrite a piece of state using an identifier received from the `useState` hook. 154 | -- | 155 | -- | ```purs 156 | -- | _ /\ countId :: StateId Int <- Hooks.useState 0 157 | -- | 158 | -- | let 159 | -- | onClick = do 160 | -- | Hooks.put countId 10 161 | -- | ``` 162 | put :: forall state m. StateId state -> state -> HookM m Unit 163 | put identifier state = modify_ identifier (const state) 164 | 165 | -- | Raise an output message for the component. Requires a token carrying the 166 | -- | output type of the component, which is provided by the `Hooks.component` 167 | -- | function. 168 | raise :: forall o m. OutputToken o -> o -> HookM m Unit 169 | raise _ o = HookM $ liftF $ Raise (toOutputValue o) unit 170 | 171 | -- | Send a query to a child of a component at the specified slot. Requires a 172 | -- | token carrying the slot type of the component, which is provided by the 173 | -- | `Hooks.component` function. 174 | query 175 | :: forall m label ps query o' slot a _1 176 | . Row.Cons label (H.Slot query o' slot) _1 ps 177 | => IsSymbol label 178 | => Ord slot 179 | => SlotToken ps 180 | -> Proxy label 181 | -> slot 182 | -> query a 183 | -> HookM m (Maybe a) 184 | query _ label p q = 185 | HookM $ liftF $ ChildQuery $ box $ CQ.mkChildQueryBox do 186 | CQ.ChildQuery (\k -> maybe (pure Nothing) k <<< Slot.lookup label p) q identity 187 | where 188 | box :: CQ.ChildQueryBox ps ~> CQ.ChildQueryBox SlotType 189 | box = unsafeCoerce 190 | 191 | -- | Send a query-request to a child of a component at the specified slot. Requires a 192 | -- | token carrying the slot type of the component, which is provided by the 193 | -- | `Hooks.component` function. 194 | request 195 | :: forall m label ps query o' slot a _1 196 | . Row.Cons label (H.Slot query o' slot) _1 ps 197 | => IsSymbol label 198 | => Ord slot 199 | => SlotToken ps 200 | -> Proxy label 201 | -> slot 202 | -> Request query a 203 | -> HookM m (Maybe a) 204 | request slotToken label slot req = query slotToken label slot $ mkRequest req 205 | 206 | -- | Send a tell-request to a child of a component at the specified slot. Requires a 207 | -- | token carrying the slot type of the component, which is provided by the 208 | -- | `Hooks.component` function. 209 | tell 210 | :: forall m label ps query o' slot _1 211 | . Row.Cons label (H.Slot query o' slot) _1 ps 212 | => IsSymbol label 213 | => Ord slot 214 | => SlotToken ps 215 | -> Proxy label 216 | -> slot 217 | -> Tell query 218 | -> HookM m Unit 219 | tell slotToken label slot req = void $ query slotToken label slot $ mkTell req 220 | 221 | -- | Send a query to all children of a component at the specified slot. Requires 222 | -- | a token carrying the slot type of the component, which is provided by the 223 | -- | `Hooks.component` function. 224 | queryAll 225 | :: forall m label ps query o' slot a _1 226 | . Row.Cons label (H.Slot query o' slot) _1 ps 227 | => IsSymbol label 228 | => Ord slot 229 | => SlotToken ps 230 | -> Proxy label 231 | -> query a 232 | -> HookM m (Map slot a) 233 | queryAll _ label q = 234 | HookM $ liftF $ ChildQuery $ box $ CQ.mkChildQueryBox do 235 | CQ.ChildQuery (\k -> map catMapMaybes <<< traverse k <<< Slot.slots label) q identity 236 | where 237 | box :: CQ.ChildQueryBox ps ~> CQ.ChildQueryBox SlotType 238 | box = unsafeCoerce 239 | 240 | catMapMaybes :: forall k v. Ord k => Map k (Maybe v) -> Map k v 241 | catMapMaybes = foldrWithIndex (\k v acc -> maybe acc (flip (Map.insert k) acc) v) Map.empty 242 | 243 | -- | Subscribes a component to an `Emitter`. When a component is disposed of 244 | -- | any active subscriptions will automatically be stopped and no further subscriptions 245 | -- | will be possible during finalization. 246 | subscribe :: forall m. HS.Emitter (HookM m Unit) -> HookM m H.SubscriptionId 247 | subscribe es = HookM $ liftF $ Subscribe (\_ -> es) identity 248 | 249 | -- | An alternative to `subscribe`, intended for subscriptions that unsubscribe 250 | -- | themselves. Instead of returning the `SubscriptionId` from `subscribe'`, it 251 | -- | is passed into an `Emitter` constructor. This allows emitted queries 252 | -- | to include the `SubscriptionId`, rather than storing it in the state of the 253 | -- | component. 254 | -- | 255 | -- | When a component is disposed of any active subscriptions will automatically 256 | -- | be stopped and no further subscriptions will be possible during 257 | -- | finalization. 258 | subscribe' :: forall m. (H.SubscriptionId -> HS.Emitter (HookM m Unit)) -> HookM m Unit 259 | subscribe' esc = HookM $ liftF $ Subscribe esc (const unit) 260 | 261 | -- | Unsubscribes a component from an `Emitter`. If the subscription 262 | -- | associated with the ID has already ended this will have no effect. 263 | unsubscribe :: forall m. H.SubscriptionId -> HookM m Unit 264 | unsubscribe sid = HookM $ liftF $ Unsubscribe sid unit 265 | 266 | -- | Starts a `HalogenM` process running independent from the current `eval` 267 | -- | "thread". 268 | -- | 269 | -- | A commonly use case for `fork` is in component initializers where some 270 | -- | async action is started. Normally all interaction with the component will 271 | -- | be blocked until the initializer completes, but if the async action is 272 | -- | `fork`ed instead, the initializer can complete synchronously while the 273 | -- | async action continues. 274 | -- | 275 | -- | Some care needs to be taken when using a `fork` that can modify the 276 | -- | component state, as it's easy for the forked process to "clobber" the state 277 | -- | (overwrite some or all of it with an old value) by mistake. 278 | -- | 279 | -- | When a component is disposed of any active forks will automatically 280 | -- | be killed. New forks can be started during finalization but there will be 281 | -- | no means of killing them. 282 | fork :: forall m. HookM m Unit -> HookM m H.ForkId 283 | fork fn = HookM $ liftF $ Fork fn identity 284 | 285 | -- | Kills a forked process if it is still running. Attempting to kill a forked 286 | -- | process that has already ended will have no effect. 287 | kill :: forall m. H.ForkId -> HookM m Unit 288 | kill fid = HookM $ liftF $ Kill fid unit 289 | 290 | -- | Retrieves an `Element` value that is associated with a `Ref` in the 291 | -- | rendered o of a component. If there is no currently rendered value for 292 | -- | the requested ref this will return `Nothing`. 293 | getRef :: forall m. H.RefLabel -> HookM m (Maybe DOM.Element) 294 | getRef p = HookM $ liftF $ GetRef p identity 295 | 296 | -- | Retrieves a `HTMLElement` value that is associated with a `Ref` in the 297 | -- | rendered o of a component. If there is no currently rendered value (or 298 | -- | it is not an `HTMLElement`) for the request will return `Nothing`. 299 | getHTMLElementRef :: forall m. H.RefLabel -> HookM m (Maybe HTML.HTMLElement) 300 | getHTMLElementRef = map (HTMLElement.fromElement =<< _) <<< getRef 301 | -------------------------------------------------------------------------------- /src/Halogen/Hooks/Internal/Eval/Types.purs: -------------------------------------------------------------------------------- 1 | module Halogen.Hooks.Internal.Eval.Types where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe) 6 | import Data.Newtype (class Newtype) 7 | import Data.Tuple.Nested (type (/\)) 8 | import Effect.Ref (Ref) 9 | import Halogen as H 10 | import Halogen.Hooks.HookM (HookM) 11 | import Halogen.Hooks.Internal.Types (MemoValue, OutputValue, RefValue, SlotType, StateValue) 12 | import Halogen.Hooks.Types (ComponentRef, MemoValues, OutputToken, SlotToken) 13 | import Unsafe.Coerce (unsafeCoerce) 14 | 15 | type HalogenM' q i m b a = H.HalogenM (HookState q i m b) (HookM m Unit) SlotType OutputValue m a 16 | 17 | toHalogenM 18 | :: forall q i ps o m b a 19 | . SlotToken ps 20 | -> OutputToken o 21 | -> HalogenM' q i m b a 22 | -> H.HalogenM (HookState q i m b) (HookM m Unit) ps o m a 23 | toHalogenM _ _ hm = unsafeCoerce hm 24 | 25 | data InterpretHookReason 26 | = Initialize 27 | | Queued 28 | | Step 29 | | Finalize 30 | 31 | derive instance Eq InterpretHookReason 32 | 33 | foreign import data QueryFn :: (Type -> Type) -> (Type -> Type) -> Type 34 | 35 | toQueryFn :: forall q m. (forall a. q a -> HookM m (Maybe a)) -> QueryFn q m 36 | toQueryFn = unsafeCoerce 37 | 38 | fromQueryFn :: forall q m. QueryFn q m -> (forall a. q a -> HookM m (Maybe a)) 39 | fromQueryFn = unsafeCoerce 40 | 41 | newtype HookState q i m a = HookState 42 | { result :: a 43 | , stateRef :: Ref (InternalHookState q i m a) 44 | } 45 | 46 | derive instance Newtype (HookState q i m a) _ 47 | 48 | type InternalHookState q i m a = 49 | { input :: i 50 | , componentRef :: ComponentRef 51 | , queryFn :: Maybe (QueryFn q m) 52 | , evalQueue :: Array (H.HalogenM (HookState q i m a) (HookM m Unit) SlotType OutputValue m Unit) 53 | , stateCells :: QueueState StateValue 54 | , effectCells :: QueueState ((Maybe MemoValues) /\ HookM m Unit) 55 | , memoCells :: QueueState (MemoValues /\ MemoValue) 56 | , refCells :: QueueState (Ref RefValue) 57 | , stateDirty :: Boolean 58 | } 59 | 60 | type QueueState a = 61 | { queue :: Array a 62 | , index :: Int 63 | } 64 | -------------------------------------------------------------------------------- /src/Halogen/Hooks/Internal/Types.js: -------------------------------------------------------------------------------- 1 | export function _memoValuesImpl (eq) { 2 | return function (memos) { 3 | return { eq, memos } 4 | } 5 | } 6 | -------------------------------------------------------------------------------- /src/Halogen/Hooks/Internal/Types.purs: -------------------------------------------------------------------------------- 1 | module Halogen.Hooks.Internal.Types where 2 | 3 | import Halogen.Hooks.Types 4 | import Foreign.Object (Object) 5 | import Unsafe.Coerce (unsafeCoerce) 6 | 7 | foreign import data StateValue :: Type 8 | 9 | toStateValue :: forall state. state -> StateValue 10 | toStateValue = unsafeCoerce 11 | 12 | fromStateValue :: forall state. StateValue -> state 13 | fromStateValue = unsafeCoerce 14 | 15 | foreign import data QueryValue :: Type -> Type 16 | 17 | toQueryValue :: forall q a. q a -> QueryValue a 18 | toQueryValue = unsafeCoerce 19 | 20 | fromQueryValue :: forall q a. QueryValue a -> q a 21 | fromQueryValue = unsafeCoerce 22 | 23 | foreign import data SlotType :: Row Type 24 | 25 | foreign import data OutputValue :: Type 26 | 27 | toOutputValue :: forall output. output -> OutputValue 28 | toOutputValue = unsafeCoerce 29 | 30 | fromOutputValue :: forall output. OutputValue -> output 31 | fromOutputValue = unsafeCoerce 32 | 33 | foreign import data MemoValue :: Type 34 | 35 | type MemoValuesImpl = 36 | { eq :: Object MemoValue -> Object MemoValue -> Boolean 37 | , memos :: Object MemoValue 38 | } 39 | 40 | foreign import _memoValuesImpl :: forall r. (Record r -> Record r -> Boolean) -> Record r -> MemoValuesImpl 41 | 42 | toMemoValuesImpl 43 | :: forall memos 44 | . { eq :: Record memos -> Record memos -> Boolean, memos :: Record memos } 45 | -> MemoValuesImpl 46 | toMemoValuesImpl { eq, memos } = _memoValuesImpl eq memos 47 | 48 | toMemoValues :: MemoValuesImpl -> MemoValues 49 | toMemoValues = unsafeCoerce 50 | 51 | fromMemoValues :: MemoValues -> MemoValuesImpl 52 | fromMemoValues = unsafeCoerce 53 | 54 | toMemoValue :: forall memo. memo -> MemoValue 55 | toMemoValue = unsafeCoerce 56 | 57 | fromMemoValue :: forall memo. MemoValue -> memo 58 | fromMemoValue = unsafeCoerce 59 | 60 | foreign import data RefValue :: Type 61 | 62 | toRefValue :: forall a. a -> RefValue 63 | toRefValue = unsafeCoerce 64 | 65 | fromRefValue :: forall a. RefValue -> a 66 | fromRefValue = unsafeCoerce 67 | -------------------------------------------------------------------------------- /src/Halogen/Hooks/Internal/UseHookF.purs: -------------------------------------------------------------------------------- 1 | module Halogen.Hooks.Internal.UseHookF where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe) 6 | import Data.Tuple.Nested (type (/\)) 7 | import Effect.Ref (Ref) 8 | import Halogen.Hooks.HookM (HookM) 9 | import Halogen.Hooks.Internal.Types (MemoValue, QueryValue, RefValue, StateValue) 10 | import Halogen.Hooks.Types (MemoValues, QueryToken, StateId) 11 | 12 | -- | The Hook API: a set of primitive building blocks for writing stateful logic 13 | -- | in Halogen. These should not be used directly; the hook functions supplied 14 | -- | in `Hooks` should be used instead. 15 | data UseHookF m a 16 | = UseState StateValue ((StateValue /\ StateId StateValue) -> a) 17 | | UseEffect (Maybe MemoValues) (HookM m (Maybe (HookM m Unit))) a 18 | | UseQuery (QueryToken QueryValue) (forall b. QueryValue b -> HookM m (Maybe b)) a 19 | | UseMemo MemoValues (Unit -> MemoValue) (MemoValue -> a) 20 | | UseRef RefValue ((RefValue /\ Ref RefValue) -> a) 21 | 22 | derive instance Functor (UseHookF m) 23 | -------------------------------------------------------------------------------- /src/Halogen/Hooks/Types.purs: -------------------------------------------------------------------------------- 1 | module Halogen.Hooks.Types where 2 | 3 | import Data.Tuple (Tuple) 4 | 5 | -- | The kind of types used in Hooks; primitive Hooks already have this kind, 6 | -- | and Hooks of your own should be foreign imported data types that are also 7 | -- | types of this kind: 8 | -- | 9 | -- | ```purs 10 | -- | foreign import data UseX :: Hooks.HookType 11 | -- | ``` 12 | data HookType 13 | 14 | -- | A unique identifier for a state produced by `useState`, which can be passed 15 | -- | to the state functions `get`, `put`, `modify`, and `modify_` to get or 16 | -- | modify the state. 17 | -- | 18 | -- | This token should NOT be modified. 19 | -- | 20 | -- | ```purs 21 | -- | state /\ stateId <- useState 0 22 | -- | 23 | -- | let 24 | -- | handler = Hooks.modify_ stateId (_ + 10) 25 | -- | ``` 26 | newtype StateId :: Type -> Type 27 | newtype StateId state = StateId (Tuple ComponentRef Int) 28 | 29 | -- | A unique reference for a component, which is used to track which component 30 | -- | Hooks code is defined in to ensure that it isn't run in another component 31 | -- | (this is unsafe, and doing so will throw an exception). 32 | data ComponentRef 33 | 34 | -- | The set of tokens enabling queries, child slots, and output messages when 35 | -- | running a Hook as a component. This set of tokens is provided by the 36 | -- | `Hooks.component` function. 37 | -- | 38 | -- | Hooks do not have a notion of parent / child relationships, and Halogen 39 | -- | features like queries and outputs don't make sense in the context of Hooks. 40 | -- | These tokens enable those features for Hooks which are being turned into 41 | -- | components, while ensuring Hooks which are being nested are not able to 42 | -- | access those features. 43 | type ComponentTokens :: (Type -> Type) -> Row Type -> Type -> Type 44 | type ComponentTokens q ps o = 45 | { queryToken :: QueryToken q 46 | , slotToken :: SlotToken ps 47 | , outputToken :: OutputToken o 48 | } 49 | 50 | -- | A token which carries the type of queries supported by the component which 51 | -- | is executing a Hook. Queries are specific to the parent-child component 52 | -- | relationship, and so they are not tracked in Hook types. 53 | -- | 54 | -- | This token is provided by the `component` function. 55 | data QueryToken (a :: Type -> Type) 56 | 57 | -- | A token which carries the type of child slots supported by the component 58 | -- | which is executing a Hook. Child slots are specific to the parent-child 59 | -- | component relationship, and so they are not tracked in Hook types. 60 | -- | 61 | -- | This token is provided by the `component` function. 62 | data SlotToken (slots :: Row Type) 63 | 64 | -- | A token which carries the type of outputs supported by the component 65 | -- | which is executing a Hook. Output messages slots are specific to the 66 | -- | parent-child component relationship, and so they are not tracked in 67 | -- | Hook types. 68 | -- | 69 | -- | This token is provided by the `component` function. 70 | data OutputToken :: Type -> Type 71 | data OutputToken output 72 | 73 | -- | An opaque type which signifies that a set of dependencies have been captured 74 | -- | and can be used by Hooks like `UseMemo` and `UseEffect`. 75 | -- | 76 | -- | This type is provided by the `captures` and `capturesWith` functions. 77 | data MemoValues 78 | -------------------------------------------------------------------------------- /test/Performance/Main.purs: -------------------------------------------------------------------------------- 1 | module Performance.Main where 2 | 3 | import Prelude hiding (compare) 4 | 5 | import Data.Argonaut.Core (stringifyWithIndent) 6 | import Data.Argonaut.Encode (encodeJson) 7 | import Data.Maybe (Maybe(..)) 8 | import Effect (Effect) 9 | import Effect.Aff (Milliseconds(..), launchAff_) 10 | import Effect.Class (liftEffect) 11 | import Effect.Class.Console as Console 12 | import Effect.Exception (catchException) 13 | import Node.Encoding (Encoding(..)) 14 | import Node.FS.Sync (mkdir, writeTextFile) 15 | import Performance.Setup.Measure (ComparisonSummary, TestType(..), compare, testTypeToString, withBrowser) 16 | import Performance.Setup.Puppeteer as Puppeteer 17 | import Performance.Snapshot (percentChange, snapshots) 18 | import Test.Spec (Spec, around, describe, it) 19 | import Test.Spec.Reporter (consoleReporter) 20 | import Test.Spec.Runner (defaultConfig, runSpec') 21 | 22 | main :: Effect Unit 23 | main = launchAff_ do 24 | runSpec' (defaultConfig { timeout = Just (Milliseconds 30_000.0) }) [ consoleReporter ] do 25 | describe "Peformance" spec 26 | 27 | -- These tests have wide acceptance ranges because of the variability of banchmarks 28 | -- via Puppeteer in general. But they do have some light boundaries and should 29 | -- be manually reviewed in any pull request which touches library internals. 30 | spec :: Spec Unit 31 | spec = around withBrowser do 32 | it "Should satisfy state benchmark" \browser -> do 33 | -- We can safely disregard 'Failed to parse CPU profile' log messages. This 34 | -- disables those logs from this point onwards in the program execution (all 35 | -- following benchmarks). 36 | liftEffect do 37 | Puppeteer.filterConsole 38 | catchException mempty (mkdir "test-results") 39 | 40 | let test = StateTest 41 | result <- compare browser 3 test 42 | liftEffect do 43 | writeResult test result 44 | Console.log "Wrote state test results to test-results (including snapshot change)." 45 | 46 | it "Should satisfy todo benchmark" \browser -> do 47 | let test = TodoTest 48 | result <- compare browser 3 test 49 | liftEffect do 50 | writeResult test result 51 | Console.log "Wrote todo test results to test-results (including snapshot change)." 52 | 53 | writeResult :: TestType -> ComparisonSummary -> Effect Unit 54 | writeResult test { componentAverage, hookAverage, componentResults, hookResults } = do 55 | writePath "summary" $ encodeJson 56 | { componentAverage, hookAverage } 57 | 58 | writePath "results" $ encodeJson 59 | { componentResults, hookResults } 60 | 61 | writePath "change" $ encodeJson $ case test of 62 | StateTest -> 63 | { componentChange: 64 | percentChange snapshots.state.componentAverage componentAverage 65 | , hookChange: 66 | percentChange snapshots.state.hookAverage hookAverage 67 | } 68 | TodoTest -> 69 | { componentChange: 70 | percentChange snapshots.todo.componentAverage componentAverage 71 | , hookChange: 72 | percentChange snapshots.todo.hookAverage hookAverage 73 | } 74 | where 75 | writePath label = 76 | stringifyWithIndent 2 >>> writeTextFile UTF8 (mkPath label) 77 | 78 | mkPath label = 79 | "test-results/" <> testTypeToString test <> "-" <> label <> ".json" 80 | -------------------------------------------------------------------------------- /test/Performance/Setup/Measure.purs: -------------------------------------------------------------------------------- 1 | module Performance.Setup.Measure where 2 | 3 | import Prelude hiding (compare) 4 | 5 | import Control.Monad.Rec.Class (forever) 6 | import Data.Array (fold, replicate) 7 | import Data.Array as Array 8 | import Data.Foldable (foldl, for_, maximum, sum) 9 | import Data.Maybe (fromJust, fromMaybe) 10 | import Data.Traversable (for) 11 | import Effect.Aff (Aff, bracket, delay, error, forkAff, killFiber, throwError) 12 | import Effect.Aff as Aff 13 | import Effect.Aff.AVar as AVar 14 | import Effect.Class (liftEffect) 15 | import Node.Path (resolve) 16 | import Partial.Unsafe (unsafePartial) 17 | import Performance.Test.Types (Test(..), completedSuffix, startSuffix, testToString) 18 | import Performance.Test.Todo.Shared (addNewId, checkId, editId, saveId) 19 | import Performance.Setup.Puppeteer (Browser, FilePath(..), Kilobytes(..), Milliseconds(..), Page) 20 | import Performance.Setup.Puppeteer as Puppeteer 21 | 22 | type PerformanceSummary = 23 | { averageFPS :: Int 24 | , peakHeap :: Kilobytes 25 | , averageHeap :: Kilobytes 26 | , scriptTime :: Milliseconds 27 | , totalTime :: Milliseconds 28 | } 29 | 30 | type ComparisonSummary = 31 | { hookResults :: Array PerformanceSummary 32 | , hookAverage :: PerformanceSummary 33 | , componentResults :: Array PerformanceSummary 34 | , componentAverage :: PerformanceSummary 35 | } 36 | 37 | -- | Bracket test runs by supplying a new browser to each one 38 | withBrowser :: (Browser -> Aff Unit) -> Aff Unit 39 | withBrowser = bracket (Puppeteer.launch { headless: true }) Puppeteer.closeBrowser 40 | 41 | data TestType = StateTest | TodoTest 42 | 43 | testTypeToString :: TestType -> String 44 | testTypeToString = case _ of 45 | StateTest -> "state-test" 46 | TodoTest -> "todo-test" 47 | 48 | compare :: Browser -> Int -> TestType -> Aff ComparisonSummary 49 | compare browser n testType = do 50 | let runs = replicate n (compareOnce browser testType) 51 | results <- for runs (delay (Aff.Milliseconds 100.0) *> _) 52 | 53 | let 54 | hookResults = map _.hook results 55 | componentResults = map _.component results 56 | hookAverage = average hookResults 57 | componentAverage = average componentResults 58 | 59 | pure { hookResults, hookAverage, componentResults, componentAverage } 60 | 61 | compareOnce 62 | :: Browser 63 | -> TestType 64 | -> Aff { hook :: PerformanceSummary, component :: PerformanceSummary } 65 | compareOnce browser = case _ of 66 | StateTest -> do 67 | hook <- measure browser StateHook 68 | component <- measure browser StateComponent 69 | pure { hook, component } 70 | 71 | TodoTest -> do 72 | hook <- measure browser TodoHook 73 | component <- measure browser TodoComponent 74 | pure { hook, component } 75 | 76 | measure :: Browser -> Test -> Aff PerformanceSummary 77 | measure browser test = do 78 | page <- Puppeteer.newPage browser 79 | 80 | path <- liftEffect $ resolve [] "test/test.html" 81 | Puppeteer.goto page ("file://" <> path) 82 | 83 | -- Prepare by selecting the test to mount 84 | let selector = prependHash (testToString test) 85 | mbTestElem <- Puppeteer.waitForSelector page selector 86 | 87 | -- Prepare for the test by collecting garbage (for more accurate heap usage 88 | -- metrics) and starting metrics collection 89 | let tracePath = FilePath $ fold [ "test-results/", testToString test, "-trace.json" ] 90 | 91 | -- Initialize data for capturing heap measurements 92 | var <- AVar.new { captures: [], count: 0 } 93 | 94 | -- Collect garbage in preparation for heap measurements 95 | Puppeteer.enableHeapProfiler page 96 | Puppeteer.collectGarbage page 97 | 98 | -- Start recording the performance trace, depositing the resulting trace file 99 | -- to `tracePath` so it can be manually analyzed 100 | Puppeteer.startTrace page tracePath 101 | 102 | -- Collect initial timestamp and heap usage 103 | initialPageMetrics <- Puppeteer.pageMetrics page 104 | 105 | -- Start collecting heap measurements every 10 milliseconds 106 | -- 107 | -- TODO: It may be better to ditch the dependencies and just use this strategy 108 | -- with `requestAnimationFrame` to measure the FPS as well. 109 | heapFiber <- forkAff $ forever do 110 | { heapUsed } <- Puppeteer.pageMetrics page 111 | { captures, count } <- AVar.take var 112 | AVar.put { captures: Array.snoc captures heapUsed, count: count + 1 } var 113 | delay $ Aff.Milliseconds 10.0 114 | 115 | -- Run the test to completion 116 | for_ mbTestElem Puppeteer.click 117 | runScriptForTest page test 118 | 119 | -- Retrieve heap captures 120 | { captures, count } <- AVar.take var 121 | 122 | -- Collect final timestamp and heap usage 123 | finalPageMetrics <- Puppeteer.pageMetrics page 124 | 125 | -- Stop recording the trace and write it to disk 126 | trace <- Puppeteer.stopTrace page 127 | Puppeteer.closePage page 128 | killFiber (error "time's up!") heapFiber 129 | 130 | -- Use the trace to get the average FPS during the execution 131 | mbModel <- Puppeteer.getPerformanceModel trace 132 | let averageFPS = Puppeteer.getAverageFPS $ unsafePartial $ fromJust mbModel 133 | 134 | -- Use the trace to retrieve time spent executing scripts (JS execution) 135 | scriptTime <- liftEffect (Puppeteer.readScriptingTime tracePath) 136 | 137 | -- Use the initial and final metrics to record the total time spent recording 138 | -- the trace 139 | let totalTime = finalPageMetrics.timestamp - initialPageMetrics.timestamp 140 | 141 | -- Use the heap usage captures to record the average heap usage during 142 | -- execution, minus the heap that existed when the trace began. 143 | let 144 | peakHeap = fromMaybe (Kilobytes 0) $ map (_ - initialPageMetrics.heapUsed) $ maximum captures 145 | averageHeap = (sum captures / Kilobytes count) - initialPageMetrics.heapUsed 146 | 147 | pure { averageFPS, averageHeap, peakHeap, scriptTime, totalTime } 148 | 149 | -- TODO: Replace query selectors 150 | -- 151 | -- Currently tests use query selectors to start tests and understand when a test 152 | -- has completed. But it would be better to expose an interface via the window 153 | -- object that can be used to query the Halogen application and run tests. This 154 | -- would allow tests to: 155 | -- 156 | -- 1. Query the application and await the result; when the result is received 157 | -- then the test is complete and the timer can stop. 158 | -- 159 | -- 2. Alternately, query the application and subscribe to output messages which 160 | -- will record when a test has completed. 161 | -- 162 | -- The Halogen application can register functions onto the window object at app 163 | -- startup (in the `main` function). The `Puppeteer.evaluate` function enables 164 | -- calling functions within Puppeteer, and the `Puppeteer.exposeFunction` function 165 | -- enables a function which evaluates within Puppeteer to be called from outside. 166 | -- 167 | -- Until then, though, we'll just rely on query selectors. 168 | runScriptForTest :: Page -> Test -> Aff Unit 169 | runScriptForTest page test = do 170 | let selector = prependHash (testToString test) 171 | if test == StateHook || test == StateComponent then do 172 | n <- Puppeteer.waitForSelector page (selector <> startSuffix) 173 | for_ n Puppeteer.click 174 | void $ Puppeteer.waitForSelector page (selector <> completedSuffix) 175 | 176 | else if test == TodoHook || test == TodoComponent then do 177 | addNew <- Puppeteer.waitForSelector page (prependHash addNewId) 178 | for_ addNew Puppeteer.click 179 | 180 | check0 <- Puppeteer.waitForSelector page (prependHash $ checkId 0) 181 | for_ check0 Puppeteer.click 182 | check1 <- Puppeteer.waitForSelector page (prependHash $ checkId 1) 183 | for_ check1 Puppeteer.click 184 | 185 | Puppeteer.focus page (prependHash $ editId 5) 186 | Puppeteer.typeWithKeyboard page "is so fun" 187 | save5 <- Puppeteer.waitForSelector page (prependHash $ saveId 5) 188 | for_ save5 Puppeteer.click 189 | 190 | for_ check0 Puppeteer.click 191 | for_ check1 Puppeteer.click 192 | 193 | else 194 | throwError $ error "Impossible!!!" 195 | 196 | prependHash :: String -> String 197 | prependHash str = "#" <> str 198 | 199 | average :: Array PerformanceSummary -> PerformanceSummary 200 | average summaries = do 201 | let 202 | summary = foldl (+) zero summaries 203 | total = Array.length summaries 204 | 205 | { averageFPS: summary.averageFPS / total 206 | , averageHeap: summary.averageHeap / Kilobytes total 207 | , peakHeap: summary.peakHeap / Kilobytes total 208 | , scriptTime: summary.scriptTime / Milliseconds total 209 | , totalTime: summary.totalTime / Milliseconds total 210 | } 211 | -------------------------------------------------------------------------------- /test/Performance/Setup/Puppeteer.js: -------------------------------------------------------------------------------- 1 | import P from 'puppeteer' 2 | import filterConsole from 'filter-console' 3 | import tracealyzer from 'tracealyzer' 4 | import { getPerformanceModel } from 'headless-devtools' 5 | 6 | export function filterConsoleImpl () { 7 | filterConsole(['Failed to parse CPU profile.']) 8 | } 9 | 10 | export function launchImpl (args) { 11 | return function () { 12 | return P.launch(args) 13 | } 14 | } 15 | 16 | export function newPageImpl (browser) { 17 | return browser.newPage() 18 | } 19 | 20 | export function debugImpl (page) { 21 | page.on('console', msg => console.log('PAGE LOG:', msg.text())) 22 | page.on('pageerror', err => console.log('ERROR LOG:', err.message)) 23 | } 24 | 25 | export function clickImpl (elem) { 26 | return elem.click() 27 | } 28 | 29 | export function waitForSelectorImpl (page, selector) { 30 | return page.waitForSelector(selector) 31 | } 32 | 33 | export function focusImpl (page, selector) { 34 | return page.focus(selector) 35 | } 36 | 37 | export function typeWithKeybordImpl (page, string) { 38 | return page.keyboard.type(string) 39 | } 40 | 41 | export function gotoImpl (page, path) { 42 | return page.goto(path) 43 | } 44 | 45 | export function closePageImpl (page) { 46 | return page.close() 47 | } 48 | 49 | export function closeBrowserImpl (browser) { 50 | return browser.close() 51 | } 52 | 53 | export function enableHeapProfilerImpl (page) { 54 | return page._client.send('HeapProfiler.enable') 55 | } 56 | 57 | export function collectGarbageImpl (page) { 58 | return page._client.send('HeapProfiler.collectGarbage') 59 | } 60 | 61 | export function startTraceImpl (page, path) { 62 | return page.tracing.start({ path }) 63 | } 64 | 65 | export function stopTraceImpl (page) { 66 | return page.tracing.stop() 67 | } 68 | 69 | // Should be used on the trace produced by `page.tracing.stop()` 70 | export function getPerformanceModelImpl (trace) { 71 | try { 72 | const traceJSON = JSON.parse(trace.toString()) 73 | return getPerformanceModel(traceJSON) 74 | } catch (e) { 75 | return null 76 | } 77 | } 78 | 79 | // Should be used on the model returned by `getPeformanceModel` 80 | export function getAverageFPS (model) { 81 | const frames = model.frames() 82 | const durations = frames.map(x => x.duration) 83 | const avg = durations.reduce((acc, item) => acc + item, 0) / durations.length 84 | return Math.round(1000 / avg) 85 | } 86 | 87 | export function pageMetricsImpl (page) { 88 | return page.metrics() 89 | } 90 | 91 | export function tracealyzerImpl (filename) { 92 | return function () { 93 | return tracealyzer(filename) 94 | } 95 | } 96 | -------------------------------------------------------------------------------- /test/Performance/Setup/Puppeteer.purs: -------------------------------------------------------------------------------- 1 | module Performance.Setup.Puppeteer 2 | ( filterConsole 3 | , Browser 4 | , launch 5 | , Page 6 | , newPage 7 | , debug 8 | , click 9 | , waitForSelector 10 | , focus 11 | , typeWithKeyboard 12 | , goto 13 | , closePage 14 | , closeBrowser 15 | , enableHeapProfiler 16 | , collectGarbage 17 | , FilePath(..) 18 | , startTrace 19 | , Trace 20 | , stopTrace 21 | , PerformanceModel 22 | , getPerformanceModel 23 | , getAverageFPS 24 | , Kilobytes(..) 25 | , Milliseconds(..) 26 | , PageMetrics 27 | , pageMetrics 28 | , readScriptingTime 29 | ) where 30 | 31 | import Prelude 32 | 33 | import Control.Promise (Promise, toAffE) 34 | import Data.Argonaut.Core (Json) 35 | import Data.Argonaut.Decode (class DecodeJson, decodeJson, printJsonDecodeError, (.:), (.:?)) 36 | import Data.Argonaut.Encode (class EncodeJson, encodeJson) 37 | import Data.Either (Either(..)) 38 | import Data.Int (round) 39 | import Data.Int as Int 40 | import Data.Maybe (Maybe, fromJust, fromMaybe) 41 | import Data.Newtype (class Newtype) 42 | import Data.Nullable (Nullable, toMaybe) 43 | import Data.String.CodeUnits as String 44 | import Effect (Effect) 45 | import Effect.Aff (Aff) 46 | import Effect.Class (liftEffect) 47 | import Effect.Exception (throw) 48 | import Effect.Uncurried (EffectFn1, EffectFn2, runEffectFn1, runEffectFn2) 49 | import Node.Path as Path 50 | import Partial.Unsafe (unsafePartial) 51 | import Web.HTML (HTMLElement) 52 | 53 | -- | Turn off noisy messages from the Puppeteer tests 54 | foreign import filterConsoleImpl :: Effect Unit 55 | 56 | filterConsole :: Effect Unit 57 | filterConsole = filterConsoleImpl 58 | 59 | -- | An instance of a Puppeteer browser, which should be created at 60 | -- | the start of any Puppeteer session and closed at the end. 61 | foreign import data Browser :: Type 62 | 63 | -- | The headless :: Boolean argument specifies whether or not to run the browser in headless mode. 64 | -- | To debug/test visually, set headless to false 65 | type LaunchArgs = 66 | { headless :: Boolean 67 | } 68 | 69 | foreign import launchImpl :: LaunchArgs -> Effect (Promise Browser) 70 | 71 | launch :: LaunchArgs -> Aff Browser 72 | launch config = toAffE (launchImpl config) 73 | 74 | -- | An instance of a Puppeteer page, which is necessary to run page-level 75 | -- | functions like collecting metrics and starting and stopping traces. 76 | foreign import data Page :: Type 77 | 78 | foreign import newPageImpl :: EffectFn1 Browser (Promise Page) 79 | 80 | -- | Create a running instance of a `Page` 81 | newPage :: Browser -> Aff Page 82 | newPage = toAffE1 newPageImpl 83 | 84 | foreign import debugImpl :: EffectFn1 Page Unit 85 | 86 | -- | Enable logs from the Puppeteer instance 87 | debug :: Page -> Aff Unit 88 | debug = liftEffect <<< runEffectFn1 debugImpl 89 | 90 | foreign import clickImpl :: EffectFn1 HTMLElement (Promise Unit) 91 | 92 | click :: HTMLElement -> Aff Unit 93 | click = toAffE1 clickImpl 94 | 95 | foreign import waitForSelectorImpl :: EffectFn2 Page String (Promise (Nullable HTMLElement)) 96 | 97 | waitForSelector :: Page -> String -> Aff (Maybe HTMLElement) 98 | waitForSelector page selector = map toMaybe (toAffE2 waitForSelectorImpl page selector) 99 | 100 | foreign import focusImpl :: EffectFn2 Page String (Promise Unit) 101 | 102 | focus :: Page -> String -> Aff Unit 103 | focus = toAffE2 focusImpl 104 | 105 | foreign import typeWithKeybordImpl :: EffectFn2 Page String (Promise Unit) 106 | 107 | typeWithKeyboard :: Page -> String -> Aff Unit 108 | typeWithKeyboard = toAffE2 typeWithKeybordImpl 109 | 110 | foreign import gotoImpl :: EffectFn2 Page Path.FilePath (Promise Unit) 111 | 112 | goto :: Page -> Path.FilePath -> Aff Unit 113 | goto = toAffE2 gotoImpl 114 | 115 | foreign import closePageImpl :: EffectFn1 Page (Promise Unit) 116 | 117 | -- | Terminate the running Puppeteer page 118 | closePage :: Page -> Aff Unit 119 | closePage = toAffE1 closePageImpl 120 | 121 | foreign import closeBrowserImpl :: EffectFn1 Browser (Promise Unit) 122 | 123 | -- | Terminate the running Puppeteer browser, ending the session 124 | closeBrowser :: Browser -> Aff Unit 125 | closeBrowser = toAffE1 closeBrowserImpl 126 | 127 | foreign import enableHeapProfilerImpl :: EffectFn1 Page (Promise Unit) 128 | 129 | -- | Turn on the heap profiler, enabling JS heap measurements and manual garbage 130 | -- | collection for more reliable benchmarking 131 | enableHeapProfiler :: Page -> Aff Unit 132 | enableHeapProfiler = toAffE1 enableHeapProfilerImpl 133 | 134 | foreign import collectGarbageImpl :: EffectFn1 Page (Promise Unit) 135 | 136 | -- | Manually trigger garbage collection, which can be used to ensure more 137 | -- | accurate heap usage 138 | collectGarbage :: Page -> Aff Unit 139 | collectGarbage = toAffE1 collectGarbageImpl 140 | 141 | newtype FilePath = FilePath String 142 | 143 | derive instance Newtype FilePath _ 144 | 145 | foreign import startTraceImpl :: EffectFn2 Page FilePath (Promise Unit) 146 | 147 | -- | Begin measuring a performance trace. Use `stopTrace` to complete the 148 | -- | measurement and write it to the specified file path. This trace can then 149 | -- | be loaded up in the Chrome Dev Tools. 150 | startTrace :: Page -> FilePath -> Aff Unit 151 | startTrace = toAffE2 startTraceImpl 152 | 153 | -- | The opaque blob returned by a performance trace, which can be analyzed to 154 | -- | retrieve performance measurements like FPS. 155 | foreign import data Trace :: Type 156 | 157 | foreign import stopTraceImpl :: EffectFn1 Page (Promise Trace) 158 | 159 | -- | Begin measuring a performance trace. Use `stopTrace` to complete the 160 | -- | measurement. 161 | stopTrace :: Page -> Aff Trace 162 | stopTrace = toAffE1 stopTraceImpl 163 | 164 | -- | The opaque blob returned by the `getPerformanceModel` function, which can 165 | -- | be used to retrieve the average frames per second over the measured duration 166 | foreign import data PerformanceModel :: Type 167 | 168 | foreign import getPerformanceModelImpl :: EffectFn1 Trace (Promise (Nullable PerformanceModel)) 169 | 170 | getPerformanceModel :: Trace -> Aff (Maybe PerformanceModel) 171 | getPerformanceModel = map toMaybe <<< toAffE1 getPerformanceModelImpl 172 | 173 | -- | Retrieve the average frames per second over the course of the performance trace 174 | foreign import getAverageFPS :: PerformanceModel -> Int 175 | 176 | type JSPageMetrics = 177 | { "JSHeapUsedSize" :: Number -- megabytes 178 | , "Timestamp" :: Number -- microseconds 179 | } 180 | 181 | foreign import pageMetricsImpl :: EffectFn1 Page (Promise JSPageMetrics) 182 | 183 | newtype Kilobytes = Kilobytes Int 184 | 185 | derive instance Newtype Kilobytes _ 186 | derive newtype instance Eq Kilobytes 187 | derive newtype instance Ord Kilobytes 188 | derive newtype instance Semiring Kilobytes 189 | derive newtype instance Ring Kilobytes 190 | derive newtype instance CommutativeRing Kilobytes 191 | derive newtype instance EuclideanRing Kilobytes 192 | 193 | instance EncodeJson Kilobytes where 194 | encodeJson = encodeJson <<< show 195 | 196 | instance DecodeJson Kilobytes where 197 | decodeJson json = decodeJson json >>= \str -> do 198 | pure (Kilobytes (unsafePartial (fromJust (Int.fromString (String.dropRight 2 str))))) 199 | 200 | instance Show Kilobytes where 201 | show (Kilobytes kb) = show kb <> "kb" 202 | 203 | newtype Milliseconds = Milliseconds Int 204 | 205 | derive instance Newtype Milliseconds _ 206 | derive newtype instance Eq Milliseconds 207 | derive newtype instance Ord Milliseconds 208 | derive newtype instance Semiring Milliseconds 209 | derive newtype instance Ring Milliseconds 210 | derive newtype instance CommutativeRing Milliseconds 211 | derive newtype instance EuclideanRing Milliseconds 212 | 213 | instance EncodeJson Milliseconds where 214 | encodeJson = encodeJson <<< show 215 | 216 | instance Show Milliseconds where 217 | show (Milliseconds ms) = show ms <> "ms" 218 | 219 | instance DecodeJson Milliseconds where 220 | decodeJson json = decodeJson json >>= \str -> do 221 | pure (Milliseconds (unsafePartial (fromJust (Int.fromString (String.dropRight 2 str))))) 222 | 223 | -- | A snapshot of current page data 224 | type PageMetrics = 225 | { heapUsed :: Kilobytes 226 | , timestamp :: Milliseconds 227 | } 228 | 229 | -- | Retrieve a snapshot of the current page metrics, which can be used to see 230 | -- | current heap usage and execution times 231 | pageMetrics :: Page -> Aff PageMetrics 232 | pageMetrics = toAffE1 pageMetricsImpl >>> map \{ "JSHeapUsedSize": heap, "Timestamp": ts } -> 233 | { heapUsed: Kilobytes (round (heap / 1000.0)) 234 | , timestamp: Milliseconds (round (ts * 1000.0)) 235 | } 236 | 237 | -- | Retrieve the time spent in scripting during the execution 238 | readScriptingTime :: FilePath -> Effect Milliseconds 239 | readScriptingTime fp = do 240 | json <- tracealyzer fp 241 | 242 | let 243 | decoded = do 244 | obj <- decodeJson json 245 | (_ .:? "scripting") =<< (_ .: "categories") =<< obj .: "profiling" 246 | 247 | case decoded of 248 | Left err -> throw $ printJsonDecodeError err 249 | Right val -> pure $ Milliseconds $ round $ fromMaybe 0.0 val 250 | 251 | foreign import tracealyzerImpl :: FilePath -> Effect Json 252 | 253 | tracealyzer :: FilePath -> Effect Json 254 | tracealyzer = tracealyzerImpl 255 | 256 | toAffE1 :: forall a b. EffectFn1 a (Promise b) -> a -> Aff b 257 | toAffE1 fn = toAffE <<< runEffectFn1 fn 258 | 259 | toAffE2 :: forall a b c. EffectFn2 a b (Promise c) -> a -> b -> Aff c 260 | toAffE2 fn a b = toAffE (runEffectFn2 fn a b) 261 | -------------------------------------------------------------------------------- /test/Performance/Snapshot.purs: -------------------------------------------------------------------------------- 1 | module Performance.Snapshot where 2 | 3 | import Prelude 4 | 5 | import Data.Argonaut.Core (Json) 6 | import Data.Argonaut.Decode (JsonDecodeError, decodeJson) 7 | import Data.Either (Either, fromRight') 8 | import Data.Int (toNumber) 9 | import Data.Int as Int 10 | import Data.Newtype (unwrap) 11 | import Effect.Exception.Unsafe (unsafeThrow) 12 | import Performance.Setup.Measure (PerformanceSummary) 13 | import Performance.Snapshot.StateTest as StateTest 14 | import Performance.Snapshot.TodoTest as TodoTest 15 | 16 | -- A subset of the `ComparisonSummary` type in `Performance.Setup.Measure` 17 | type Snapshot = 18 | { componentAverage :: PerformanceSummary 19 | , hookAverage :: PerformanceSummary 20 | } 21 | 22 | decodeSnapshot :: Json -> Either JsonDecodeError Snapshot 23 | decodeSnapshot = decodeJson 24 | 25 | snapshots :: { state :: Snapshot, todo :: Snapshot } 26 | snapshots = fromRight' (\_ -> unsafeThrow "expected Right") do 27 | state <- decodeJson StateTest.result 28 | todo <- decodeJson TodoTest.result 29 | pure { state, todo } 30 | 31 | type Percent = String 32 | 33 | formatPercent :: Int -> String 34 | formatPercent percent = show percent <> "%" 35 | 36 | percentChange 37 | :: PerformanceSummary 38 | -> PerformanceSummary 39 | -> { averageFPS :: Percent 40 | , averageHeap :: Percent 41 | , peakHeap :: Percent 42 | , scriptTime :: Percent 43 | } 44 | percentChange value1 value2 = do 45 | let 46 | change new old = do 47 | let 48 | newN = toNumber new 49 | oldN = toNumber old 50 | formatPercent $ Int.round (((newN - oldN) / oldN) * 100.0) 51 | { averageFPS: 52 | change value1.averageFPS value2.averageFPS 53 | , averageHeap: 54 | change (unwrap value1.averageHeap) (unwrap value2.averageHeap) 55 | , peakHeap: 56 | change (unwrap value1.peakHeap) (unwrap value2.peakHeap) 57 | , scriptTime: 58 | change (unwrap value1.scriptTime) (unwrap value2.scriptTime) 59 | } 60 | -------------------------------------------------------------------------------- /test/Performance/Snapshot/StateTest.js: -------------------------------------------------------------------------------- 1 | export const result = { 2 | "hookAverage": { 3 | "totalTime": "110ms", 4 | "scriptTime": "55ms", 5 | "peakHeap": "2113kb", 6 | "averageHeap": "888kb", 7 | "averageFPS": 43 8 | }, 9 | "componentAverage": { 10 | "totalTime": "82ms", 11 | "scriptTime": "28ms", 12 | "peakHeap": "1146kb", 13 | "averageHeap": "549kb", 14 | "averageFPS": 63 15 | } 16 | } -------------------------------------------------------------------------------- /test/Performance/Snapshot/StateTest.purs: -------------------------------------------------------------------------------- 1 | {- AUTOMATICALLY GENERATED, DO NOT EDIT -} 2 | 3 | module Performance.Snapshot.StateTest where 4 | 5 | import Data.Argonaut.Core (Json) 6 | 7 | foreign import result :: Json 8 | -------------------------------------------------------------------------------- /test/Performance/Snapshot/TodoTest.js: -------------------------------------------------------------------------------- 1 | export const result = { 2 | "hookAverage": { 3 | "totalTime": "412ms", 4 | "scriptTime": "163ms", 5 | "peakHeap": "11352kb", 6 | "averageHeap": "5101kb", 7 | "averageFPS": 40 8 | }, 9 | "componentAverage": { 10 | "totalTime": "341ms", 11 | "scriptTime": "97ms", 12 | "peakHeap": "6069kb", 13 | "averageHeap": "2967kb", 14 | "averageFPS": 47 15 | } 16 | } -------------------------------------------------------------------------------- /test/Performance/Snapshot/TodoTest.purs: -------------------------------------------------------------------------------- 1 | {- AUTOMATICALLY GENERATED, DO NOT EDIT -} 2 | 3 | module Performance.Snapshot.TodoTest where 4 | 5 | import Data.Argonaut.Core (Json) 6 | 7 | foreign import result :: Json 8 | -------------------------------------------------------------------------------- /test/Performance/Snapshot/Write.purs: -------------------------------------------------------------------------------- 1 | module Performance.Snapshot.Write where 2 | 3 | import Prelude hiding (compare) 4 | 5 | import Data.Argonaut.Core (stringifyWithIndent) 6 | import Data.Argonaut.Encode (encodeJson) 7 | import Data.Foldable (fold) 8 | import Effect (Effect) 9 | import Effect.Aff (bracket, launchAff_) 10 | import Effect.Class (liftEffect) 11 | import Effect.Class.Console as Console 12 | import Effect.Exception (catchException) 13 | import Node.Encoding (Encoding(..)) 14 | import Node.FS.Sync (mkdir, writeTextFile) 15 | import Performance.Setup.Measure (TestType(..), compare) 16 | import Performance.Setup.Puppeteer as Puppeteer 17 | import Performance.Snapshot (Snapshot) 18 | 19 | main :: Effect Unit 20 | main = launchAff_ do 21 | bracket (Puppeteer.launch { headless: true }) Puppeteer.closeBrowser \browser -> do 22 | liftEffect do 23 | Puppeteer.filterConsole 24 | catchException mempty (mkdir "test-results") 25 | 26 | Console.log "Running state tests..." 27 | state <- compare browser 6 StateTest 28 | liftEffect do 29 | writeSnapshot StateTest 30 | { componentAverage: state.componentAverage 31 | , hookAverage: state.hookAverage 32 | } 33 | 34 | Console.log "Running todo tests..." 35 | todo <- compare browser 6 TodoTest 36 | liftEffect do 37 | writeSnapshot TodoTest 38 | { componentAverage: todo.componentAverage 39 | , hookAverage: todo.hookAverage 40 | } 41 | 42 | Console.log "Done with snapshots!" 43 | where 44 | writeSnapshot :: TestType -> Snapshot -> Effect Unit 45 | writeSnapshot test snapshot = do 46 | writeTextFile UTF8 snapshotPath.js (snapshotTemplate snapshot) 47 | writeTextFile UTF8 snapshotPath.purs snapshotPursTemplate 48 | 49 | where 50 | moduleName = testTypeToModule test 51 | 52 | snapshotPath = do 53 | let path = "test/Performance/Snapshot/" <> moduleName 54 | { purs: path <> ".purs", js: path <> ".js" } 55 | 56 | snapshotPursTemplate = 57 | fold 58 | [ "{- AUTOMATICALLY GENERATED, DO NOT EDIT -}\n" 59 | , "\n" 60 | , "module Performance.Snapshot." <> moduleName <> " where\n" 61 | , "\n" 62 | , "import Data.Argonaut.Core (Json)\n" 63 | , "\n" 64 | , "foreign import result :: Json\n" 65 | ] 66 | 67 | snapshotTemplate results = 68 | "export const result = " <> stringifyWithIndent 2 (encodeJson results) 69 | 70 | testTypeToModule :: TestType -> String 71 | testTypeToModule = case _ of 72 | StateTest -> "StateTest" 73 | TodoTest -> "TodoTest" 74 | -------------------------------------------------------------------------------- /test/Performance/Test/App.purs: -------------------------------------------------------------------------------- 1 | module Performance.Test.App where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Effect.Aff (launchAff_) 7 | import Effect.Aff.Class (class MonadAff) 8 | import Halogen as H 9 | import Halogen.Aff.Util as HA 10 | import Halogen.HTML as HH 11 | import Halogen.HTML.Events as HE 12 | import Halogen.HTML.Properties as HP 13 | import Halogen.VDom.Driver (runUI) 14 | import Performance.Test.State.Component as State.Component 15 | import Performance.Test.State.Hook as State.Hook 16 | import Performance.Test.Types (Test(..), completedSuffix, testToString) 17 | import Performance.Test.Todo.Component as Todo.Component 18 | import Performance.Test.Todo.Hook as Todo.Hook 19 | 20 | main :: Effect Unit 21 | main = launchAff_ do 22 | body <- HA.awaitBody 23 | _ <- runUI container unit body 24 | pure unit 25 | 26 | data TestState 27 | = NotStarted 28 | | Running Test 29 | | Completed Test 30 | 31 | derive instance Eq TestState 32 | 33 | data Action = HandleStartTest Test | HandleTestComplete Test 34 | 35 | container :: forall q i o m. MonadAff m => H.Component q i o m 36 | container = H.mkComponent 37 | { initialState: \_ -> NotStarted 38 | , render 39 | , eval: H.mkEval $ H.defaultEval { handleAction = handleAction } 40 | } 41 | where 42 | -- Used by Puppeteer to mount a test into the page so that it can be started 43 | testAction test = do 44 | let test' = testToString test 45 | HH.button [ HP.id test', HE.onClick \_ -> HandleStartTest test ] [ HH.text test' ] 46 | 47 | handleComplete test = 48 | const (HandleTestComplete test) 49 | 50 | render state = do 51 | HH.div_ 52 | [ HH.div_ 53 | [ -- Used by Puppeteer to trigger a test to be mounted into the page 54 | testAction StateHook 55 | , testAction StateComponent 56 | , testAction TodoHook 57 | , testAction TodoComponent 58 | 59 | , case state of 60 | NotStarted -> 61 | HH.text "" 62 | 63 | Running StateHook -> 64 | HH.slot State.Hook._stateHook unit State.Hook.component unit (handleComplete StateHook) 65 | 66 | Running StateComponent -> 67 | HH.slot State.Component._stateComponent unit State.Component.component unit (handleComplete StateComponent) 68 | 69 | Running TodoHook -> 70 | HH.slot Todo.Hook._todoHook unit Todo.Hook.container unit (handleComplete TodoHook) 71 | 72 | Running TodoComponent -> 73 | HH.slot Todo.Component._todoComponent unit Todo.Component.container unit (handleComplete TodoComponent) 74 | 75 | Completed test -> 76 | HH.div [ HP.id (testToString test <> completedSuffix) ] [] 77 | ] 78 | ] 79 | 80 | handleAction = case _ of 81 | HandleStartTest test -> 82 | H.put (Running test) 83 | 84 | HandleTestComplete test -> 85 | H.put (Completed test) 86 | -------------------------------------------------------------------------------- /test/Performance/Test/State/Component.purs: -------------------------------------------------------------------------------- 1 | module Performance.Test.State.Component where 2 | 3 | import Prelude 4 | 5 | import Data.Array.NonEmpty (replicate) 6 | import Data.Foldable (sequence_) 7 | 8 | import Halogen as H 9 | import Halogen.HTML as HH 10 | import Halogen.HTML.Events as HE 11 | import Halogen.HTML.Properties as HP 12 | import Performance.Test.State.Shared (Output(..), stateUpdates) 13 | import Performance.Test.Types (Test(..), startSuffix, testToString) 14 | import Type.Proxy (Proxy(..)) 15 | 16 | _stateComponent = Proxy :: Proxy "stateComponent" 17 | 18 | data Action = RunState 19 | 20 | component :: forall q i m. H.Component q i Output m 21 | component = 22 | H.mkComponent 23 | { initialState: \_ -> { n: 0, n1: 0, n2: 0, n3: 0, n4: 0 } 24 | , render 25 | , eval: H.mkEval $ H.defaultEval { handleAction = handleAction } 26 | } 27 | where 28 | render state = 29 | HH.div_ 30 | [ HH.button 31 | [ HP.id (testToString StateComponent <> startSuffix) 32 | , HE.onClick \_ -> RunState 33 | ] 34 | [ HH.text "Start Test" ] 35 | , HH.text $ show state 36 | ] 37 | 38 | handleAction RunState = do 39 | sequence_ $ replicate stateUpdates $ H.modify_ \s -> s { n = s.n + 1 } 40 | sequence_ $ replicate stateUpdates $ H.modify_ \s -> s { n1 = s.n1 + 1 } 41 | sequence_ $ replicate stateUpdates $ H.modify_ \s -> s { n2 = s.n2 + 1 } 42 | sequence_ $ replicate stateUpdates $ H.modify_ \s -> s { n3 = s.n3 + 1 } 43 | sequence_ $ replicate stateUpdates $ H.modify_ \s -> s { n4 = s.n4 + 1 } 44 | H.raise Done 45 | -------------------------------------------------------------------------------- /test/Performance/Test/State/Hook.purs: -------------------------------------------------------------------------------- 1 | module Performance.Test.State.Hook where 2 | 3 | import Prelude 4 | 5 | import Data.Array (replicate) 6 | import Data.Foldable (sequence_) 7 | import Data.Tuple.Nested ((/\)) 8 | import Effect.Aff.Class (class MonadAff) 9 | import Halogen as H 10 | import Halogen.HTML as HH 11 | import Halogen.HTML.Events as HE 12 | import Halogen.HTML.Properties as HP 13 | import Halogen.Hooks as Hooks 14 | import Performance.Test.State.Shared (Output(..), stateUpdates) 15 | import Performance.Test.Types (Test(..), startSuffix, testToString) 16 | import Type.Proxy (Proxy(..)) 17 | 18 | _stateHook = Proxy :: Proxy "stateHook" 19 | 20 | component :: forall q i m. MonadAff m => H.Component q i Output m 21 | component = Hooks.memoComponent (\_ _ -> false) \{ outputToken } _ -> Hooks.do 22 | n /\ nId <- Hooks.useState { n: 0, n1: 0, n2: 0, n3: 0, n4: 0 } 23 | 24 | let 25 | runState = do 26 | sequence_ $ replicate stateUpdates $ Hooks.modify_ nId \s -> s { n = s.n + 1 } 27 | sequence_ $ replicate stateUpdates $ Hooks.modify_ nId \s -> s { n1 = s.n1 + 1 } 28 | sequence_ $ replicate stateUpdates $ Hooks.modify_ nId \s -> s { n2 = s.n2 + 1 } 29 | sequence_ $ replicate stateUpdates $ Hooks.modify_ nId \s -> s { n3 = s.n3 + 1 } 30 | sequence_ $ replicate stateUpdates $ Hooks.modify_ nId \s -> s { n4 = s.n4 + 1 } 31 | Hooks.raise outputToken Done 32 | 33 | Hooks.pure do 34 | HH.div_ 35 | [ HH.button 36 | [ HP.id (testToString StateHook <> startSuffix) 37 | , HE.onClick \_ -> runState 38 | ] 39 | [ HH.text "Start Test" ] 40 | , HH.text $ show n 41 | ] 42 | -------------------------------------------------------------------------------- /test/Performance/Test/State/README.md: -------------------------------------------------------------------------------- 1 | # Performance Test: State 2 | 3 | This test measures Hooks overhead by comparing a component and a Hooks-based component which update state several hundred times in response to a click. This test isn't particularly useful on its own; if Hooks add a half millisecond per render + Hooks evaluation, then several hundred updates in a row will add significantly to its execution time. Of course, you would never ever do this in the real world. 4 | 5 | It's still useful as a small sanity check when testing changes -- the Hooks version should not be much slower than the regular component version, though it may use more heap as it stores slightly more state. 6 | -------------------------------------------------------------------------------- /test/Performance/Test/State/Shared.purs: -------------------------------------------------------------------------------- 1 | module Performance.Test.State.Shared where 2 | 3 | import Prelude 4 | 5 | import Halogen as H 6 | 7 | type Slot id = forall q. H.Slot q Void id 8 | 9 | data Output = Done 10 | 11 | stateUpdates = 50 :: Int 12 | -------------------------------------------------------------------------------- /test/Performance/Test/Todo/Component.purs: -------------------------------------------------------------------------------- 1 | module Performance.Test.Todo.Component where 2 | 3 | import Prelude 4 | 5 | import Data.Foldable (for_) 6 | import Data.Maybe (Maybe(..)) 7 | import Data.Set as Set 8 | import Effect.Aff.Class (class MonadAff) 9 | import Halogen (liftEffect) 10 | import Halogen as H 11 | import Halogen.HTML as HH 12 | import Halogen.HTML.Events as HE 13 | import Halogen.HTML.Properties as HP 14 | import Performance.Test.Todo.Shared (CheckboxInput, CheckboxOutput(..), TodoInput, TodoOutput(..)) 15 | import Performance.Test.Todo.Shared as Shared 16 | import Type.Proxy (Proxy(..)) 17 | 18 | _todoComponent = Proxy :: Proxy "todoComponent" 19 | 20 | data ContainerAction 21 | = Initialize 22 | | HandleTodo TodoOutput 23 | | AddNew 24 | 25 | container :: forall q i o m. MonadAff m => H.Component q i o m 26 | container = 27 | H.mkComponent 28 | { initialState: \_ -> Shared.initialContainerState 29 | , render 30 | , eval: H.mkEval $ H.defaultEval { handleAction = handleAction, initialize = Just Initialize } 31 | } 32 | where 33 | handleAction = case _ of 34 | Initialize -> do 35 | state <- H.get 36 | filled <- liftEffect $ Shared.fillContainerState state 37 | H.put filled 38 | 39 | HandleTodo msg -> case msg of 40 | Save t -> do 41 | state <- H.get 42 | for_ (Shared.updateTodo t state.todos) \todos -> 43 | H.modify_ _ { todos = todos } 44 | 45 | SetCompleted id complete -> do 46 | if complete then 47 | H.modify_ \state -> state { completed = Set.insert id state.completed } 48 | else 49 | H.modify_ \state -> state { completed = Set.delete id state.completed } 50 | 51 | AddNew -> do 52 | state <- H.get 53 | newState <- liftEffect $ Shared.createTodo state 54 | H.put newState 55 | 56 | render state = do 57 | let 58 | todos = state.todos <#> \t -> 59 | HH.slot Shared._todo t.id todo { todo: t, completed: state.completed } HandleTodo 60 | 61 | HH.div_ 62 | [ HH.button 63 | [ HP.id Shared.addNewId 64 | , HE.onClick \_ -> AddNew 65 | ] 66 | [ HH.text "Add New" ] 67 | , HH.div 68 | [ HP.id Shared.todosId ] 69 | todos 70 | ] 71 | 72 | data TodoAction 73 | = ReceiveTodoInput TodoInput 74 | | UpdateDescription String 75 | | SaveUpdate 76 | | HandleCheckbox CheckboxOutput 77 | 78 | todo :: forall q m. MonadAff m => H.Component q TodoInput TodoOutput m 79 | todo = H.mkComponent 80 | { initialState: identity 81 | , render 82 | , eval: H.mkEval $ H.defaultEval { handleAction = handleAction, receive = Just <<< ReceiveTodoInput } 83 | } 84 | where 85 | handleAction = case _ of 86 | ReceiveTodoInput input -> do 87 | state <- H.get 88 | unless (state.todo.id == input.todo.id && state.completed == input.completed) do 89 | H.modify_ \st -> st { todo { id = input.todo.id }, completed = input.completed } 90 | 91 | UpdateDescription str -> do 92 | H.modify_ \state -> state { todo { description = str } } 93 | 94 | SaveUpdate -> do 95 | state <- H.get 96 | H.raise $ Save { id: state.todo.id, description: state.todo.description } 97 | 98 | HandleCheckbox (Check checked) -> do 99 | state <- H.get 100 | H.raise $ SetCompleted state.todo.id checked 101 | 102 | render state = 103 | HH.div_ 104 | [ HH.input 105 | [ HP.id (Shared.editId state.todo.id) 106 | , HE.onValueInput UpdateDescription 107 | , HP.value state.todo.description 108 | ] 109 | , HH.slot Shared._checkbox unit checkbox { id: state.todo.id, completed: state.completed } HandleCheckbox 110 | , HH.button 111 | [ HP.id (Shared.saveId state.todo.id) 112 | , HE.onClick \_ -> SaveUpdate 113 | ] 114 | [ HH.text "Save Changes" ] 115 | ] 116 | 117 | data CheckboxAction = ReceiveCheckboxInput CheckboxInput | HandleCheck Boolean 118 | 119 | checkbox :: forall q m. MonadAff m => H.Component q CheckboxInput CheckboxOutput m 120 | checkbox = H.mkComponent 121 | { initialState: identity 122 | , render 123 | , eval: H.mkEval $ H.defaultEval { handleAction = handleAction } 124 | } 125 | where 126 | handleAction = case _ of 127 | ReceiveCheckboxInput input -> 128 | H.put input 129 | 130 | HandleCheck checked -> 131 | H.raise $ Check checked 132 | 133 | render state = 134 | HH.input 135 | [ HP.id (Shared.checkId state.id) 136 | , HP.checked $ Set.member state.id state.completed 137 | , HP.type_ HP.InputCheckbox 138 | , HE.onChecked HandleCheck 139 | ] 140 | -------------------------------------------------------------------------------- /test/Performance/Test/Todo/Hook.purs: -------------------------------------------------------------------------------- 1 | module Performance.Test.Todo.Hook where 2 | 3 | import Prelude 4 | 5 | import Data.Foldable (for_) 6 | import Data.Function (on) 7 | import Data.Maybe (Maybe(..)) 8 | import Data.Set as Set 9 | import Data.Tuple.Nested ((/\)) 10 | import Effect.Aff.Class (class MonadAff) 11 | import Halogen (liftEffect) 12 | import Halogen as H 13 | import Halogen.HTML as HH 14 | import Halogen.HTML.Events as HE 15 | import Halogen.HTML.Properties as HP 16 | import Halogen.Hooks as Hooks 17 | import Performance.Test.Todo.Shared (CheckboxInput, CheckboxOutput(..), TodoInput, TodoOutput(..)) 18 | import Performance.Test.Todo.Shared as Shared 19 | import Type.Proxy (Proxy(..)) 20 | 21 | _todoHook = Proxy :: Proxy "todoHook" 22 | 23 | container :: forall q i o m. MonadAff m => H.Component q i o m 24 | container = Hooks.component \_ _ -> Hooks.do 25 | state /\ stateId <- Hooks.useState Shared.initialContainerState 26 | 27 | let 28 | handleTodo = case _ of 29 | Save t -> do 30 | for_ (Shared.updateTodo t state.todos) \todos -> 31 | Hooks.modify_ stateId _ { todos = todos } 32 | 33 | SetCompleted id complete -> do 34 | if complete then 35 | Hooks.modify_ stateId _ { completed = Set.insert id state.completed } 36 | else 37 | Hooks.modify_ stateId _ { completed = Set.delete id state.completed } 38 | 39 | Hooks.useLifecycleEffect do 40 | filled <- liftEffect $ Shared.fillContainerState state 41 | Hooks.put stateId filled 42 | pure Nothing 43 | 44 | Hooks.pure do 45 | let 46 | todos = state.todos <#> \t -> 47 | HH.slot Shared._todo t.id todo { todo: t, completed: state.completed } handleTodo 48 | 49 | HH.div_ 50 | [ HH.button 51 | [ HP.id Shared.addNewId 52 | , HE.onClick \_ -> do 53 | newState <- liftEffect $ Shared.createTodo state 54 | Hooks.put stateId newState 55 | ] 56 | [ HH.text "Add New" ] 57 | , HH.div 58 | [ HP.id Shared.todosId ] 59 | todos 60 | ] 61 | 62 | todo :: forall q m. MonadAff m => H.Component q TodoInput TodoOutput m 63 | todo = Hooks.memoComponent (eq `on` _.todo.id && eq `on` _.completed) \{ outputToken } input -> Hooks.do 64 | description /\ descriptionId <- Hooks.useState input.todo.description 65 | 66 | let 67 | handleCheckbox (Check bool) = do 68 | Hooks.raise outputToken $ SetCompleted input.todo.id bool 69 | 70 | Hooks.pure do 71 | HH.div_ 72 | [ HH.input 73 | [ HP.id (Shared.editId input.todo.id) 74 | , HE.onValueInput (Hooks.put descriptionId) 75 | , HP.value description 76 | ] 77 | , HH.slot Shared._checkbox unit checkbox { id: input.todo.id, completed: input.completed } handleCheckbox 78 | , HH.button 79 | [ HP.id (Shared.saveId input.todo.id) 80 | , HE.onClick \_ -> do 81 | Hooks.raise outputToken $ Save { id: input.todo.id, description } 82 | ] 83 | [ HH.text "Save Changes" ] 84 | ] 85 | 86 | checkbox :: forall q m. MonadAff m => H.Component q CheckboxInput CheckboxOutput m 87 | checkbox = Hooks.component \{ outputToken } input -> Hooks.do 88 | Hooks.pure do 89 | HH.input 90 | [ HP.id (Shared.checkId input.id) 91 | , HP.checked $ Set.member input.id input.completed 92 | , HP.type_ HP.InputCheckbox 93 | , HE.onChecked \checked -> do 94 | Hooks.raise outputToken $ Check checked 95 | ] 96 | -------------------------------------------------------------------------------- /test/Performance/Test/Todo/README.md: -------------------------------------------------------------------------------- 1 | # Performance Test: Todo 2 | 3 | This test measures performance when nesting components several layers deep and updating from the root. It's intended to catch performance issues that would be relevant in the real world. 4 | 5 | Actions: 6 | 7 | - Add a new TODO 8 | - Check and un-check a TODO 9 | - Edit a TODO and save it 10 | -------------------------------------------------------------------------------- /test/Performance/Test/Todo/Shared.purs: -------------------------------------------------------------------------------- 1 | module Performance.Test.Todo.Shared where 2 | 3 | import Prelude 4 | 5 | import Data.Array as Array 6 | import Data.Maybe (Maybe) 7 | import Data.Set (Set) 8 | import Data.Set as Set 9 | import Effect (Effect) 10 | import Effect.Random (randomInt) 11 | import Halogen as H 12 | import Partial.Unsafe (unsafePartial) 13 | import Type.Proxy (Proxy(..)) 14 | 15 | data Query a = Run (Unit -> a) 16 | 17 | data TodoOutput = Save Todo | SetCompleted Int Boolean 18 | 19 | _todo = Proxy :: Proxy "todo" 20 | 21 | data CheckboxOutput = Check Boolean 22 | 23 | _checkbox = Proxy :: Proxy "checkbox" 24 | 25 | type Slot = H.Slot Query Void 26 | 27 | type ContainerState = 28 | { todos :: Array Todo 29 | , lastIndex :: Int 30 | , completed :: Set Int 31 | } 32 | 33 | initialContainerState :: ContainerState 34 | initialContainerState = 35 | { todos: [] 36 | , lastIndex: 0 37 | , completed: Set.empty 38 | } 39 | 40 | fillContainerState :: ContainerState -> Effect ContainerState 41 | fillContainerState state = do 42 | let lastIndex' = state.lastIndex + 100 43 | todos <- go state.lastIndex lastIndex' state.todos 44 | pure $ state { todos = todos, lastIndex = lastIndex' } 45 | where 46 | go :: Int -> Int -> Array Todo -> Effect (Array Todo) 47 | go n limit arr 48 | | n == limit = pure arr 49 | | otherwise = do 50 | todo <- mkTodo n 51 | go (n + 1) limit (Array.snoc arr todo) 52 | 53 | createTodo :: ContainerState -> Effect ContainerState 54 | createTodo state = do 55 | todo <- mkTodo (state.lastIndex + 1) 56 | pure $ state { todos = Array.snoc state.todos todo, lastIndex = todo.id } 57 | 58 | type TodoInput = 59 | { todo :: Todo 60 | , completed :: Set Int 61 | } 62 | 63 | type Todo = 64 | { description :: String 65 | , id :: Int 66 | } 67 | 68 | mkTodo :: Int -> Effect Todo 69 | mkTodo id = do 70 | ix <- randomInt 0 9 71 | let description = unsafePartial (Array.unsafeIndex descriptions ix) 72 | pure { description, id } 73 | 74 | updateTodo :: Todo -> Array Todo -> Maybe (Array Todo) 75 | updateTodo todo todos = do 76 | ix <- Array.findIndex (_.id >>> eq todo.id) todos 77 | Array.updateAt ix todo todos 78 | 79 | descriptions :: Array String 80 | descriptions = [ "eat", "drink", "sleep", "party", "walk", "run", "hike", "play the drums", "cook", "chill" ] 81 | 82 | addNewId :: String 83 | addNewId = "add-new" 84 | 85 | todosId :: String 86 | todosId = "todos" 87 | 88 | editId :: Int -> String 89 | editId id = "edit-" <> show id 90 | 91 | saveId :: Int -> String 92 | saveId id = "save-" <> show id 93 | 94 | checkId :: Int -> String 95 | checkId id = "check-" <> show id 96 | 97 | type CheckboxInput = 98 | { id :: Int 99 | , completed :: Set Int 100 | } 101 | -------------------------------------------------------------------------------- /test/Performance/Test/Types.purs: -------------------------------------------------------------------------------- 1 | module Performance.Test.Types where 2 | 3 | import Prelude 4 | 5 | data Test 6 | = StateHook 7 | | StateComponent 8 | | TodoHook 9 | | TodoComponent 10 | 11 | derive instance Eq Test 12 | derive instance Ord Test 13 | 14 | testToString :: Test -> String 15 | testToString = case _ of 16 | StateHook -> "state-hook" 17 | StateComponent -> "state-component" 18 | TodoHook -> "todo-hook" 19 | TodoComponent -> "todo-component" 20 | 21 | -- Used by a test along with its string id to control test start / stop 22 | startSuffix = "-start" :: String 23 | completedSuffix = "-complete" :: String 24 | -------------------------------------------------------------------------------- /test/README.md: -------------------------------------------------------------------------------- 1 | # Halogen Hooks Tests 2 | 3 | Hooks are tested in two ways: 4 | 5 | 1. Behavior tests, which exercise the logic of each of the primitive Hooks in isolation and together to verify they behave as they should; 6 | 2. Performance tests, which ensure that the overhead incurred by Hooks is not too large and that changes to the library don't cause regressions. 7 | 8 | The `test` command exercises both tests. 9 | 10 | ## Behavioral Tests 11 | 12 | The `Hooks` directory contains tests that exercise the logic of the Hooks provided by this library. The `evalM` and `eval` functions allow you to call functions within a Hook, triggering new evaluations, and then use `readResult` to see the resulting Hook state and a log of what happened during the evaluations. If you are contributing a new test, use the existing tests as a template (especially `useState`, which is simple). 13 | 14 | ## Performance Tests 15 | 16 | The `Performance` directory contains small apps that are run by Puppeteer. These tests measure the performance metrics that are observable via the Chrome developer tools, and output trace.json files that can be imported into the Chrome developer tools for more granular looks at performance. 17 | 18 | These tests are meant to measure the overhead incurred by Hooks and aid in attempts to make the library more performant. **These tests are not typically reflective of real-world use, and large numbers don't mean poor performance in the real world. They are simply meant to measure whether internal changes have positive or negative performance implications.** Hooks tests are usually accompanied by the equivalent implementation using ordinary Halogen components as a reference. 19 | 20 | Each Hooks release contains a snapshot, which is an average of several runs of a benchmark, which can be used to ensure regressions haven't occurred. 21 | -------------------------------------------------------------------------------- /test/Test/Hooks/Spec.purs: -------------------------------------------------------------------------------- 1 | module Test.Hooks.Spec where 2 | 3 | import Prelude 4 | 5 | import Test.Hooks.UseLifecycleEffect (lifecycleEffectHook) 6 | import Test.Hooks.UseMemo (memoHook) 7 | import Test.Hooks.UseRef (refHook) 8 | import Test.Hooks.UseState (stateHook) 9 | import Test.Hooks.UseTickEffect (tickEffectHook) 10 | import Test.Spec (Spec) 11 | 12 | spec :: Spec Unit 13 | spec = do 14 | stateHook 15 | tickEffectHook 16 | lifecycleEffectHook 17 | memoHook 18 | refHook 19 | -------------------------------------------------------------------------------- /test/Test/Hooks/UseLifecycleEffect.purs: -------------------------------------------------------------------------------- 1 | module Test.Hooks.UseLifecycleEffect where 2 | 3 | import Prelude 4 | 5 | import Data.Array (replicate) 6 | import Data.Foldable (fold) 7 | import Data.Maybe (Maybe(..)) 8 | import Data.Tuple.Nested ((/\)) 9 | import Effect.Aff (Aff) 10 | import Halogen as H 11 | import Halogen.Hooks (type (<>), Hook, HookM, UseEffect, UseState) 12 | import Halogen.Hooks as Hooks 13 | import Halogen.Hooks.Internal.Eval.Types (InterpretHookReason(..)) 14 | import Test.Setup.Eval (evalM, initDriver, mkEval) 15 | import Test.Setup.Log (logShouldBe, readResult, writeLog) 16 | import Test.Setup.Types (EffectType(..), LogRef, TestEvent(..)) 17 | import Test.Spec (Spec, before, describe, it) 18 | 19 | type Interface = { tick :: HookM Aff Unit } 20 | 21 | type UseLogHook = UseState Int <> UseEffect <> Hooks.Pure 22 | 23 | useLifecycleEffectLog :: LogRef -> Hook Aff UseLogHook Interface 24 | useLifecycleEffectLog log = Hooks.do 25 | -- used to force re-evaluation of the hook; this should not re-run the effect 26 | -- because lifecycle effects run only once. 27 | _ /\ stateId <- Hooks.useState 0 28 | 29 | Hooks.useLifecycleEffect do 30 | writeLog (RunEffect (EffectBody 0)) log 31 | pure $ Just do 32 | writeLog (RunEffect (EffectCleanup 0)) log 33 | 34 | Hooks.pure { tick: Hooks.modify_ stateId (_ + 1) } 35 | 36 | lifecycleEffectHook :: Spec Unit 37 | lifecycleEffectHook = before initDriver $ describe "useLifecycleEffect" do 38 | let eval = mkEval useLifecycleEffectLog 39 | 40 | it "runs the effect on initialize" \ref -> do 41 | evalM ref $ eval H.Initialize 42 | logShouldBe ref initializeSteps 43 | 44 | it "runs the effect on initialize and finalize" \ref -> do 45 | evalM ref $ eval H.Initialize *> eval H.Finalize 46 | logShouldBe ref $ fold [ initializeSteps, finalizeSteps ] 47 | 48 | it "doesn't run the effect other than initialize / finalize" \ref -> do 49 | evalM ref do 50 | eval H.Initialize 51 | 52 | { tick } <- readResult ref 53 | eval (H.Action tick) *> eval (H.Action tick) 54 | 55 | eval H.Finalize 56 | 57 | logShouldBe ref $ fold 58 | [ initializeSteps 59 | , fold $ replicate 2 [ ModifyState, RunHooks Step, Render ] 60 | , finalizeSteps 61 | ] 62 | 63 | where 64 | initializeSteps = 65 | [ RunHooks Initialize, Render, RunEffect (EffectBody 0) ] 66 | 67 | finalizeSteps = 68 | [ RunHooks Finalize, Render, RunEffect (EffectCleanup 0) ] 69 | -------------------------------------------------------------------------------- /test/Test/Hooks/UseMemo.purs: -------------------------------------------------------------------------------- 1 | module Test.Hooks.UseMemo where 2 | 3 | import Prelude 4 | 5 | import Data.Foldable (fold) 6 | import Data.Tuple.Nested ((/\)) 7 | import Effect.Aff (Aff) 8 | import Halogen as H 9 | import Halogen.Hooks (class HookNewtype, type (<>), Hook, HookM, UseMemo, UseState) 10 | import Halogen.Hooks as Hooks 11 | import Halogen.Hooks.Internal.Eval.Types (InterpretHookReason(..)) 12 | import Test.Setup.Eval (evalM, mkEval, initDriver) 13 | import Test.Setup.Log (logShouldBe, readResult, unsafeWriteLog) 14 | import Test.Setup.Types (LogRef, MemoType(..), TestEvent(..)) 15 | import Test.Spec (Spec, before, describe, it) 16 | import Test.Spec.Assertions (shouldEqual) 17 | 18 | foreign import data UseMemoCount :: Hooks.HookType 19 | 20 | type UseMemoCount' = 21 | UseState Int 22 | <> UseState Int 23 | <> UseState Int 24 | <> UseMemo Int 25 | <> UseMemo Int 26 | <> UseMemo Int 27 | <> Hooks.Pure 28 | 29 | instance HookNewtype UseMemoCount UseMemoCount' 30 | 31 | type Interface = 32 | { incrementA :: HookM Aff Unit 33 | , incrementB :: HookM Aff Unit 34 | , incrementC :: HookM Aff Unit 35 | , expensive1 :: Int 36 | , expensive2 :: Int 37 | , expensive3 :: Int 38 | } 39 | 40 | useMemoCount :: LogRef -> Hook Aff UseMemoCount Interface 41 | useMemoCount log = Hooks.wrap Hooks.do 42 | state1 /\ state1Id <- Hooks.useState 0 43 | state2 /\ state2Id <- Hooks.useState 0 44 | _ /\ state3Id <- Hooks.useState 0 45 | 46 | expensive1 <- memoize1 { state1 } 47 | expensive2 <- memoize2 { state2 } 48 | expensive3 <- memoize3 { state1, state2 } 49 | 50 | Hooks.pure 51 | { incrementA: Hooks.modify_ state1Id (_ + 1) -- recomputes 1 and 3 52 | , incrementB: Hooks.modify_ state2Id (_ + 1) -- recomputes 2 and 3 53 | , incrementC: Hooks.modify_ state3Id (_ + 1) -- recomputes nothing 54 | , expensive1 55 | , expensive2 56 | , expensive3 57 | } 58 | where 59 | memoize1 deps@{ state1 } = Hooks.captures deps $ flip Hooks.useMemo \_ -> do 60 | let _ = unsafeWriteLog (RunMemo (CalculateMemo 1)) log 61 | state1 + 5 62 | 63 | memoize2 deps@{ state2 } = Hooks.captures deps $ flip Hooks.useMemo \_ -> do 64 | let _ = unsafeWriteLog (RunMemo (CalculateMemo 2)) log 65 | state2 + 5 66 | 67 | memoize3 deps@{ state1, state2 } = Hooks.captures deps $ flip Hooks.useMemo \_ -> do 68 | let _ = unsafeWriteLog (RunMemo (CalculateMemo 3)) log 69 | state1 + state2 + 5 70 | 71 | memoHook :: Spec Unit 72 | memoHook = before initDriver $ describe "useMemo" do 73 | let eval = mkEval useMemoCount 74 | 75 | it "initializes to the proper initial values" \ref -> do 76 | { expensive1, expensive2, expensive3 } <- evalM ref do 77 | eval H.Initialize 78 | readResult ref 79 | 80 | expensive1 `shouldEqual` 5 81 | expensive2 `shouldEqual` 5 82 | expensive3 `shouldEqual` 5 83 | 84 | it "recalculates memoized values in response to actions" \ref -> do 85 | { expensive1, expensive2, expensive3 } <- evalM ref do 86 | eval H.Initialize 87 | 88 | { incrementA, incrementB } <- readResult ref 89 | eval (H.Action incrementA) *> eval (H.Action incrementB) 90 | 91 | eval H.Finalize 92 | readResult ref 93 | 94 | expensive1 `shouldEqual` 6 95 | expensive2 `shouldEqual` 6 96 | expensive3 `shouldEqual` 7 97 | 98 | logShouldBe ref $ fold 99 | [ initializeSteps 100 | -- incrementA should recompute memos 1 and 3 101 | , [ ModifyState, RunHooks Step, RunMemo (CalculateMemo 1), RunMemo (CalculateMemo 3), Render ] 102 | -- incrementB should recompute memos 2 and 3 103 | , [ ModifyState, RunHooks Step, RunMemo (CalculateMemo 2), RunMemo (CalculateMemo 3), Render ] 104 | 105 | , finalizeSteps 106 | ] 107 | 108 | it "does not recalculate memoized values when memos are unchanged" \ref -> do 109 | { expensive1, expensive2, expensive3 } <- evalM ref do 110 | eval H.Initialize 111 | 112 | { incrementC } <- readResult ref 113 | eval (H.Action incrementC) 114 | 115 | eval H.Finalize 116 | readResult ref 117 | 118 | expensive1 `shouldEqual` 5 119 | expensive2 `shouldEqual` 5 120 | expensive3 `shouldEqual` 5 121 | 122 | logShouldBe ref $ fold 123 | [ initializeSteps 124 | , [ ModifyState, RunHooks Step, Render ] -- incrementC shouldn't affect memoized values 125 | , finalizeSteps 126 | ] 127 | 128 | where 129 | initializeSteps = 130 | [ RunHooks Initialize, RunMemo (CalculateMemo 1), RunMemo (CalculateMemo 2), RunMemo (CalculateMemo 3), Render ] 131 | 132 | finalizeSteps = 133 | [ RunHooks Finalize, Render ] 134 | -------------------------------------------------------------------------------- /test/Test/Hooks/UseRef.purs: -------------------------------------------------------------------------------- 1 | module Test.Hooks.UseRef where 2 | 3 | import Prelude 4 | 5 | import Data.Foldable (fold) 6 | import Data.Tuple.Nested ((/\)) 7 | import Effect.Aff (Aff) 8 | import Effect.Ref as Ref 9 | import Halogen (liftEffect) 10 | import Halogen as H 11 | import Halogen.Hooks (type (<>), Hook, HookM, UseRef) 12 | import Halogen.Hooks as Hooks 13 | import Halogen.Hooks.Internal.Eval.Types (InterpretHookReason(..)) 14 | import Test.Setup.Eval (evalM, initDriver, mkEval) 15 | import Test.Setup.Log (logShouldBe, readResult) 16 | import Test.Setup.Types (TestEvent(..)) 17 | import Test.Spec (Spec, before, describe, it) 18 | import Test.Spec.Assertions (shouldEqual) 19 | 20 | type Interface = { increment :: HookM Aff Unit, count :: Int } 21 | 22 | useRefCount :: Hook Aff (UseRef Int <> Hooks.Pure) Interface 23 | useRefCount = Hooks.do 24 | count /\ countRef <- Hooks.useRef 0 25 | Hooks.pure { count, increment: liftEffect $ Ref.modify_ (_ + 1) countRef } 26 | 27 | refHook :: Spec Unit 28 | refHook = before initDriver $ describe "useRef" do 29 | let eval = mkEval (const useRefCount) 30 | 31 | it "initializes to the proper initial value" \ref -> do 32 | { count } <- evalM ref do 33 | eval H.Initialize 34 | readResult ref 35 | 36 | count `shouldEqual` 0 37 | 38 | it "updates state in response to actions" \ref -> do 39 | { count } <- evalM ref do 40 | eval H.Initialize 41 | 42 | { increment } <- readResult ref 43 | eval (H.Action increment) 44 | eval (H.Action increment) 45 | eval (H.Action increment) 46 | 47 | eval H.Finalize 48 | readResult ref 49 | 50 | count `shouldEqual` 3 51 | 52 | it "does not cause re-evaluation when value updates" \ref -> do 53 | { count } <- evalM ref do 54 | eval H.Initialize 55 | 56 | { increment } <- readResult ref 57 | eval (H.Action increment) 58 | eval (H.Action increment) 59 | eval (H.Action increment) 60 | eval (H.Action increment) 61 | 62 | eval H.Finalize 63 | readResult ref 64 | 65 | count `shouldEqual` 4 66 | 67 | -- despite multiple increments there should be no hook evaluation outside 68 | -- of the initializer and finalizer 69 | logShouldBe ref $ fold [ initializeSteps, finalizeSteps ] 70 | 71 | where 72 | initializeSteps = 73 | [ RunHooks Initialize, Render ] 74 | 75 | finalizeSteps = 76 | [ RunHooks Finalize, Render ] 77 | -------------------------------------------------------------------------------- /test/Test/Hooks/UseState.purs: -------------------------------------------------------------------------------- 1 | module Test.Hooks.UseState where 2 | 3 | import Prelude 4 | 5 | import Data.Array (replicate) 6 | import Data.Foldable (fold) 7 | import Data.Tuple.Nested ((/\)) 8 | import Effect.Aff (Aff) 9 | import Halogen as H 10 | import Halogen.Hooks (type (<>), Hook, HookM, UseState) 11 | import Halogen.Hooks as Hooks 12 | import Halogen.Hooks.Internal.Eval.Types (InterpretHookReason(..)) 13 | import Test.Setup.Eval (evalM, mkEval, initDriver) 14 | import Test.Setup.Log (logShouldBe, readResult) 15 | import Test.Setup.Types (TestEvent(..)) 16 | import Test.Spec (Spec, before, describe, it) 17 | import Test.Spec.Assertions (shouldEqual) 18 | 19 | type Interface = 20 | { count :: Int 21 | , increment :: HookM Aff Unit 22 | } 23 | 24 | useStateCount :: Hook Aff (UseState Int <> Hooks.Pure) Interface 25 | useStateCount = Hooks.do 26 | count /\ countId <- Hooks.useState 0 27 | 28 | Hooks.pure 29 | { count 30 | , increment: Hooks.modify_ countId (_ + 1) 31 | } 32 | 33 | stateHook :: Spec Unit 34 | stateHook = before initDriver $ describe "useState" do 35 | let eval = mkEval (const useStateCount) 36 | 37 | it "initializes to the proper initial state value" \ref -> do 38 | { count } <- evalM ref do 39 | eval H.Initialize 40 | readResult ref 41 | 42 | count `shouldEqual` 0 43 | 44 | it "updates state in response to actions" \ref -> do 45 | { count } <- evalM ref do 46 | eval H.Initialize 47 | 48 | { increment } <- readResult ref 49 | eval (H.Action increment) 50 | eval (H.Action increment) 51 | 52 | eval H.Finalize 53 | readResult ref 54 | 55 | count `shouldEqual` 2 56 | logShouldBe ref $ fold 57 | [ initializeSteps 58 | , fold $ replicate 2 [ ModifyState, RunHooks Step, Render ] 59 | , finalizeSteps 60 | ] 61 | 62 | where 63 | initializeSteps = 64 | [ RunHooks Initialize, Render ] 65 | 66 | finalizeSteps = 67 | [ RunHooks Finalize, Render ] 68 | -------------------------------------------------------------------------------- /test/Test/Hooks/UseTickEffect.purs: -------------------------------------------------------------------------------- 1 | module Test.Hooks.UseTickEffect where 2 | 3 | import Prelude 4 | 5 | import Data.Array (replicate) 6 | import Data.Foldable (fold) 7 | import Data.Maybe (Maybe(..)) 8 | import Data.Tuple.Nested ((/\)) 9 | import Effect.Aff (Aff) 10 | import Halogen as H 11 | import Halogen.Hooks (type (<>), Hook, HookM, UseEffect, UseState) 12 | import Halogen.Hooks as Hooks 13 | import Halogen.Hooks.Internal.Eval.Types (InterpretHookReason(..)) 14 | import Test.Setup.Eval (evalM, initDriver, mkEval) 15 | import Test.Setup.Log (logShouldBe, readResult, writeLog) 16 | import Test.Setup.Types (EffectType(..), LogRef, TestEvent(..)) 17 | import Test.Spec (Spec, before, describe, it) 18 | import Test.Spec.Assertions (shouldEqual) 19 | 20 | type Interface = 21 | { increment :: HookM Aff Unit 22 | , toggle :: HookM Aff Unit 23 | , count :: Int 24 | } 25 | 26 | type UseLogHook = UseState Int <> UseState Boolean <> UseEffect <> Hooks.Pure 27 | 28 | useTickEffectLog :: LogRef -> Hook Aff UseLogHook Interface 29 | useTickEffectLog log = Hooks.do 30 | count /\ countId <- Hooks.useState 0 31 | _ /\ toggleId <- Hooks.useState false 32 | useLogger { count, id: 0 } 33 | Hooks.pure 34 | { count 35 | , increment: Hooks.modify_ countId (_ + 1) 36 | , toggle: Hooks.modify_ toggleId not 37 | } 38 | where 39 | useLogger deps@{ id } = Hooks.captures deps Hooks.useTickEffect do 40 | writeLog (RunEffect (EffectBody id)) log 41 | pure $ Just do 42 | writeLog (RunEffect (EffectCleanup id)) log 43 | 44 | tickEffectHook :: Spec Unit 45 | tickEffectHook = before initDriver $ describe "useTickEffect" do 46 | let eval = mkEval useTickEffectLog 47 | 48 | it "effect runs on initialize and cleans up on finalize" \ref -> do 49 | evalM ref $ eval H.Initialize *> eval H.Finalize 50 | logShouldBe ref $ fold [ initializeSteps, finalizeSteps ] 51 | 52 | it "effect runs on memo change and cleans up before next run" \ref -> do 53 | { count } <- evalM ref do 54 | eval H.Initialize 55 | 56 | { increment } <- readResult ref 57 | eval (H.Action increment) *> eval (H.Action increment) 58 | 59 | eval H.Finalize 60 | readResult ref 61 | 62 | count `shouldEqual` 2 63 | logShouldBe ref $ fold 64 | [ initializeSteps 65 | , fold $ replicate 2 66 | [ ModifyState 67 | , RunHooks Step 68 | , Render 69 | , RunEffect (EffectCleanup 0) 70 | , RunEffect (EffectBody 0) 71 | ] 72 | , finalizeSteps 73 | ] 74 | 75 | it "effect is skipped when memos are unchanged" \ref -> do 76 | _ <- evalM ref do 77 | eval H.Initialize 78 | 79 | { toggle } <- readResult ref 80 | eval (H.Action toggle) *> eval (H.Action toggle) 81 | 82 | eval H.Finalize 83 | readResult ref 84 | 85 | -- Unlike the previous test, there should not be successive effect cleanup 86 | -- and evaluation during hook evaluations because deps are unchanged. 87 | logShouldBe ref $ fold 88 | [ initializeSteps 89 | , fold $ replicate 2 [ ModifyState, RunHooks Step, Render ] 90 | , finalizeSteps 91 | ] 92 | 93 | where 94 | initializeSteps = 95 | [ RunHooks Initialize, Render, RunEffect (EffectBody 0) ] 96 | 97 | finalizeSteps = 98 | [ RunHooks Finalize, Render, RunEffect (EffectCleanup 0) ] 99 | -------------------------------------------------------------------------------- /test/Test/Integration/Issue5.purs: -------------------------------------------------------------------------------- 1 | module Test.Integration.Issue5 where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Data.Tuple.Nested ((/\)) 7 | import Effect.Aff (Aff) 8 | import Halogen as H 9 | import Halogen.Hooks (class HookNewtype, type (<>), Hook, UseEffect, UseState) 10 | import Halogen.Hooks as Hooks 11 | import Halogen.Hooks.Internal.Eval.Types (InterpretHookReason(..)) 12 | import Test.Setup.Eval (evalM, initDriver, mkEval) 13 | import Test.Setup.Log (logShouldBe, readResult, writeLog) 14 | import Test.Setup.Types (EffectType(..), LogRef, TestEvent(..)) 15 | import Test.Spec (Spec, before, describe, it) 16 | import Test.Spec.Assertions (fail) 17 | 18 | foreign import data UseTickAfterInitialize :: Hooks.HookType 19 | 20 | type UseTickAfterInitialize' = 21 | UseState Int 22 | <> UseState Int 23 | <> UseEffect 24 | <> UseState Int 25 | <> UseEffect 26 | <> Hooks.Pure 27 | 28 | instance HookNewtype UseTickAfterInitialize UseTickAfterInitialize' 29 | 30 | rerunTickAfterInitialEffects :: LogRef -> Hook Aff UseTickAfterInitialize { count :: Int, state1 :: Int, state2 :: Int } 31 | rerunTickAfterInitialEffects log = Hooks.wrap Hooks.do 32 | count /\ _ <- Hooks.useState 0 33 | 34 | state1 /\ state1Id <- Hooks.useState 1 35 | 36 | Hooks.useLifecycleEffect do 37 | writeLog (RunEffect (EffectBody 0)) log 38 | Hooks.modify_ state1Id (_ + 1) 39 | pure $ Just do 40 | writeLog (RunEffect (EffectCleanup 0)) log 41 | 42 | state2 /\ state2Id <- Hooks.useState 0 43 | 44 | useMyEffect (Hooks.modify_ state2Id) { state1 } 45 | 46 | Hooks.pure { count, state1, state2 } 47 | where 48 | useMyEffect modifyState2 deps@{ state1 } = Hooks.captures deps Hooks.useTickEffect do 49 | writeLog (RunEffect (EffectBody 1)) log 50 | modifyState2 (_ + state1) 51 | pure $ Just do 52 | writeLog (RunEffect (EffectCleanup 1)) log 53 | 54 | rerunTickAfterInitialEffectsHook :: Spec Unit 55 | rerunTickAfterInitialEffectsHook = before initDriver $ describe "rerunTickAfterInitialEffects" do 56 | let eval = mkEval rerunTickAfterInitialEffects 57 | 58 | it "tick effect reruns when memos are updated via initial effect's state modification" \ref -> do 59 | { count, state1, state2 } <- evalM ref do 60 | eval H.Initialize 61 | readResult ref 62 | 63 | when (count /= 0) $ fail $ "count /= 0. count: " <> show count 64 | when (state1 /= 2) $ fail $ "state1 /= 2. state1: " <> show state1 65 | when (state2 /= 3) $ fail $ "state2 /= 3. state2: " <> show state2 66 | logShouldBe ref initializeSteps 67 | 68 | where 69 | initializeSteps = 70 | [ RunHooks Initialize -- initialize hooks 71 | , Render -- first render occurs 72 | 73 | , RunEffect (EffectBody 0) -- run enqueued lifecycle effect's initializer 74 | , ModifyState -- state1 gets incremented to 2, 75 | -- which should cause tick effect to rerun 76 | , RunHooks Queued -- rerun all non-effect hooks to update state 77 | -- now the returned `state1` value is 2 78 | , Render -- render 79 | 80 | , RunEffect (EffectBody 1) -- run enqueued tick effect's initializer 81 | , ModifyState -- state2 gets incremented to 1 82 | -- (i.e. 0 + state1's initial value: 1) 83 | , RunHooks Queued -- rerun all non-effect hooks to update state 84 | -- now the returned `state2` value is 1 85 | , Render -- render 86 | 87 | , RunHooks Step -- rerun hooks in case tick effect updated state 88 | -- here we enqueue but don't yet run the 89 | -- tick effect due to the lifecycle effect's 90 | -- initializer modifying its dependencies 91 | , Render -- render (because we have to...) 92 | 93 | , RunEffect (EffectCleanup 1) -- rerun enqueued tick effect's initializer 94 | , RunEffect (EffectBody 1) -- and finalizer in one call 95 | , ModifyState -- state2 gets incremented to 3 96 | -- (i.e. 1 + state2's current value: 2) 97 | 98 | , RunHooks Queued -- rerun all non-effect hooks to update state 99 | -- now the returned `state2` value is 3 100 | , Render -- render 101 | 102 | , RunHooks Step -- rerun hooks in case tick effect updated state 103 | , Render 104 | ] 105 | -------------------------------------------------------------------------------- /test/Test/Integration/Issue73.purs: -------------------------------------------------------------------------------- 1 | module Test.Integration.Issue73 where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Effect.Aff (Aff) 7 | import Halogen (liftAff) 8 | import Halogen as H 9 | import Halogen.Hooks (class HookNewtype, type (<>), Hook, UseEffect) 10 | import Halogen.Hooks as Hooks 11 | import Halogen.Hooks.Internal.Eval.Types (InterpretHookReason(..)) 12 | import Test.Setup.Eval (evalM, initDriver, mkEval) 13 | import Test.Setup.Log (getLogRef, logShouldBe, writeLog) 14 | import Test.Setup.Types (EffectType(..), LogRef, TestEvent(..)) 15 | import Test.Spec (Spec, before, describe, it) 16 | 17 | foreign import data UseImmediateRaiseAndReceive :: Hooks.HookType 18 | 19 | type UseImmediateRaiseAndReceive' = UseEffect <> Hooks.Pure 20 | 21 | instance HookNewtype UseImmediateRaiseAndReceive UseImmediateRaiseAndReceive' 22 | 23 | interruptInitialize :: Aff Unit -> LogRef -> Hook Aff UseImmediateRaiseAndReceive Unit 24 | interruptInitialize interrupt log = Hooks.wrap Hooks.do 25 | Hooks.captures { once : true } Hooks.useTickEffect do 26 | writeLog (RunEffect (EffectBody 0)) log 27 | liftAff interrupt 28 | pure $ Just do 29 | writeLog (RunEffect (EffectCleanup 0)) log 30 | 31 | Hooks.pure unit 32 | 33 | safeInitialize :: Spec Unit 34 | safeInitialize = before initDriver $ describe "safeInitialize" do 35 | 36 | let 37 | -- receive should simulate a parent component firing a Receive to the running hook in response to an action in 38 | -- UseEffect 39 | receive ref = do 40 | logRef <- getLogRef ref 41 | evalM ref $ mkEval ( interruptInitialize $ pure unit ) ( H.Receive logRef ) 42 | 43 | it "effect initialization should be safe from interuption by parent" \ref -> do 44 | 45 | evalM ref $ mkEval ( interruptInitialize $ receive ref ) H.Initialize 46 | 47 | logShouldBe ref initializeSteps 48 | 49 | where 50 | initializeSteps = 51 | [ RunHooks Initialize -- initialize hooks 52 | , Render -- first render occurs 53 | 54 | , RunEffect (EffectBody 0) -- run enqueued lifecycle effect's initializer 55 | , RunHooks Step -- get interrupted by parent 56 | , Render -- render because of parent 57 | ] 58 | -------------------------------------------------------------------------------- /test/Test/Integration/Spec.purs: -------------------------------------------------------------------------------- 1 | module Test.Integration.Spec where 2 | 3 | import Prelude 4 | 5 | import Test.Integration.Issue5 (rerunTickAfterInitialEffectsHook) 6 | import Test.Integration.Issue73 (safeInitialize) 7 | import Test.Spec (Spec) 8 | 9 | spec :: Spec Unit 10 | spec = do 11 | rerunTickAfterInitialEffectsHook 12 | safeInitialize 13 | -------------------------------------------------------------------------------- /test/Test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main (main) where 2 | 3 | import Prelude hiding (compare) 4 | 5 | import Effect (Effect) 6 | import Effect.Aff (launchAff_) 7 | import Test.Hooks.Spec as Hooks.Spec 8 | import Test.Integration.Spec as Integration.Spec 9 | import Test.Spec (describe) 10 | import Test.Spec.Reporter (consoleReporter) 11 | import Test.Spec.Runner (runSpec) 12 | 13 | main :: Effect Unit 14 | main = launchAff_ $ runSpec [ consoleReporter ] do 15 | describe "Hooks Tests" Hooks.Spec.spec 16 | describe "Integration Tests" Integration.Spec.spec 17 | -------------------------------------------------------------------------------- /test/Test/Setup/Eval.purs: -------------------------------------------------------------------------------- 1 | -- An alternate way to evaluate hooks without components, useful for ensuring 2 | -- the logic is correct. 3 | module Test.Setup.Eval where 4 | 5 | import Prelude 6 | 7 | import Control.Monad.Free (foldFree, liftF, substFree) 8 | import Data.Maybe (Maybe(..)) 9 | import Data.Newtype (over, unwrap) 10 | import Data.Tuple (Tuple(..)) 11 | import Effect.Aff (Aff) 12 | import Effect.Class (class MonadEffect, liftEffect) 13 | import Effect.Exception.Unsafe (unsafeThrow) 14 | import Effect.Ref (Ref) 15 | import Effect.Ref as Ref 16 | import Effect.Unsafe (unsafePerformEffect) 17 | import Halogen (HalogenQ) 18 | import Halogen as H 19 | import Halogen.Aff.Driver.Eval as Aff.Driver.Eval 20 | import Halogen.Aff.Driver.State (DriverState(..), DriverStateX, initDriverState) 21 | import Halogen.HTML as HH 22 | import Halogen.Hooks (Hook, HookF(..), HookM(..)) 23 | import Halogen.Hooks.Hook (unsafeFromHook) 24 | import Halogen.Hooks.Internal.Eval as Hooks.Eval 25 | import Halogen.Hooks.Internal.Eval.Types (HalogenM', HookState(..)) 26 | import Halogen.Hooks.Types (ComponentRef, StateId(..)) 27 | import Test.Setup.Log (writeLog) 28 | import Test.Setup.Types (DriverResultState, LogRef, TestEvent(..), HalogenF') 29 | import Unsafe.Coerce (unsafeCoerce) 30 | import Unsafe.Reference (unsafeRefEq) 31 | 32 | -- Our test `evalM` function hijacks the `State` implementation from the Halogen 33 | -- `Aff.Driver.Eval.evalM` implementation, and otherwise passes constructors 34 | -- through. This allows us to inspect the result of a state modification and 35 | -- log it. 36 | -- 37 | -- WARNING: This must be kept in sync with the underlying Halogen implementation. 38 | evalM :: forall r q b. Ref (DriverResultState r q b) -> HalogenM' q LogRef Aff b ~> Aff 39 | evalM ref (H.HalogenM hm) = Aff.Driver.Eval.evalM mempty ref (foldFree go hm) 40 | where 41 | go :: HalogenF' q LogRef Aff b ~> HalogenM' q LogRef Aff b 42 | go = case _ of 43 | -- We'll report renders the same way Halogen triggers them: successful 44 | -- state modifications. 45 | H.State f -> H.lift do 46 | DriverState (st@{ state, lifecycleHandlers }) <- liftEffect (Ref.read ref) 47 | case f state of 48 | Tuple a state' 49 | | unsafeRefEq state state' -> do 50 | pure a 51 | | otherwise -> do 52 | -- First, we'll log that a render is occurring. 53 | { input } <- liftEffect $ Ref.read (unwrap state).stateRef 54 | writeLog Render input 55 | 56 | -- Then we'll defer to the Halogen implementation. 57 | liftEffect $ Ref.write (DriverState (st { state = state' })) ref 58 | _ <- Aff.Driver.Eval.handleLifecycle lifecycleHandlers (pure unit) 59 | pure a 60 | 61 | c -> 62 | H.HalogenM $ liftF c 63 | 64 | evalHookM :: forall q a. HalogenM' q LogRef Aff a a -> HookM Aff ~> HalogenM' q LogRef Aff a 65 | evalHookM runHooks (HookM hm) = foldFree go hm 66 | where 67 | go :: HookF Aff ~> HalogenM' q LogRef Aff a 68 | go = case _ of 69 | c@(Modify (StateId (Tuple ref id)) f _) -> do 70 | HookState { stateRef } <- H.get 71 | 72 | let state = unsafePerformEffect $ Ref.read stateRef 73 | 74 | case unsafeRefEq state.componentRef ref of 75 | true -> 76 | pure unit 77 | _ -> 78 | unsafeThrow "Attempted to use state-modifying HookM code outside the component where it was defined." 79 | 80 | let 81 | v = Hooks.Eval.unsafeGetCell id state.stateCells.queue 82 | 83 | -- Calls to `get` should not trigger evaluation. This matches with the 84 | -- underlying implementation of `evalHookM` and Halogen's `evalM`. 85 | case unsafeRefEq v (f v) of 86 | true -> 87 | pure unit 88 | _ -> 89 | writeLog ModifyState state.input 90 | 91 | Hooks.Eval.evalHookM runHooks (HookM $ liftF c) 92 | 93 | c -> 94 | -- For now, all other constructors are ordinary `HalogenM` 95 | Hooks.Eval.evalHookM runHooks (HookM $ liftF c) 96 | 97 | -- | Hooks.Eval.mkEval, specialized to local evalHookHm and interpretUseHookFn 98 | -- | functions, and pre-specialized to `Unit` for convenience. 99 | mkEval 100 | :: forall h q b 101 | . (LogRef -> Hook Aff h b) 102 | -> (Unit -> HalogenQ q (HookM Aff Unit) LogRef Unit) 103 | -> HalogenM' q LogRef Aff b Unit 104 | mkEval h q = mkEvalQuery h (H.mkTell q) 105 | 106 | mkEvalQuery 107 | :: forall h q b a 108 | . (LogRef -> Hook Aff h b) 109 | -> HalogenQ q (HookM Aff Unit) LogRef a 110 | -> HalogenM' q LogRef Aff b a 111 | mkEvalQuery hookFn = 112 | Hooks.Eval.mkEval (\_ _ -> false) evalHookM evalHook 113 | where 114 | -- WARNING: Unlike the other functions, this one needs to be manually kept in 115 | -- sync with the implementation in the main Hooks library. If you change this 116 | -- function, also check the main library function. 117 | evalHook reason = do 118 | HookState { stateRef } <- H.get 119 | 120 | let 121 | eval = Hooks.Eval.evalHook evalHookM evalHook reason stateRef 122 | { input } = unsafePerformEffect $ Ref.read stateRef 123 | hookF = unsafeFromHook (hookFn input) 124 | 125 | writeLog (RunHooks reason) input 126 | a <- H.HalogenM (substFree eval hookF) 127 | 128 | H.modify_ (over HookState _ { result = a }) 129 | pure a 130 | 131 | -- | Create a new DriverState, which can be used to evaluate multiple calls to 132 | -- | evaluate test code, and which contains the LogRef. 133 | -- | 134 | -- | TODO: It should be possible to use the created driver with `evalQ` to 135 | -- | produce a way to run actual queries; however, that would mean the driver 136 | -- | would need to be created using the actual eval function. 137 | -- | 138 | -- | For more details, look at how Halogen runs components with `runUI` and 139 | -- | returns an interface that can be used to query them. We essentially want 140 | -- | to do that, but without the rendering. 141 | initDriver :: forall m r q a. MonadEffect m => m (Ref (DriverResultState r q a)) 142 | initDriver = liftEffect do 143 | logRef <- Ref.new [] 144 | 145 | stateRef <- Ref.new 146 | { input: logRef 147 | , componentRef: unsafeCoerce {} :: ComponentRef 148 | , queryFn: Nothing 149 | , stateCells: { queue: [], index: 0 } 150 | , effectCells: { queue: [], index: 0 } 151 | , memoCells: { queue: [], index: 0 } 152 | , refCells: { queue: [], index: 0 } 153 | , evalQueue: [] 154 | , stateDirty: false 155 | } 156 | 157 | lifecycleHandlers <- Ref.new mempty 158 | 159 | map unDriverStateXRef do 160 | initDriverState 161 | { initialState: \_ -> HookState { result: unit, stateRef } 162 | , render: \_ -> HH.text "" 163 | , eval: H.mkEval H.defaultEval 164 | } 165 | unit 166 | mempty 167 | lifecycleHandlers 168 | where 169 | unDriverStateXRef 170 | :: forall r' s' f' act' ps' i' o' 171 | . Ref (DriverStateX r' f' o') 172 | -> Ref (DriverState r' s' f' act' ps' i' o') 173 | unDriverStateXRef = unsafeCoerce 174 | -------------------------------------------------------------------------------- /test/Test/Setup/Log.purs: -------------------------------------------------------------------------------- 1 | module Test.Setup.Log where 2 | 3 | import Prelude 4 | 5 | import Data.Array as Array 6 | import Data.Newtype (unwrap) 7 | import Effect.Aff (Aff, launchAff_) 8 | import Effect.Class (class MonadEffect, liftEffect) 9 | import Effect.Ref (Ref) 10 | import Effect.Ref as Ref 11 | import Effect.Unsafe (unsafePerformEffect) 12 | import Halogen.Aff.Driver.State (DriverState(..)) 13 | import Test.Setup.Types (DriverResultState, LogRef, TestEvent, Log) 14 | import Test.Spec.Assertions (shouldEqual) 15 | 16 | logShouldBe :: forall r q a. Ref (DriverResultState r q a) -> Log -> Aff Unit 17 | logShouldBe ref x = readLog ref >>= shouldEqual x 18 | 19 | unsafeWriteLog :: TestEvent -> LogRef -> Unit 20 | unsafeWriteLog event ref = do 21 | let _ = unsafePerformEffect $ launchAff_ $ writeLog event ref 22 | unit 23 | 24 | writeLog :: forall m. MonadEffect m => TestEvent -> LogRef -> m Unit 25 | writeLog event ref = liftEffect do 26 | log <- Ref.read ref 27 | Ref.write (Array.snoc log event) ref 28 | 29 | getLogRef :: forall m r q a. MonadEffect m => Ref (DriverResultState r q a) -> m ( Ref Log ) 30 | getLogRef ref = liftEffect do 31 | DriverState driver <- Ref.read ref 32 | state <- Ref.read (unwrap driver.state).stateRef 33 | pure state.input 34 | 35 | readLog :: forall m r q a. MonadEffect m => Ref (DriverResultState r q a) -> m Log 36 | readLog ref = liftEffect do 37 | DriverState driver <- Ref.read ref 38 | state <- Ref.read (unwrap driver.state).stateRef 39 | Ref.read state.input 40 | 41 | clearLog :: forall m r q a. MonadEffect m => Ref (DriverResultState r q a) -> m Unit 42 | clearLog ref = liftEffect do 43 | DriverState driver <- Ref.read ref 44 | state <- Ref.read (unwrap driver.state).stateRef 45 | Ref.write [] state.input 46 | 47 | -- | Useful for logging result state outside of hook evaluation. For example, in 48 | -- | this block we can only access `count` once the actions are completed, but 49 | -- | not in between several actions: 50 | -- | 51 | -- | ```purs` 52 | -- | { count } <- evalM ref do 53 | -- | { tick } <- initialize 54 | -- | action tick *> action tick 55 | -- | finalize 56 | -- | ``` 57 | -- | 58 | -- | But with `readResult` we can inspect the value in between actions: 59 | -- | 60 | -- | ```purs 61 | -- | count <- evalM ref do 62 | -- | { tick } <- initialize 63 | -- | action tick 64 | -- | readResult ref >>= logShow 65 | -- | finalize 66 | -- | ``` 67 | readResult :: forall m r q a. MonadEffect m => Ref (DriverResultState r q a) -> m a 68 | readResult ref = liftEffect do 69 | DriverState driver <- Ref.read ref 70 | pure $ (unwrap driver.state).result 71 | -------------------------------------------------------------------------------- /test/Test/Setup/Types.purs: -------------------------------------------------------------------------------- 1 | module Test.Setup.Types where 2 | 3 | import Prelude 4 | 5 | import Data.Foldable (fold) 6 | import Data.Generic.Rep (class Generic) 7 | import Data.Show.Generic (genericShow) 8 | import Effect.Aff (Aff) 9 | import Effect.Ref (Ref) 10 | import Halogen as H 11 | import Halogen.Aff.Driver.State (DriverState) 12 | import Halogen.Hooks (HookM) 13 | import Halogen.Hooks.Internal.Eval.Types (HookState, InterpretHookReason(..)) 14 | import Halogen.Hooks.Internal.Types (OutputValue, SlotType) 15 | 16 | type HalogenF' q i m b a = H.HalogenF (HookState q i m b) (HookM m Unit) SlotType OutputValue m a 17 | 18 | type DriverResultState r q a = DriverState r (HookState q LogRef Aff a) q (HookM Aff Unit) SlotType LogRef OutputValue 19 | 20 | type LogRef = Ref Log 21 | 22 | type Log = Array TestEvent 23 | 24 | data TestEvent 25 | = RunHooks InterpretHookReason 26 | | ModifyState 27 | | RunEffect EffectType 28 | | RunMemo MemoType 29 | | EvaluateHook HookType 30 | | Render 31 | 32 | derive instance Eq TestEvent 33 | 34 | instance Show TestEvent where 35 | show = case _ of 36 | RunHooks reason -> 37 | append "RunHooks " case reason of 38 | Initialize -> "Initialize" 39 | Queued -> "Queued" 40 | Step -> "Step" 41 | Finalize -> "Finalize" 42 | 43 | ModifyState -> 44 | "ModifyState" 45 | 46 | RunEffect effect -> 47 | fold [ "RunEffect ", show effect ] 48 | 49 | RunMemo memo -> 50 | fold [ "RunMemo ", show memo ] 51 | 52 | EvaluateHook hook -> 53 | fold [ "EvaluateHook ", show hook ] 54 | 55 | Render -> 56 | "Render" 57 | 58 | data HookType 59 | = UseStateHook 60 | | UseEffectHook 61 | | UseMemoHook 62 | | UseRefHook 63 | 64 | derive instance Eq HookType 65 | derive instance Generic HookType _ 66 | 67 | instance Show HookType where 68 | show = genericShow 69 | 70 | data EffectType = EffectBody Int | EffectCleanup Int 71 | 72 | derive instance Eq EffectType 73 | derive instance Generic EffectType _ 74 | 75 | instance Show EffectType where 76 | show = genericShow 77 | 78 | data MemoType = CalculateMemo Int 79 | 80 | derive instance Eq MemoType 81 | derive instance Generic MemoType _ 82 | 83 | instance Show MemoType where 84 | show = genericShow 85 | -------------------------------------------------------------------------------- /test/run-snapshot.mjs: -------------------------------------------------------------------------------- 1 | import { main } from "../output-es/Performance.Snapshot.Write/index.js"; 2 | 3 | main(); 4 | -------------------------------------------------------------------------------- /test/run-test.mjs: -------------------------------------------------------------------------------- 1 | import { main } from "../output-es/Performance.Main/index.js"; 2 | 3 | main(); 4 | -------------------------------------------------------------------------------- /test/test.dhall: -------------------------------------------------------------------------------- 1 | let conf = ../spago.dhall 2 | in conf // 3 | { dependencies = 4 | conf.dependencies # 5 | [ "aff-promise" 6 | , "avar" 7 | , "argonaut-codecs" 8 | , "argonaut-core" 9 | , "either" 10 | , "console" 11 | , "integers" 12 | , "node-buffer" 13 | , "node-fs" 14 | , "node-path" 15 | , "nullable" 16 | , "spec" 17 | , "strings" 18 | , "random" 19 | ] 20 | , sources = 21 | conf.sources # 22 | [ "test/**/*.purs" 23 | ] 24 | } 25 | -------------------------------------------------------------------------------- /test/test.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | Test Halogen Hooks 7 | 8 | 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /test/test.performance.dhall: -------------------------------------------------------------------------------- 1 | let conf = ./test.dhall 2 | in conf // { backend = "purs-backend-es build" } 3 | --------------------------------------------------------------------------------