diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ -

A tasty Haskell web and mobile framework 🍜

+

A Haskell library for building web and mobile applications

@@ -27,32 +27,45 @@

-## +

+Inspired by Elm and React. See the GitHub org. Try it. Read the docs. +

-**Miso** is a small, production-ready, component-oriented, [reactive](https://github.com/haskell-miso/miso-reactive), [isomorphic](http://nerds.airbnb.com/isomorphic-javascript-future-web-apps/) [Haskell](https://www.haskell.org/) front-end framework for quickly building highly interactive single-page web and [mobile](https://github.com/dmjio/miso-native) applications. It features a virtual-dom, recursive diffing / patching algorithm, attribute and property normalization, event delegation, event batching, SVG, 2D/3D Canvas (WebGL), [Fetch](https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API), Server-sent events ([SSE](https://github.com/haskell-miso/miso-sse)), [Websockets](https://github.com/haskell-miso/miso-websocket), type-safe [servant](https://haskell-servant.github.io/)-style routing and an extensible Subscription-based subsystem. Inspired by [Elm](http://elm-lang.org/) and [React](http://react.dev/). **Miso** is pure by default, but side effects can be introduced into the system via the `Effect` data type. +## Key features -**Miso** makes heavy use of the [GHC Javascript FFI](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/wasm.html#javascript-ffi-in-the-wasm-backend) and therefore has minimal dependencies. **Miso** can be considered a shallow [embedded domain-specific language](https://wiki.haskell.org/Embedded_domain_specific_language) for modern web programming. +- [Virtual DOM](https://en.wikipedia.org/wiki/Virtual_DOM) with recursive diffing and patching algorithm +- Attribute and property normalization, event delegation, and event batching +- Model-View-Update paradigm +- Pure by default +- SVG, 2D Canvas, and WebGL (via [three.js](https://threejs.org)) +- [Fetch](https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API), [Server-Sent Events](https://github.com/haskell-miso/miso-sse), and [WebSocket](https://github.com/haskell-miso/miso-websocket) support +- Type-safe client-side routing +- An extensible subscription system for long-running effects and third-party library integration +- Lifecycle hooks (`onCreated`, `onDestroyed`, `mount`, `unmount`) +- [Reactive](https://github.com/haskell-miso/miso-reactive) extensions for fine-grained reactivity +- [Component](https://react.dev/reference/react/Component), [Fragment](https://react.dev/reference/react/Fragment) and [Props](https://react.dev/learn/passing-props-to-a-component) features. -**Miso** supports compilation to both [JavaScript](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/javascript.html) and [WebAssembly](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/wasm.html) using [GHC](https://www.haskell.org/ghc/). For hot-reload, `miso` uses [WASM browser mode](https://www.tweag.io/blog/2025-04-17-wasm-ghci-browser/). When used with [ghciwatch](https://github.com/MercuryTechnologies/ghciwatch) this enables a rapid development workflow. +It makes heavy use of the [GHC JavaScript FFI](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/wasm.html#javascript-ffi-in-the-wasm-backend) and maintains minimal dependencies. It can be considered a shallow [embedded domain-specific language](https://wiki.haskell.org/Embedded_domain_specific_language) for modern web programming. Compilation targets include [JavaScript](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/javascript.html) and [WebAssembly](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/wasm.html) via [GHC](https://www.haskell.org/ghc/). Hot reload is provided through [WASM browser mode](https://www.tweag.io/blog/2025-04-17-wasm-ghci-browser/) integrated with [ghciwatch](https://github.com/MercuryTechnologies/ghciwatch). -> [!IMPORTANT] -> Check out the new [Haskell miso Organization](https://github.com/haskell-miso) 🍜 +> [!TIP] +> See the [Haskell miso organization](https://github.com/haskell-miso) on GitHub for the full ecosystem of packages and examples 🍜 ## Table of Contents -- [History](#history-) -- [Docs](#docs-) -- [Quick Start](#quick-start-) -- [Getting Started](#getting-started) -- [Setup](#setup-%EF%B8%8F) +- [Playground](#playground-) +- [Quick Start (Nix)](#quick-start-nix-) +- [Manual Setup (GHCup / Cabal)](#manual-setup-ghcup--cabal) + - [cabal.project](#cabalproject) + - [app.cabal](#appcabal) + - [Main.hs](#mainhs) - [Hot Reload](#hot-reload-) +- [Installation](#installation) - [Haddocks](#haddocks) - [Wiki](#wiki) - [Architecture](#architecture) - [Examples](#examples) -- [Building examples](#building-examples) - [HTTP](#interacting-with-http-apis-) -- [Coverage](#coverage-) -- [Native](#native) +- [Testing](#testing-) +- [Native](#native-) - [Benchmarks](#benchmarks-%EF%B8%8F) - [Nix](#nix-) - [Pinning nixpkgs](#pinning-nixpkgs-) @@ -65,27 +78,20 @@ - [Partnerships](#partnerships-) - [Backers](#backers) - [Organizations](#organizations) +- [History](#history-) - [License](#license) -# History πŸ“œ - -> **miso** is a play on the words ***micro*** and ***isomorphic***. - -[miso](https://haskell-miso.org) began in 2016 as research in: - - Expressing the [Elm architecture](https://elm-lang.org) in [GHCJS](https://github.com/ghcjs/ghcjs) as an [embedded domain-specific language](https://wiki.haskell.org/Embedded_domain_specific_language). - - Implementing modern JavaScript frontend techniques as found in [react](https://react.dev) (e.g. [Reconciliation](https://legacy.reactjs.org/docs/reconciliation.html#the-diffing-algorithm), [isomorphic](https://en.wikipedia.org/wiki/Isomorphic_JavaScript)) - -Miso aims to [bridge the gap](https://wiki.haskell.org/The_JavaScript_Problem) between modern JavaScript frameworks (such as [React](https://reactjs.org), [Vue.js](https://vuejs.org), etc.) and functional programming in [Haskell](https://haskell.org). It has since grown to encompass more features from the JavaScript community like [Components](https://react.dev/learn/your-first-component) and [Renderers](https://github.com/chentsulin/awesome-react-renderer). Miso also now supports [native development](https://github.com/haskell-miso/miso-lynx) for [iOS](https://www.apple.com/ios/), [Android](https://www.android.com/) and [HarmonyOS](https://device.harmonyos.com/en/) devices via [LynxJS](https://lynxjs.org) and targets additional backends like [Web Assembly](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/wasm.html). +## Playground πŸ› -## Docs πŸ“š - -See the [Miso](https://haddocks.haskell-miso.org/miso/Miso.html) module. +An interactive playground is available at [try.haskell-miso.org](https://try.haskell-miso.org). It allows editing and running applications directly in the browser without any local toolchain setup, and is useful for experimentation and sharing minimal reproducible examples. -## Quick start ⚑ +## Quick Start (Nix) ⚑ > [!TIP] -> We have a [template repository](https://github.com/haskell-miso/miso-sampler) that includes a sample counter application and build scripts for all platforms. +> The [miso-sampler](https://github.com/haskell-miso/miso-sampler) template repository includes a counter application with build scripts for WebAssembly, JavaScript, and native GHC targets. +The following requires [Nix Flakes](https://wiki.nixos.org/wiki/Flakes). See also [Binary cache](#binary-cache) to avoid rebuilding dependencies. + ```bash # Install nix curl -L https://nixos.org/nix/install | sh @@ -93,23 +99,19 @@ # Enable flakes echo 'experimental-features = nix-command flakes' >> ~/.config/nix/nix.conf -# Clone, build and host +# Clone, build and serve git clone https://github.com/haskell-miso/miso-sampler && cd miso-sampler nix develop .#wasm --command bash -c 'make && make serve' ``` -The fastest way to get started is to clone and build the [miso sampler](https://github.com/haskell-miso/miso-sampler) repository 🍱 This has build scripts for Web Assembly, JS and vanilla [GHC](https://haskell.org/ghc). This requires [Nix Flakes](https://wiki.nixos.org/wiki/Flakes) usage. See also the section on using [miso's binary cache](#binary-cache). - -## Getting started +## Manual Setup (GHCup / Cabal) -To start developing applications with `miso` you will need to acquire [GHC](https://www.haskell.org/ghc/) and [cabal](https://www.haskell.org/cabal/). This can be done via [GHCup](https://www.haskell.org/ghcup/) or [Nix](https://nixos.org/). +To develop applications without Nix, acquire [GHC](https://www.haskell.org/ghc/) and [cabal](https://www.haskell.org/cabal/) via [GHCup](https://www.haskell.org/ghcup/). > [!TIP] -> For new Haskell users we recommend using [GHCup](https://www.haskell.org/ghcup/) to acquire both [GHC](https://www.haskell.org/ghc/) and [cabal](https://www.haskell.org/cabal/) - -## Setup πŸ—οΈ +> For users new to Haskell tooling, [GHCup](https://www.haskell.org/ghcup/) is the recommended way to install both [GHC](https://www.haskell.org/ghc/) and [cabal](https://www.haskell.org/cabal/). -To develop and build your first `miso` application you will need 3 files: +A minimal application requires three files: - `cabal.project` - `app.cabal` @@ -117,7 +119,7 @@ ### `cabal.project` -```yaml +```cabal packages: . @@ -127,11 +129,14 @@ branch: master ``` +> [!NOTE] +> Pinning to a specific `tag:` or `commit:` rather than `branch: master` is recommended for reproducible builds. + ### `app.cabal` -We recommend using at least `cabal-version: 2.2`, this will give you the [common sections](https://vrom911.github.io/blog/common-stanzas) feature which we will use later to allow multiple compilers to build our project (so we can target `WASM` and `JS` backends) +Using `cabal-version: 2.2` or later enables [common stanzas](https://vrom911.github.io/blog/common-stanzas), which allow a single `.cabal` file to target both the WASM and JS backends. -```yaml +```cabal cabal-version: 2.2 name: app version: 0.1.0.0 @@ -164,7 +169,7 @@ ### `Main.hs` -This file contains a simple `miso` counter application. +A counter application demonstrating the Model-View-Update pattern: ```haskell ---------------------------------------------------------------------------- @@ -176,7 +181,6 @@ ---------------------------------------------------------------------------- import Miso import qualified Miso.Html as H -import qualified Miso.Html.Property as P import Miso.Lens ---------------------------------------------------------------------------- -- | Sum type for App events @@ -220,18 +224,17 @@ ---------------------------------------------------------------------------- ``` -Now that your project files are populated, development can begin. - ## Hot Reload πŸ”₯ -See the [WASM browser mode](https://github.com/haskell-miso/miso-sampler/blob/main/README.md#browser-mode-) section of the [miso-sampler](https://github.com/haskell-miso/miso-sampler) repository for usage of hot reload development w/ [ghciwatch](https://github.com/MercuryTechnologies/ghciwatch). Also see this [blog post](https://www.tweag.io/blog/2025-04-17-wasm-ghci-browser/). +Hot reload is supported via [WASM browser mode](https://www.tweag.io/blog/2025-04-17-wasm-ghci-browser/) and [ghciwatch](https://github.com/MercuryTechnologies/ghciwatch). This provides incremental recompilation with automatic browser refresh on file changes. See the [miso-sampler browser mode documentation](https://github.com/haskell-miso/miso-sampler/blob/main/README.md#browser-mode-) for setup instructions. + ## Installation -See [Installation](docs/Install.md) for more information. +See [Installation](docs/Install.md) for platform-specific installation instructions. ## Haddocks -Offical [Haskell](https://haskell.org) documentation of the [Miso](https://haskell-miso.org) web framework. +Official API reference. See also the [Miso](https://haddocks.haskell-miso.org/miso/Miso.html) module for a guided entry point into the library. | Platform | URL | |------|-------------| @@ -240,78 +243,80 @@ ## Wiki -See the [DeepWiki](https://deepwiki.com/dmjio/miso) entry to explore the source code. +See the [DeepWiki](https://deepwiki.com/dmjio/miso) entry for an AI-assisted exploration of the source code. [![Ask DeepWiki](https://deepwiki.com/badge.svg)](https://deepwiki.com/dmjio/miso) ## Architecture -For constructing client and server applications, we recommend using one `cabal` file with two executable sections, where the `buildable` attribute set is contingent on the compiler. An example of this layout is [here](https://github.com/haskell-miso/haskell-miso.org/blob/master/haskell-miso.cabal). +**miso** follows the [Model-View-Update](https://guide.elm-lang.org/architecture/) (MVU) pattern. A `Component` is parameterized by a `model` type and an `action` type. The `update` function maps actions to `Effect` values β€” a monad over the Reader/Writer/State stack β€” which can both modify the model and schedule `IO` operations. Long-running effects are expressed as `Sub`scriptions that push actions into the component via a `Sink`. +For (client/server) applications, the recommended layout is a single `.cabal` file with separate executable stanzas conditioned on the compiler target. An example of this structure is the [haskell-miso.org source](https://github.com/haskell-miso/haskell-miso.org/blob/master/haskell-miso.cabal). + > [!TIP] -> For more information on how to use `nix` with a `client`/`server` setup, see the [nix scripts](https://github.com/haskell-miso/haskell-miso.org/blob/master/default.nix) for [https://haskell-miso.org](https://haskell-miso.org). +> For a worked example of a Nix-based client/server deployment, see the [nix scripts](https://github.com/haskell-miso/haskell-miso.org/blob/master/default.nix) for [haskell-miso.org](https://haskell-miso.org). ## Examples -For real-world examples of Haskell `miso` applications, see below. - -| Name | Description | Source Link | Live Demo Link | Author | -|-----------------------|-------------------------------------------|---------------------------------------------------------------|-----------------------------------------------------------|---------------------------------------------------| -| **TodoMVC** | A classic TodoMVC implementation | [Source](https://github.com/haskell-miso/miso-todomvc) | [Demo](https://todomvc.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | -| **2048** | A clone of the 2048 game | [Source](https://github.com/haskell-miso/miso-2048) | [Demo](https://2048.haskell-miso.org/) | [@ptigwe](https://github.com/ptigwe) | -| **Flatris** | A Tetris-like game | [Source](https://github.com/haskell-miso/miso-flatris) | [Demo](https://flatris.haskell-miso.org/) | [@ptigwe](https://github.com/ptigwe) | -| **Plane** | A flappy-birds-like game | [Source](https://github.com/haskell-miso/miso-plane) | [Demo](https://plane.haskell-miso.org/) | [@Lermex](https://github.com/Lermex) | -| **Snake** | The classic Snake game | [Source](https://github.com/haskell-miso/miso-snake) | [Demo](https://snake.haskell-miso.org/) | [@lbonn](https://github.com/lbonn) | -| **SVG** | An example showcasing SVG rendering | [Source](https://github.com/haskell-miso/miso-svg) | [Demo](https://svg.haskell-miso.org/) | [@dmjio](https://github.com/dmjio) | -| **Fetch** | An example demonstrating AJAX requests | [Source](https://github.com/haskell-miso/miso-fetch) | [Demo](https://fetch.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | -| **File Reader** | A FileReader API example | [Source](https://github.com/haskell-miso/miso-filereader) | [Demo](https://file-reader.haskell-miso.org/) | [@dmjio](https://github.com/dmjio) | -| **Mario** | A Super Mario physics example | [Source](https://github.com/haskell-miso/miso-mario) | [Demo](https://mario.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | -| **WebSocket** | A simple WebSocket example | [Source](https://github.com/haskell-miso/miso-websocket) | [Demo](https://websocket.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | -| **Router** | A client-side routing example | [Source](https://github.com/haskell-miso/miso-router) | [Demo](https://router.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | -| **Canvas 2D** | A 2D Canvas rendering example | [Source](https://github.com/haskell-miso/miso-canvas2d) | [Demo](https://canvas.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | -| **MathML** | A MathML example | [Source](https://github.com/haskell-miso/miso-mathml) | [Demo](https://mathml.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | -| **Simple** | A simple counter example | [Source](https://github.com/haskell-miso/miso-sampler) | [Demo](https://counter.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | -| **SSE** | SSE (Server-sent events) Example | [Source](https://github.com/haskell-miso/miso-sse) | [Demo](https://sse.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | -| **Three.js** | A 3D rendering example using Three.JS | [Source](https://github.com/haskell-miso/three-miso) | [Demo](https://threejs.haskell-miso.org/) | [@juliendehos](https://github.com/juliendehos) | -| **Space Invaders** | A Space-Invaders-like game | [Source](https://github.com/haskell-miso/miso-invaders) | [Demo](https://space-invaders.haskell-miso.org/) | [@juliendehos](https://github.com/juliendehos) | -| **Audio** | Audio examples | [Source](https://github.com/haskell-miso/miso-audio) | [Demo](https://audio.haskell-miso.org/) | [@juliendehos](https://github.com/juliendehos) | -| **Video** | Video examples | [Source](https://github.com/haskell-miso/miso-video) | [Demo](https://video.haskell-miso.org/) | [@juliendehos](https://github.com/juliendehos) | -| **WebVR** | WebVR examples | [Source](https://github.com/haskell-miso/miso-aframe) | [Demo](https://aframe.haskell-miso.org/) | [@dmjio](https://github.com/dmjio) | -| **Reactivity** | Reactive examples | [Source](https://github.com/haskell-miso/miso-reactive) | [Demo](https://reactive.haskell-miso.org/) | [@dmjio](https://github.com/dmjio) | - - -## Building examples - -The easiest way to build the examples is with the [`nix`](https://nixos.org/nix/) package manager. +Examples are hosted under the [haskell-miso](https://github.com/haskell-miso) GitHub organization. Each repository contains its own build instructions. The recommended approach is to build via [`nix`](https://nixos.org/nix/). > [!TIP] -> Use [cachix](https://cachix.org) to ensure you're not building dependencies unnecessarily `cachix use haskell-miso-cachix` +> Use [cachix](https://cachix.org) to avoid rebuilding shared dependencies: `cachix use haskell-miso-cachix` -See the [@HaskellMiso](https://github.com/haskell-miso) organization for all examples, and how to build then. +| Name | Description | Source | Demo | Author | +|-----------------------|-------------------------------------------|---------------------------------------------------------------|-----------------------------------------------------------|---------------------------------------------------| +| **TodoMVC** | TodoMVC reference implementation | [Source](https://github.com/haskell-miso/miso-todomvc) | [Demo](https://todomvc.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | +| **2048** | Clone of the 2048 sliding-tile game | [Source](https://github.com/haskell-miso/miso-2048) | [Demo](https://2048.haskell-miso.org/) | [@ptigwe](https://github.com/ptigwe) | +| **Flatris** | Tetris variant | [Source](https://github.com/haskell-miso/miso-flatris) | [Demo](https://flatris.haskell-miso.org/) | [@ptigwe](https://github.com/ptigwe) | +| **Plane** | Flappy-bird-style game | [Source](https://github.com/haskell-miso/miso-plane) | [Demo](https://plane.haskell-miso.org/) | [@Lermex](https://github.com/Lermex) | +| **Snake** | Classic Snake game | [Source](https://github.com/haskell-miso/miso-snake) | [Demo](https://snake.haskell-miso.org/) | [@lbonn](https://github.com/lbonn) | +| **SVG** | SVG rendering | [Source](https://github.com/haskell-miso/miso-svg) | [Demo](https://svg.haskell-miso.org/) | [@dmjio](https://github.com/dmjio) | +| **Fetch** | HTTP API interaction via Fetch | [Source](https://github.com/haskell-miso/miso-fetch) | [Demo](https://fetch.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | +| **File Reader** | FileReader API | [Source](https://github.com/haskell-miso/miso-filereader) | [Demo](https://file-reader.haskell-miso.org/) | [@dmjio](https://github.com/dmjio) | +| **Mario** | Physics-based platformer | [Source](https://github.com/haskell-miso/miso-mario) | [Demo](https://mario.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | +| **WebSocket** | WebSocket communication | [Source](https://github.com/haskell-miso/miso-websocket) | [Demo](https://websocket.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | +| **Router** | Client-side routing | [Source](https://github.com/haskell-miso/miso-router) | [Demo](https://router.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | +| **Canvas 2D** | 2D Canvas rendering | [Source](https://github.com/haskell-miso/miso-canvas2d) | [Demo](https://canvas.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | +| **MathML** | MathML rendering | [Source](https://github.com/haskell-miso/miso-mathml) | [Demo](https://mathml.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | +| **Simple** | Counter (minimal example) | [Source](https://github.com/haskell-miso/miso-sampler) | [Demo](https://counter.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | +| **SSE** | Server-Sent Events | [Source](https://github.com/haskell-miso/miso-sse) | [Demo](https://sse.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | +| **Three.js** | 3D rendering via Three.js | [Source](https://github.com/haskell-miso/three-miso) | [Demo](https://threejs.haskell-miso.org/) | [@juliendehos](https://github.com/juliendehos) | +| **Space Invaders** | Space Invaders clone | [Source](https://github.com/haskell-miso/miso-invaders) | [Demo](https://space-invaders.haskell-miso.org/) | [@juliendehos](https://github.com/juliendehos) | +| **Audio** | Audio playback | [Source](https://github.com/haskell-miso/miso-audio) | [Demo](https://audio.haskell-miso.org/) | [@juliendehos](https://github.com/juliendehos) | +| **Video** | Video playback | [Source](https://github.com/haskell-miso/miso-video) | [Demo](https://video.haskell-miso.org/) | [@juliendehos](https://github.com/juliendehos) | +| **WebVR** | WebVR via A-Frame | [Source](https://github.com/haskell-miso/miso-aframe) | [Demo](https://aframe.haskell-miso.org/) | [@dmjio](https://github.com/dmjio) | +| **Reactivity** | Fine-grained reactive updates | [Source](https://github.com/haskell-miso/miso-reactive) | [Demo](https://reactive.haskell-miso.org/) | [@dmjio](https://github.com/dmjio) | +| **Chess** | Chess game | [Source](https://github.com/haskell-miso/chess) | [Demo](https://chess.haskell-miso.org) | [@dmjio](https://github.com/dmjio) | ## Interacting with HTTP APIs πŸ”Œ -If you want to interact with an HTTP API, we recommend one of the following approaches: +Two approaches are supported: - 1. For a simple JSON-based API, you can use Miso's [Fetch](https://haddocks.haskell-miso.org/miso/Miso-Fetch.html) module. + 1. For simple JSON-based APIs, use the [Fetch](https://haddocks.haskell-miso.org/miso/Miso-Fetch.html) module directly. - 2. In more complex cases, you can define a [Servant](https://www.servant.dev/) API and automatically obtain client functions via [servant-miso-client](https://github.com/haskell-miso/servant-miso-client). + 2. For more complex cases, define a [Servant](https://www.servant.dev/) API and derive client functions via [servant-miso-client](https://github.com/haskell-miso/servant-miso-client). - The Fetch example ([Source](https://github.com/haskell-miso/miso-fetch), [Demo](https://fetch.haskell-miso.org/)) demonstrates the necessary ingredients. Make sure to add the following to your `cabal.project`: + The [Fetch example](https://github.com/haskell-miso/miso-fetch) ([Demo](https://fetch.haskell-miso.org/)) demonstrates the required setup. Add the following to `cabal.project` to use `servant-miso-client`: - ```cabal + ``` source-repository-package type: git location: https://github.com/haskell-miso/servant-miso-client tag: master ``` -## Coverage βœ… +## Testing βœ… -The core engine of `miso` is the [diff](https://github.com/dmjio/miso/blob/master/ts/miso/dom.ts) function. It is responsible for all DOM manipulation that occurs in a miso application and has [100% code coverage](http://coverage.haskell-miso.org). Tests and coverage made possible using [bun](https://github.com/oven-sh/bun). +The test suite spans three layers: +- **Unit tests** β€” the TypeScript runtime (virtual DOM, diffing, event delegation) is tested with [bun](https://github.com/oven-sh/bun), covering the core `diff` engine and supporting utilities. +- **Integration tests** β€” Haskell internals are exercised via a WASM test suite that runs the runtime in a headless browser environment, verifying component lifecycle, subscriptions, and state transitions. +- **End-to-end tests** β€” selected applications such as [TodoMVC](https://github.com/haskell-miso/miso-todomvc) are tested end-to-end against a live browser to validate full-stack rendering and event handling. + +A full coverage report for the TypeScript layer is available at [coverage.haskell-miso.org](http://coverage.haskell-miso.org). + > [!NOTE] -> To run the tests and build the coverage report ensure [bun](https://github.com/oven-sh/bun) is installed. +> To run the TypeScript tests, install [bun](https://github.com/oven-sh/bun) first. ```bash $ curl -fsSL https://bun.sh/install | bash @@ -328,64 +333,34 @@ $ bun install && bun run test ``` -```bash ---------------------------|---------|---------|------------------- -File | % Funcs | % Lines | Uncovered Line #s ---------------------------|---------|---------|------------------- -All files | 93.50 | 92.28 | - ts/happydom.ts | 100.00 | 100.00 | - ts/miso/context/dom.ts | 100.00 | 100.00 | - ts/miso/context/patch.ts | 75.00 | 81.17 | 68-76,79-84,87-93,99-107,193-202 - ts/miso/dom.ts | 100.00 | 98.86 | 41,302-303 - ts/miso/event.ts | 100.00 | 92.75 | 28-30,52,81,85-90,116,161 - ts/miso/hydrate.ts | 100.00 | 98.15 | 11-12 - ts/miso/patch.ts | 100.00 | 80.00 | 26-32,36,38,42-43,85-86,91,93 - ts/miso/smart.ts | 85.00 | 93.33 | 45-48 - ts/miso/types.ts | 100.00 | 100.00 | - ts/miso/util.ts | 75.00 | 78.53 | 79,83,122,137,169,172,175-186,197-202,223-229,233-236,249-254 ---------------------------|---------|---------|------------------- - - 223 pass - 0 fail - 7598 expect() calls -Ran 223 tests across 9 files. [497.00ms] -``` +## Native πŸ“± -## NativeπŸ“± -Miso supports the creation of iOS and Android applications via [LynxJS](https://lynxjs.org). See the [miso-lynx](https://github.com/haskell-miso/miso-lynx) repository for more information. +iOS and Android applications are supported via [LynxJS](https://lynxjs.org). See the [miso-lynx](https://github.com/haskell-miso/miso-lynx) repository for details. ## Benchmarks 🏎️ -[According to benchmarks](https://krausest.github.io/js-framework-benchmark/current.html) `miso` is competitive. `miso.js` depicted below is how `miso` performs with its JS engine relative to vanilla JS. The `miso` column shows performance using the [GHC](https://www.haskell.org/ghc/) JS backend. We're currently researching [staged meta-programming](https://dl.acm.org/doi/abs/10.1145/3498723) as a way to remove excess allocations in our DSL and to increase performance when compiling from Haskell. - -image +[According to benchmarks](https://krausest.github.io/js-framework-benchmark/current.html), `miso` performs competitively relative to other frameworks. ## Nix nixos-snowflake -`Nix` is a powerful option for building web applications with `miso` since it encompasses development workflow, configuration management, and deployment. The source code for [`haskell-miso.org`](https://github.com/dmjio/miso/tree/master/haskell-miso.org) is an example of this. - -> [!TIP] -> If unfamiliar with `nix`, we recommend [@Gabriella439](https://github.com/Gabriella439)'s ["Nix and Haskell in production"](https://github.com/Gabriella439/haskell-nix) guide. +`Nix` provides a reproducible environment for building, configuring, and deploying applications. The [haskell-miso.org](https://github.com/dmjio/miso/tree/master/haskell-miso.org) source serves as a reference for this workflow. ### Pinning nixpkgs πŸ“Œ -By default `miso` uses a known-to-work, pinned version of [`nixpkgs`](https://github.com/dmjio/miso/blob/master/nix/nixpkgs.json) known as `pkgs`. +By default, `miso` uses a pinned version of [`nixpkgs`](https://github.com/dmjio/miso/blob/master/nix/nixpkgs.json) known as `pkgs`. > [!NOTE] -> `miso` also maintains a legacy version of nixpkgs known as `legacyPkgs` so we can use tools like `nixops` for deployment and to build `miso` with the original `GHCJS 8.6` backend. +> `miso` also maintains a `legacyPkgs` nixpkgs pin for tools such as `nixops` and for builds using the original `GHCJS 8.6` backend. ### Binary cache -`nix` users on a Linux or OSX distros can take advantage of a [binary cache](https://haskell-miso-cachix.cachix.org) for faster builds. To use the binary cache follow the instructions on [cachix](https://haskell-miso-cachix.cachix.org/). - -> [!TIP] -> We highly recommend nix users consume the [cachix](https://cachix.org) cache. `cachix use haskell-miso-cachix`. +Linux and macOS users can use a [binary cache](https://haskell-miso-cachix.cachix.org) to avoid rebuilding dependencies. Follow the setup instructions on [cachix](https://haskell-miso-cachix.cachix.org/). ```bash $ cachix use haskell-miso-cachix ``` -When building `miso` projects w/ GitHub workflow CI, we recommend the Cachix GitHub action +For CI pipelines using GitHub Actions: ```yaml - name: Install cachix @@ -399,8 +374,6 @@ - [Github](https://github.com/haskell-miso) - [Matrix](https://matrix.to/#/#haskell-miso:matrix.org) - [Discord](https://discord.gg/QVDtfYNSxq) -- [Slack](https://haskell-miso.slack.com/join/shared_invite_confirmed/zt-37vusrcdw-HH6~hY0DGT7MLCjNWZvLDQ#/email-invite/credentials) -- [IRC](https://www.irccloud.com/invite?channel=%23haskell-miso&hostname=irc.libera.chat&port=6697&ssl=1) ## Maintainers @@ -408,47 +381,47 @@ ## Commercial πŸš€ -Since it's launch, `miso` has been used in a variety of industries, including but not limited to: - - - Quantitative finance - - Network security - - Defense research - - Academia - - SaaS companies - - Public sector - - Non-profit sector - - etc. - -The largest `miso` installation known was ~200,000 lines of `miso` code with 10,000+ users. +Since its launch, `miso` has been deployed across a range of domains, including quantitative finance, network security, defense research, academia, SaaS, the public sector, and non-profit organizations. The largest known deployment consisted of approximately 200,000 LOC serving over 10,000 users. ## Contributing -Feel free to dive in! [Open an issue](https://github.com/dmjio/miso/issues/new) or a submit [Pull Request](https://github.com/dmjio/miso/pulls). +Contributions are welcome. [Open an issue](https://github.com/dmjio/miso/issues/new) or submit a [pull request](https://github.com/dmjio/miso/pulls). -See [CONTRIBUTING](https://github.com/dmjio/miso/blob/master/CONTRIBUTING.md) for more info. +See [CONTRIBUTING](https://github.com/dmjio/miso/blob/master/CONTRIBUTING.md) for guidelines. ## Contributors 🦾 > [!NOTE] -> This project exists thanks to all the people who [contribute](CONTRIBUTING.md) +> This project exists thanks to all the people who [contribute](CONTRIBUTING.md). ## Partnerships 🀝 -If you'd like to support this project financially, be it through requesting feature development, or a corporate partnership, please drop us a line and we will be in touch shortly.

support@haskell-miso.org

+For inquiries regarding feature sponsorship or corporate partnerships, contact support@haskell-miso.org. ## Backers -Become a [financial contributor](https://opencollective.com/miso/contribute) and help us sustain our project and community. We are very grateful and thankful for our individual sponsors. +Become a [financial contributor](https://opencollective.com/miso/contribute) to help sustain the project. -## Organizations +## organizations -[Support this project](https://opencollective.com/miso/contribute) with your organization. Your logo will show up here with a link to your website. We are also very grateful and thankful for our corporate sponsors. +[Support this project](https://opencollective.com/miso/contribute) with your organization. Your logo will appear here with a link to your website. + +## History πŸ“œ + +> **miso** is a portmanteau of ***micro*** and ***isomorphic***. + +[miso](https://haskell-miso.org) was initiated in 2016 as a research project exploring two directions: + +- Expressing the [Elm architecture](https://elm-lang.org) in [GHCJS](https://github.com/ghcjs/ghcjs) as an [embedded domain-specific language](https://wiki.haskell.org/Embedded_domain_specific_language) +- Implementing reconciliation and isomorphic rendering techniques from the JavaScript ecosystem ([Reconciliation](https://legacy.reactjs.org/docs/reconciliation.html#the-diffing-algorithm), [isomorphic JavaScript](https://en.wikipedia.org/wiki/Isomorphic_JavaScript)) within a purely functional setting + +The project addresses the [JavaScript problem](https://wiki.haskell.org/The_JavaScript_Problem) in Haskell by providing component abstractions and rendering primitives familiar to practitioners of frameworks such as [React](https://reactjs.org) and [Vue.js](https://vuejs.org). The library has since expanded to include multiple rendering backends and native mobile support for [iOS](https://www.apple.com/ios/), [Android](https://www.android.com/), and [HarmonyOS](https://device.harmonyos.com/en/) via [LynxJS](https://lynxjs.org). ## License diff --git a/ffi/js/Miso/DSL/FFI.hs b/ffi/js/Miso/DSL/FFI.hs --- a/ffi/js/Miso/DSL/FFI.hs +++ b/ffi/js/Miso/DSL/FFI.hs @@ -1,7 +1,6 @@ ----------------------------------------------------------------------------- {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- diff --git a/js/miso.js b/js/miso.js --- a/js/miso.js +++ b/js/miso.js @@ -767,10 +767,12 @@ // ts/miso/event.ts function delegator(mount, events, getVTree, debug, context) { + const controller = "AbortController" in globalThis ? new AbortController : { signal: null, abort: null }; + mount["abort"] = controller.abort?.bind(controller); for (const event of events) { context.addEventListener(mount, event.name, function(e) { listener(e, mount, getVTree, debug, context); - }, event.capture); + }, event.capture, controller.signal); } } function listener(e, mount, getVTree, debug, context) { @@ -981,8 +983,12 @@ // ts/miso/context/dom.ts var eventContext = { - addEventListener: (mount, event, listener2, capture) => { - mount.addEventListener(event, listener2, capture); + addEventListener: (mount, event, listener2, capture, signal) => { + const options = { capture }; + if (signal) { + options["signal"] = signal; + } + mount.addEventListener(event, listener2, options); }, delegator: (mount, events, getVTree, debug, ctx) => { delegator(mount, events, getVTree, debug, ctx); diff --git a/js/miso.prod.js b/js/miso.prod.js --- a/js/miso.prod.js +++ b/js/miso.prod.js @@ -1,1 +1,1 @@ -var m="1.9.0.0";function y(U,z){var G=function(){var H=document.getElementById(U);if(H&&H.focus)H.focus()};z>0?setTimeout(G,z):G()}function h(U,z){var G=function(){var H=document.getElementById(U);if(H&&H.blur)H.blur()};z>0?setTimeout(G,z):G()}function u(U,z){var G=function(){var H=document.getElementById(U);if(H&&typeof H.select==="function")H.select()};z>0?setTimeout(G,z):G()}function g(U,z,G,H){var K=function(){var Q=document.getElementById(U);if(Q&&typeof Q.setSelectionRange==="function")Q.setSelectionRange(z,G,"none")};H>0?setTimeout(K,H):K()}function v(U,z,G,H,K,Q,X){var Y={method:z,headers:H};if(G)Y.body=G;let $={},_=null;try{fetch(U,Y).then((Z)=>{_=Z.status;for(let[B,S]of Z.headers)$[B]=S;if(!Z.ok)throw new Error(Z.statusText);if(X=="json")return Z.json();else if(X=="text")return Z.text();else if(X==="arrayBuffer")return Z.arrayBuffer();else if(X==="blob")return Z.blob();else if(X==="bytes")return Z.bytes();else if(X==="formData")return Z.formData();else if(X==="none")return K({error:null,body:null,headers:$,status:_})}).then((Z)=>K({error:null,body:Z,headers:$,status:_})).catch((Z)=>Q({error:null,body:Z,headers:$,status:_}))}catch(Z){Q({body:null,error:Z.message,headers:$,status:_})}}function l(U,z,G,H,K,Q,X,Y,$){try{let _=new WebSocket(U);return _.onopen=function(){z()},_.onclose=function(Z){G(Z)},_.onerror=function(Z){console.error(Z),Y("WebSocket error received")},_.onmessage=function(Z){if(typeof Z.data==="string")try{if($){if(H)H(Z.data);return}let B=JSON.parse(Z.data);if(K)K(B)}catch(B){if($&&H)H(Z.data);else Y(B.message)}else if(Z.data instanceof Blob){if(Q)Q(Z.data)}else if(Z.data instanceof ArrayBuffer){if(X)X(Z.data)}else console.error("Received unknown message type from WebSocket",Z),Y("Unknown message received from WebSocket")},_}catch(_){Y(_.message)}}function x(U){if(U)U.close(),U=null}function i(U,z){if(z&&U&&U.readyState===WebSocket.OPEN)U.send(z)}function d(U,z,G,H,K,Q){try{let X=new EventSource(U);return X.onopen=function(){z()},X.onerror=function(){K("EventSource error received")},X.onmessage=function(Y){try{if(Q){if(G)G(Y.data);return}let $=JSON.parse(Y.data);if(H)H($)}catch($){if(Q&&G)G(Y.data);else K($.message)}},X}catch(X){K(X.message)}}function p(U){if(U)U.close(),U=null}function a(U,z){if(!U.classList)U.classList=new Set;for(let G of z)for(let H of G.trim().split(" "))if(H)U.classList.add(H)}function s(U,z){if(!U.parent)return;z.nextSibling=U.nextSibling,z.parent=U.parent,U.parent.child=z}function r(U,z={}){let G=Object.keys(z),H=Object.values(z);return new Function(...G,U)(...H)}function c(U){if(U===null||U===void 0)return 0;if(typeof U==="number")return 1;if(typeof U==="string")return 2;if(typeof U==="boolean")return 3;if(Array.isArray(U))return 4;return 5}function o(U){return function(){U|=0,U=U+2654435769|0;var z=U^U>>>15;return z=Math.imul(z,2246822507),z=z^z>>>13,z=Math.imul(z,3266489909),((z^z>>>16)>>>0)/4294967296}}function n(){let U=new Uint32Array(1);return crypto.getRandomValues(U)[0]}function t(){return Math.random()}function W(U,z){switch(U.type){case 3:for(let G of U.children)W(G,z);break;case 0:if(U.child)W(U.child,z);break;default:z(U.domRef);break}}function q(U){switch(U.type){case 3:{if(!U.children||U.children.length===0)return null;return q(U.children[0])}case 0:if(!U.child)return null;return q(U.child);default:return U.domRef}}function N(U){switch(U.type){case 3:{if(!U.children||U.children.length===0)return null;return N(U.children[U.children.length-1])}case 0:if(!U.child)return null;return N(U.child);default:return U.domRef}}function A(U,z,G,H){if(!U&&!z)return;else if(!U)D(z,G,H);else if(!z)O(U,G,H);else if(U.type===2&&z.type===2)JU(U,z,H);else if(U.type===0&&z.type===0){if(z.key===U.key){if(z.child=U.child,z.componentId=U.componentId,U.child)U.child.parent=z;if(z.diffProps)z.diffProps();return}V(U,z,G,H)}else if(U.type===3&&z.type===3)if(z.key===U.key){let K=N(U),Q=K?K.nextSibling:H.nextSibling(U);XU(U.children,z.children,G,H,Q)}else V(U,z,G,H);else if(U.type===1&&z.type===1)if(z.tag===U.tag&&z.key===U.key)z.domRef=U.domRef,QU(U,z,H);else V(U,z,G,H);else V(U,z,G,H)}function JU(U,z,G){if(U.text!==z.text)G.setTextContent(U.domRef,z.text);z.domRef=U.domRef;return}function V(U,z,G,H){if(U.type===3){let X=N(U),Y=X?X.nextSibling:H.nextSibling(U);if(O(U,G,H),Y)C(G,2,Y,z,H);else D(z,G,H);return}switch(U.type){case 2:break;default:P(U);break}let K=q(U),Q=N(U);if(!K||!Q){let X=H.nextSibling(U);if(X)C(G,2,X,z,H);else D(z,G,H)}else if(K!==Q){let X=Q.nextSibling;if(W(U,(Y)=>H.removeChild(G,Y)),X)C(G,2,X,z,H);else D(z,G,H)}else C(G,1,K,z,H);switch(U.type){case 2:break;default:R(U);break}}function O(U,z,G){switch(U.type){case 2:break;case 3:for(let H of U.children)O(H,z,G);return;default:P(U);break}switch(W(U,(H)=>G.removeChild(z,H)),U.type){case 2:break;default:R(U);break}}function R(U){if(U.type===3){for(let z of U.children)if(z.type!==2)R(z);return}switch(AU(U),U.type){case 1:for(let z of U.children)if(z.type!==2)R(z);break;case 0:if(U.child&&U.child.type!==2)R(U.child);break}}function AU(U){if(U.type===1&&U.onDestroyed)U.onDestroyed();if(U.type===0)wU(U)}function BU(U){switch(U.type){case 0:break;case 1:if(U.onBeforeDestroyed)U.onBeforeDestroyed();break;default:break}}function P(U){if(U.type===3){for(let z of U.children)if(z.type!==2)P(z);return}switch(BU(U),U.type){case 1:for(let z of U.children){if(z.type===2)continue;P(z)}break;case 0:if(U.child&&U.child.type!==2)P(U.child);break}}function QU(U,z,G){NU(U?U.props:{},z.props,z.domRef,z.ns==="svg",G),SU(U?U.classList:null,z.classList,z.domRef,G),CU(U?U.css:{},z.css,z.domRef,G),XU(U?U.children:[],z.children,z.domRef,G),IU(z)}function SU(U,z,G,H){if(!U&&!z)return;if(!U){for(let K of z)H.addClass(K,G);return}if(!z){for(let K of U)H.removeClass(K,G);return}for(let K of U)if(!z.has(K))H.removeClass(K,G);for(let K of z)if(!U.has(K))H.addClass(K,G);return}function NU(U,z,G,H,K){var Q;for(let X in U)if(Q=z[X],Q===void 0)if(H||!(X in G)||X==="disabled")K.removeAttribute(G,X);else K.setAttribute(G,X,"");else{if(Q===U[X]&&X!=="checked"&&X!=="value")continue;if(H)if(X==="href")K.setAttributeNS(G,"http://www.w3.org/1999/xlink","href",Q);else K.setAttribute(G,X,Q);else if(X in G&&!(X==="list"||X==="form"))G[X]=Q;else K.setAttribute(G,X,Q)}for(let X in z){if(U&&X in U)continue;if(Q=z[X],H)if(X==="href")K.setAttributeNS(G,"http://www.w3.org/1999/xlink","href",Q);else K.setAttribute(G,X,Q);else if(X in G&&!(X==="list"||X==="form"))G[X]=z[X];else K.setAttribute(G,X,Q)}}function CU(U,z,G,H){H.setInlineStyle(U,z,G)}function EU(U,z){if(U.length===0||z.length===0)return!1;for(var G=0;GK.insertBefore(U,Y,G)),K.removeChild(U,G);else K.replaceChild(U,X,G);else if(z===2)if(G)W(Q.componentTree,(Y)=>K.insertBefore(U,Y,G));else W(Q.componentTree,(Y)=>K.appendChild(U,Y))}}function D(U,z,G){C(z,0,null,U,G)}function KU(U,z,G,H){let K=G?q(G)??H.nextSibling(G):null;if(K)W(z,(Q)=>H.insertBefore(U,Q,K));else W(z,(Q)=>H.appendChild(U,Q))}function RU(U,z,G,H){let K=q(U),Q=q(z);if(K&&Q&&(U.type===1||U.type===2)&&(z.type===1||z.type===2)){H.swapDOMRefs(K,Q,G);return}let X=N(U),Y=X?X.nextSibling:H.nextSibling(U),$=q(z)??H.nextSibling(z);if($)W(U,(_)=>H.insertBefore(G,_,$));else W(U,(_)=>H.appendChild(G,_));if(Y)W(z,(_)=>H.insertBefore(G,_,Y));else W(z,(_)=>H.appendChild(G,_))}function PU(U,z,G,H,K=null){var Q=0,X=0,Y=U.length-1,$=z.length-1,_,Z,B,S,J,f,HU;for(;;){if(X>$&&Q>Y)break;if(Z=z[X],B=z[$],J=U[Q],S=U[Y],Q>Y){let M=(J?q(J)??H.nextSibling(J):null)??K;if(M)C(G,2,M,Z,H);else D(Z,G,H);U.splice(X,0,Z),X++}else if(X>$){_=Y;while(Y>=Q)O(U[Y--],G,H);U.splice(Q,_-Q+1);break}else if(J.key===Z.key)A(U[Q++],z[X++],G,H);else if(S.key===B.key)A(U[Y--],z[$--],G,H);else if(J.key===B.key&&Z.key===S.key)RU(S,J,G,H),FU(U,Q,Y),A(U[Q++],z[X++],G,H),A(U[Y--],z[$--],G,H);else if(J.key===B.key){let I=N(S),M=I?I.nextSibling:H.nextSibling(S);if(M)W(J,(T)=>H.insertBefore(G,T,M));else W(J,(T)=>H.appendChild(G,T));U.splice(Y,0,U.splice(Q,1)[0]),A(U[Y--],z[$--],G,H)}else if(S.key===Z.key)KU(G,S,J,H),U.splice(Q,0,U.splice(Y,1)[0]),A(U[Q++],Z,G,H),X++;else{f=!1,_=Q;while(_<=Y){if(U[_].key===Z.key){f=!0,HU=U[_];break}_++}if(f)U.splice(Q,0,U.splice(_,1)[0]),A(U[Q++],Z,G,H),KU(G,HU,U[Q],H),X++;else{let I=q(J)??H.nextSibling(J);if(I)C(G,2,I,Z,H);else D(Z,G,H);U.splice(Q++,0,Z),X++,Y++}}}}function FU(U,z,G){let H=U[z];U[z]=U[G],U[G]=H}function e(U,z,G,H,K){for(let Q of z)K.addEventListener(U,Q.name,function(X){LU(X,U,G,H,K)},Q.capture)}function LU(U,z,G,H,K){G(function(Q){if(Array.isArray(U))for(let X of U)ZU(X,Q,z,H,K);else ZU(U,Q,z,H,K)})}function ZU(U,z,G,H,K){var Q=K.getTarget(U);if(Q){let X=VU(G,Q,K);E(U,z,X,H,K)}}function VU(U,z,G){var H=[];while(!G.isEqual(U,z))if(H.unshift(z),z&&G.parentNode(z))z=G.parentNode(z);else return H;return H}function E(U,z,G,H,K){if(!G.length){if(H)console.warn('Event "'+U.type+'" did not find an event handler to dispatch on',z,U);return}else if(G.length>1){if(z.type===2)return;else if(z.type===3){for(let Q of z.children)if(F(Q,G[0],K)){E(U,Q,G,H,K);return}return}else if(z.type===0){if(!z.child){if(H)throw console.error("VComp has no child property set during event delegation",z),console.error("This means the Component has not been fully mounted, this should never happen"),new Error("VComp has no .child property set during event delegation");return}return E(U,z.child,G,H,K)}else if(z.type===1){if(K.isEqual(z.domRef,G[0])){let Q=z.events.captures[U.type];if(Q){let X=Q.options;if(X.preventDefault)U.preventDefault();if(!U.captureStopped)Q.runEvent(U,z.domRef);if(X.stopPropagation)U.captureStopped=!0}G.splice(0,1);for(let X of z.children)if(F(X,G[0],K)){E(U,X,G,H,K);return}}return}}else if(z.type===0){if(z.child)E(U,z.child,G,H,K)}else if(z.type===3){for(let Q of z.children)if(F(Q,G[0],K)){E(U,Q,G,H,K);return}}else if(z.type===1){let Q=z.events.captures[U.type];if(Q&&!U.captureStopped){let Y=Q.options;if(K.isEqual(G[0],z.domRef)){if(Y.preventDefault)U.preventDefault();if(Q.runEvent(U,G[0]),Y.stopPropagation)U.captureStopped=!0}}let X=z.events.bubbles[U.type];if(X&&!U.captureStopped){let Y=X.options;if(K.isEqual(G[0],z.domRef)){if(Y.preventDefault)U.preventDefault();if(X.runEvent(U,G[0]),!Y.stopPropagation)$U(z.parent,U)}}else if(!U.captureStopped)$U(z.parent,U)}}function $U(U,z){while(U)switch(U.type){case 2:break;case 3:U=U.parent;break;case 1:let G=U.events.bubbles[z.type];if(G){let H=G.options;if(H.preventDefault)z.preventDefault();if(G.runEvent(z,U.domRef),H.stopPropagation)return}U=U.parent;break;case 0:if(!U.eventPropagation)return;U=U.parent;break}}function L(U,z){if(typeof U[0]==="object"){var G=[];for(var H=0;H{U.addEventListener(z,G,H)},delegator:(U,z,G,H,K)=>{e(U,z,G,H,K)},isEqual:(U,z)=>{return U===z},getTarget:(U)=>{return U.target},parentNode:(U)=>{return U.parentNode}},_U={getInlineStyle:(U,z)=>{return U.style[z]},firstChild:(U)=>{return U.firstChild},lastChild:(U)=>{return U.lastChild},getAttribute:(U,z)=>{if(z==="class")return U.className;if(z in U)return U[z];return U.getAttribute(z)},getTag:(U)=>{return U.nodeName},getTextContent:(U)=>{return U.textContent},children:(U)=>{return U.childNodes}},WU={mountComponent:function(U,z){return},unmountComponent:function(U){return},modelHydration:function(U,z){return}},UU={nextSibling:(U)=>{let z=U.nextSibling;while(z)switch(z.type){case 0:case 3:{let G=q(z);if(G)return G;z=z.nextSibling;break}default:return z.domRef}return null},createTextNode:(U)=>{return document.createTextNode(U)},createElementNS:(U,z)=>{return document.createElementNS(U,z)},appendChild:(U,z)=>{return U.appendChild(z)},replaceChild:(U,z,G)=>{return U.replaceChild(z,G)},removeChild:(U,z)=>{return U.removeChild(z)},createElement:(U)=>{return document.createElement(U)},addClass:(U,z)=>{if(U)z.classList.add(U)},removeClass:(U,z)=>{if(U)z.classList.remove(U)},insertBefore:(U,z,G)=>{return U.insertBefore(z,G)},swapDOMRefs:(U,z,G)=>{let H=U.nextSibling;G.insertBefore(U,z),G.insertBefore(z,H);return},setInlineStyle:(U,z,G)=>{var H;for(let K in U)if(H=z[K],!H)if(K in G.style)G.style[K]="";else G.style.setProperty(K,"");else if(H!==U[K])if(K in G.style)G.style[K]=H;else G.style.setProperty(K,H);for(let K in z){if(U&&U[K])continue;if(K in G.style)G.style[K]=z[K];else G.style.setProperty(K,z[K])}return},setAttribute:(U,z,G)=>{return U.setAttribute(z,G)},setAttributeNS:(U,z,G,H)=>{return U.setAttributeNS(z,G,H)},removeAttribute:(U,z)=>{return U.removeAttribute(z)},setTextContent:(U,z)=>{U.textContent=z;return},flush:()=>{return},getHead:function(){return document.head},getRoot:function(){return document.body}};function zU(U){var z=0,G=U.length>0?[U[0]]:[];for(var H=1;H0?setTimeout(G,z):G()}function h(U,z){var G=function(){var H=document.getElementById(U);if(H&&H.blur)H.blur()};z>0?setTimeout(G,z):G()}function u(U,z){var G=function(){var H=document.getElementById(U);if(H&&typeof H.select==="function")H.select()};z>0?setTimeout(G,z):G()}function g(U,z,G,H){var K=function(){var Q=document.getElementById(U);if(Q&&typeof Q.setSelectionRange==="function")Q.setSelectionRange(z,G,"none")};H>0?setTimeout(K,H):K()}function v(U,z,G,H,K,Q,X){var Y={method:z,headers:H};if(G)Y.body=G;let $={},_=null;try{fetch(U,Y).then((Z)=>{_=Z.status;for(let[B,S]of Z.headers)$[B]=S;if(!Z.ok)throw Error(Z.statusText);if(X=="json")return Z.json();else if(X=="text")return Z.text();else if(X==="arrayBuffer")return Z.arrayBuffer();else if(X==="blob")return Z.blob();else if(X==="bytes")return Z.bytes();else if(X==="formData")return Z.formData();else if(X==="none")return K({error:null,body:null,headers:$,status:_})}).then((Z)=>K({error:null,body:Z,headers:$,status:_})).catch((Z)=>Q({error:null,body:Z,headers:$,status:_}))}catch(Z){Q({body:null,error:Z.message,headers:$,status:_})}}function l(U,z,G,H,K,Q,X,Y,$){try{let _=new WebSocket(U);return _.onopen=function(){z()},_.onclose=function(Z){G(Z)},_.onerror=function(Z){console.error(Z),Y("WebSocket error received")},_.onmessage=function(Z){if(typeof Z.data==="string")try{if($){if(H)H(Z.data);return}let B=JSON.parse(Z.data);if(K)K(B)}catch(B){if($&&H)H(Z.data);else Y(B.message)}else if(Z.data instanceof Blob){if(Q)Q(Z.data)}else if(Z.data instanceof ArrayBuffer){if(X)X(Z.data)}else console.error("Received unknown message type from WebSocket",Z),Y("Unknown message received from WebSocket")},_}catch(_){Y(_.message)}}function x(U){if(U)U.close(),U=null}function i(U,z){if(z&&U&&U.readyState===WebSocket.OPEN)U.send(z)}function d(U,z,G,H,K,Q){try{let X=new EventSource(U);return X.onopen=function(){z()},X.onerror=function(){K("EventSource error received")},X.onmessage=function(Y){try{if(Q){if(G)G(Y.data);return}let $=JSON.parse(Y.data);if(H)H($)}catch($){if(Q&&G)G(Y.data);else K($.message)}},X}catch(X){K(X.message)}}function p(U){if(U)U.close(),U=null}function a(U,z){if(!U.classList)U.classList=new Set;for(let G of z)for(let H of G.trim().split(" "))if(H)U.classList.add(H)}function s(U,z){if(!U.parent)return;z.nextSibling=U.nextSibling,z.parent=U.parent,U.parent.child=z}function r(U,z={}){let G=Object.keys(z),H=Object.values(z);return Function(...G,U)(...H)}function c(U){if(U===null||U===void 0)return 0;if(typeof U==="number")return 1;if(typeof U==="string")return 2;if(typeof U==="boolean")return 3;if(Array.isArray(U))return 4;return 5}function o(U){return function(){U|=0,U=U+2654435769|0;var z=U^U>>>15;return z=Math.imul(z,2246822507),z=z^z>>>13,z=Math.imul(z,3266489909),((z^z>>>16)>>>0)/4294967296}}function n(){let U=new Uint32Array(1);return crypto.getRandomValues(U)[0]}function t(){return Math.random()}function W(U,z){switch(U.type){case 3:for(let G of U.children)W(G,z);break;case 0:if(U.child)W(U.child,z);break;default:z(U.domRef);break}}function q(U){switch(U.type){case 3:{if(!U.children||U.children.length===0)return null;return q(U.children[0])}case 0:if(!U.child)return null;return q(U.child);default:return U.domRef}}function N(U){switch(U.type){case 3:{if(!U.children||U.children.length===0)return null;return N(U.children[U.children.length-1])}case 0:if(!U.child)return null;return N(U.child);default:return U.domRef}}function A(U,z,G,H){if(!U&&!z)return;else if(!U)D(z,G,H);else if(!z)O(U,G,H);else if(U.type===2&&z.type===2)JU(U,z,H);else if(U.type===0&&z.type===0){if(z.key===U.key){if(z.child=U.child,z.componentId=U.componentId,U.child)U.child.parent=z;if(z.diffProps)z.diffProps();return}V(U,z,G,H)}else if(U.type===3&&z.type===3)if(z.key===U.key){let K=N(U),Q=K?K.nextSibling:H.nextSibling(U);XU(U.children,z.children,G,H,Q)}else V(U,z,G,H);else if(U.type===1&&z.type===1)if(z.tag===U.tag&&z.key===U.key)z.domRef=U.domRef,QU(U,z,H);else V(U,z,G,H);else V(U,z,G,H)}function JU(U,z,G){if(U.text!==z.text)G.setTextContent(U.domRef,z.text);z.domRef=U.domRef;return}function V(U,z,G,H){if(U.type===3){let X=N(U),Y=X?X.nextSibling:H.nextSibling(U);if(O(U,G,H),Y)C(G,2,Y,z,H);else D(z,G,H);return}switch(U.type){case 2:break;default:P(U);break}let K=q(U),Q=N(U);if(!K||!Q){let X=H.nextSibling(U);if(X)C(G,2,X,z,H);else D(z,G,H)}else if(K!==Q){let X=Q.nextSibling;if(W(U,(Y)=>H.removeChild(G,Y)),X)C(G,2,X,z,H);else D(z,G,H)}else C(G,1,K,z,H);switch(U.type){case 2:break;default:R(U);break}}function O(U,z,G){switch(U.type){case 2:break;case 3:for(let H of U.children)O(H,z,G);return;default:P(U);break}switch(W(U,(H)=>G.removeChild(z,H)),U.type){case 2:break;default:R(U);break}}function R(U){if(U.type===3){for(let z of U.children)if(z.type!==2)R(z);return}switch(AU(U),U.type){case 1:for(let z of U.children)if(z.type!==2)R(z);break;case 0:if(U.child&&U.child.type!==2)R(U.child);break}}function AU(U){if(U.type===1&&U.onDestroyed)U.onDestroyed();if(U.type===0)wU(U)}function BU(U){switch(U.type){case 0:break;case 1:if(U.onBeforeDestroyed)U.onBeforeDestroyed();break;default:break}}function P(U){if(U.type===3){for(let z of U.children)if(z.type!==2)P(z);return}switch(BU(U),U.type){case 1:for(let z of U.children){if(z.type===2)continue;P(z)}break;case 0:if(U.child&&U.child.type!==2)P(U.child);break}}function QU(U,z,G){NU(U?U.props:{},z.props,z.domRef,z.ns==="svg",G),SU(U?U.classList:null,z.classList,z.domRef,G),CU(U?U.css:{},z.css,z.domRef,G),XU(U?U.children:[],z.children,z.domRef,G),IU(z)}function SU(U,z,G,H){if(!U&&!z)return;if(!U){for(let K of z)H.addClass(K,G);return}if(!z){for(let K of U)H.removeClass(K,G);return}for(let K of U)if(!z.has(K))H.removeClass(K,G);for(let K of z)if(!U.has(K))H.addClass(K,G);return}function NU(U,z,G,H,K){var Q;for(let X in U)if(Q=z[X],Q===void 0)if(H||!(X in G)||X==="disabled")K.removeAttribute(G,X);else K.setAttribute(G,X,"");else{if(Q===U[X]&&X!=="checked"&&X!=="value")continue;if(H)if(X==="href")K.setAttributeNS(G,"http://www.w3.org/1999/xlink","href",Q);else K.setAttribute(G,X,Q);else if(X in G&&!(X==="list"||X==="form"))G[X]=Q;else K.setAttribute(G,X,Q)}for(let X in z){if(U&&X in U)continue;if(Q=z[X],H)if(X==="href")K.setAttributeNS(G,"http://www.w3.org/1999/xlink","href",Q);else K.setAttribute(G,X,Q);else if(X in G&&!(X==="list"||X==="form"))G[X]=z[X];else K.setAttribute(G,X,Q)}}function CU(U,z,G,H){H.setInlineStyle(U,z,G)}function EU(U,z){if(U.length===0||z.length===0)return!1;for(var G=0;GK.insertBefore(U,Y,G)),K.removeChild(U,G);else K.replaceChild(U,X,G);else if(z===2)if(G)W(Q.componentTree,(Y)=>K.insertBefore(U,Y,G));else W(Q.componentTree,(Y)=>K.appendChild(U,Y))}}function D(U,z,G){C(z,0,null,U,G)}function KU(U,z,G,H){let K=G?q(G)??H.nextSibling(G):null;if(K)W(z,(Q)=>H.insertBefore(U,Q,K));else W(z,(Q)=>H.appendChild(U,Q))}function RU(U,z,G,H){let K=q(U),Q=q(z);if(K&&Q&&(U.type===1||U.type===2)&&(z.type===1||z.type===2)){H.swapDOMRefs(K,Q,G);return}let X=N(U),Y=X?X.nextSibling:H.nextSibling(U),$=q(z)??H.nextSibling(z);if($)W(U,(_)=>H.insertBefore(G,_,$));else W(U,(_)=>H.appendChild(G,_));if(Y)W(z,(_)=>H.insertBefore(G,_,Y));else W(z,(_)=>H.appendChild(G,_))}function PU(U,z,G,H,K=null){var Q=0,X=0,Y=U.length-1,$=z.length-1,_,Z,B,S,J,f,HU;for(;;){if(X>$&&Q>Y)break;if(Z=z[X],B=z[$],J=U[Q],S=U[Y],Q>Y){let M=(J?q(J)??H.nextSibling(J):null)??K;if(M)C(G,2,M,Z,H);else D(Z,G,H);U.splice(X,0,Z),X++}else if(X>$){_=Y;while(Y>=Q)O(U[Y--],G,H);U.splice(Q,_-Q+1);break}else if(J.key===Z.key)A(U[Q++],z[X++],G,H);else if(S.key===B.key)A(U[Y--],z[$--],G,H);else if(J.key===B.key&&Z.key===S.key)RU(S,J,G,H),FU(U,Q,Y),A(U[Q++],z[X++],G,H),A(U[Y--],z[$--],G,H);else if(J.key===B.key){let I=N(S),M=I?I.nextSibling:H.nextSibling(S);if(M)W(J,(T)=>H.insertBefore(G,T,M));else W(J,(T)=>H.appendChild(G,T));U.splice(Y,0,U.splice(Q,1)[0]),A(U[Y--],z[$--],G,H)}else if(S.key===Z.key)KU(G,S,J,H),U.splice(Q,0,U.splice(Y,1)[0]),A(U[Q++],Z,G,H),X++;else{f=!1,_=Q;while(_<=Y){if(U[_].key===Z.key){f=!0,HU=U[_];break}_++}if(f)U.splice(Q,0,U.splice(_,1)[0]),A(U[Q++],Z,G,H),KU(G,HU,U[Q],H),X++;else{let I=q(J)??H.nextSibling(J);if(I)C(G,2,I,Z,H);else D(Z,G,H);U.splice(Q++,0,Z),X++,Y++}}}}function FU(U,z,G){let H=U[z];U[z]=U[G],U[G]=H}function e(U,z,G,H,K){let Q="AbortController"in globalThis?new AbortController:{signal:null,abort:null};U.abort=Q.abort?.bind(Q);for(let X of z)K.addEventListener(U,X.name,function(Y){LU(Y,U,G,H,K)},X.capture,Q.signal)}function LU(U,z,G,H,K){G(function(Q){if(Array.isArray(U))for(let X of U)ZU(X,Q,z,H,K);else ZU(U,Q,z,H,K)})}function ZU(U,z,G,H,K){var Q=K.getTarget(U);if(Q){let X=VU(G,Q,K);E(U,z,X,H,K)}}function VU(U,z,G){var H=[];while(!G.isEqual(U,z))if(H.unshift(z),z&&G.parentNode(z))z=G.parentNode(z);else return H;return H}function E(U,z,G,H,K){if(!G.length){if(H)console.warn('Event "'+U.type+'" did not find an event handler to dispatch on',z,U);return}else if(G.length>1){if(z.type===2)return;else if(z.type===3){for(let Q of z.children)if(F(Q,G[0],K)){E(U,Q,G,H,K);return}return}else if(z.type===0){if(!z.child){if(H)throw console.error("VComp has no child property set during event delegation",z),console.error("This means the Component has not been fully mounted, this should never happen"),Error("VComp has no .child property set during event delegation");return}return E(U,z.child,G,H,K)}else if(z.type===1){if(K.isEqual(z.domRef,G[0])){let Q=z.events.captures[U.type];if(Q){let X=Q.options;if(X.preventDefault)U.preventDefault();if(!U.captureStopped)Q.runEvent(U,z.domRef);if(X.stopPropagation)U.captureStopped=!0}G.splice(0,1);for(let X of z.children)if(F(X,G[0],K)){E(U,X,G,H,K);return}}return}}else if(z.type===0){if(z.child)E(U,z.child,G,H,K)}else if(z.type===3){for(let Q of z.children)if(F(Q,G[0],K)){E(U,Q,G,H,K);return}}else if(z.type===1){let Q=z.events.captures[U.type];if(Q&&!U.captureStopped){let Y=Q.options;if(K.isEqual(G[0],z.domRef)){if(Y.preventDefault)U.preventDefault();if(Q.runEvent(U,G[0]),Y.stopPropagation)U.captureStopped=!0}}let X=z.events.bubbles[U.type];if(X&&!U.captureStopped){let Y=X.options;if(K.isEqual(G[0],z.domRef)){if(Y.preventDefault)U.preventDefault();if(X.runEvent(U,G[0]),!Y.stopPropagation)$U(z.parent,U)}}else if(!U.captureStopped)$U(z.parent,U)}}function $U(U,z){while(U)switch(U.type){case 2:break;case 3:U=U.parent;break;case 1:let G=U.events.bubbles[z.type];if(G){let H=G.options;if(H.preventDefault)z.preventDefault();if(G.runEvent(z,U.domRef),H.stopPropagation)return}U=U.parent;break;case 0:if(!U.eventPropagation)return;U=U.parent;break}}function L(U,z){if(typeof U[0]==="object"){var G=[];for(var H=0;H{let Q={capture:H};if(K)Q.signal=K;U.addEventListener(z,G,Q)},delegator:(U,z,G,H,K)=>{e(U,z,G,H,K)},isEqual:(U,z)=>{return U===z},getTarget:(U)=>{return U.target},parentNode:(U)=>{return U.parentNode}},_U={getInlineStyle:(U,z)=>{return U.style[z]},firstChild:(U)=>{return U.firstChild},lastChild:(U)=>{return U.lastChild},getAttribute:(U,z)=>{if(z==="class")return U.className;if(z in U)return U[z];return U.getAttribute(z)},getTag:(U)=>{return U.nodeName},getTextContent:(U)=>{return U.textContent},children:(U)=>{return U.childNodes}},WU={mountComponent:function(U,z){return},unmountComponent:function(U){return},modelHydration:function(U,z){return}},UU={nextSibling:(U)=>{let z=U.nextSibling;while(z)switch(z.type){case 0:case 3:{let G=q(z);if(G)return G;z=z.nextSibling;break}default:return z.domRef}return null},createTextNode:(U)=>{return document.createTextNode(U)},createElementNS:(U,z)=>{return document.createElementNS(U,z)},appendChild:(U,z)=>{return U.appendChild(z)},replaceChild:(U,z,G)=>{return U.replaceChild(z,G)},removeChild:(U,z)=>{return U.removeChild(z)},createElement:(U)=>{return document.createElement(U)},addClass:(U,z)=>{if(U)z.classList.add(U)},removeClass:(U,z)=>{if(U)z.classList.remove(U)},insertBefore:(U,z,G)=>{return U.insertBefore(z,G)},swapDOMRefs:(U,z,G)=>{let H=U.nextSibling;G.insertBefore(U,z),G.insertBefore(z,H);return},setInlineStyle:(U,z,G)=>{var H;for(let K in U)if(H=z[K],!H)if(K in G.style)G.style[K]="";else G.style.setProperty(K,"");else if(H!==U[K])if(K in G.style)G.style[K]=H;else G.style.setProperty(K,H);for(let K in z){if(U&&U[K])continue;if(K in G.style)G.style[K]=z[K];else G.style.setProperty(K,z[K])}return},setAttribute:(U,z,G)=>{return U.setAttribute(z,G)},setAttributeNS:(U,z,G,H)=>{return U.setAttributeNS(z,G,H)},removeAttribute:(U,z)=>{return U.removeAttribute(z)},setTextContent:(U,z)=>{U.textContent=z;return},flush:()=>{return},getHead:function(){return document.head},getRoot:function(){return document.body}};function zU(U){var z=0,G=U.length>0?[U[0]]:[];for(var H=1;H --- Stability : experimental --- Portability : non-portable --- --- = miso 🍜 --- --- @miso@ is a library for building web and native user interface applications in Haskell. See the [GitHub group](https://github.com/haskell-miso). --- --- It provides a [React](https://react.dev)-like programming experience for a simple [Haskell](https://haskell.org) dialect that emphasizes --- --- * performance --- * purity --- * simplicity --- * extensibility --- * composability --- --- miso supports common areas that arise naturally in web development: --- --- * __DOM manipulation__: @miso@ uses a [Virtual DOM](https://en.wikipedia.org/wiki/Virtual_DOM) with diffing algorithm that is --- responsible for all DOM modification and 'Component' lifecycle hooks. --- --- * __Event delegation__: All event listeners are attached to a top-level element --- (typically @\@). When raised, events are routed through the virtual DOM --- to Haskell event handlers which cause application state changes. Internally @miso@ --- virtualizes both the @capture@ and @bubble@ phases of the browser when it performs event routing. --- --- * __Prerendering__: Prerendering is a process where the server delivers HTML --- to the client before the JavaScript (or Web Assembly) application bootstraps. --- Instead of performing an initial draw, the application will create and populate the virtual DOM from the actual DOM. --- This is a process known as \"hydration\". This avoids unnecessary page draws on initial page --- load and enhances search engine optimization. @miso@ provides its own HTML rendering --- ("Miso.Html.Render") to render HTML on the server and the 'miso' function exists on the client to \"hydrate\" --- the virtual DOM with the DOM. --- --- * __Components__: A 'Component' can be considered an instance of a @miso@ application. A 'Component' --- contains user-defined state, logic for updating this state, and a function --- for creating UI templates from this user-defined state. 'Component' can nest other 'Component' because @miso@ --- is defined recursively. --- --- * __Custom renderers__: The underlying DOM operations are able to be abstracted. --- This allows a custom rendering engine to be used. This is seen in the [miso-lynx](https://github.com/haskell-miso/miso-lynx) project --- (which allows miso to target mobile phone devices). --- --- * __Lifecycle hooks__: 'Component' expose 'Miso.Types.mount' and 'Miso.Types.unmount' lifecycle hooks. This allow users to define custom logic that will --- execute when a 'Component' mounts or unmounts. 'Miso.Event.onCreated' and 'Miso.Event.onDestroyed' are 'VNode' specific lifecycle hooks. --- These hooks are commonly used for 'Component' communication and for third-party integration with JavaScript libraries. --- --- * __State management__: 'Component' @model@ state can be manipulated using "Miso.Lens" or "Miso.State" in response to application events. --- --- = The Model-View-Update pattern --- --- The core type of miso is 'Component'. The 'Component' API adheres to the [Elm](https://elm-lang.org) --- MVU (model-view-update) interface. This is similar to a left-fold, where the 'Component' @model@ --- will be updated via a list of @action@ given a specific 'Miso.Types.update' function, and rendered via 'Miso.Types.view'. --- --- * __model__: This can be any user-defined type in Haskell. An 'Eq' constraint --- is required. We recommend using the default derived 'Eq' instance. --- --- * __view__: @'view' :: model -> 'View' model action@ --- This is the templating function that is used to construct a new virtual DOM --- (or HTML if rendering on the server). --- --- * __update__: @'update' :: action -> 'Effect' parent props model action@ --- The 'update' function handles how the 'model' evolves over time in response --- to events that are raised by the application. This function takes any @action@, --- updating the @model@ and optionally introduces 'IO' into the system. --- --- = t'View' DSL --- --- The 'View' type is the core type for both templating and adding interactivity to a web page. It is similar to --- a [Rose tree](https://en.wikipedia.org/wiki/Rose_tree) data structure. This is how the Virtual DOM is constructed. It is --- mutually recursive with the 'Component' type (via the 'view' function), which allows us to embed --- 'Component' inside other 'Component'. --- --- @ --- data 'View' model action --- = 'VNode' 'Namespace' 'Tag' ['Attribute' action] ['View' model action] --- | 'VText' (Maybe 'Key') 'MisoString' --- | 'VComp' (Maybe 'Key') ('SomeComponent' model) --- | 'VFrag' (Maybe 'Key') ['View' model action] --- @ --- --- 'VNode' and 'VText' have a one-to-one mapping from the virtual DOM to the physical DOM. The 'VComp' and 'VFrag' constructors are abstract (live only on the virtual DOM) and do not contain a reference to the physical DOM. The existential type of 'SomeComponent' is defined recursively in terms of 'View' and is what allows us to embed other polymorphic 'Component'. --- --- @ --- data 'SomeComponent' parent --- = forall model action props . (Eq model, Eq props) --- => 'SomeComponent' props ('Component' parent model action) --- @ --- --- The smart constructors: --- --- * 'node', 'vnode' --- * 'text', 'vtext' --- * 'component', 'vcomp' --- * 'fragment_', 'fragment', 'vfrag', 'vfrag_' --- * ('+>') --- --- are used to build 'VNode', 'VText', 'VFrag' and 'VComp' respectively. A list of all the smart constructors defined in terms of 'node' (e.g. 'Miso.Html.Element.div_') can be found in "Miso.Html.Element". --- --- = Your first t'Component' --- --- To define a 'Component' the 'component' smart constructor can be used. --- Below is an example of a simple counter 'Component'. --- --- @ --- ----------------------------------------------------------------------------- --- module Main where --- ----------------------------------------------------------------------------- --- import Miso --- import Miso.Lens --- import qualified Miso.Html.Element as H --- import qualified Miso.Html.Event as HE --- import qualified Miso.Html.Property as HP --- ----------------------------------------------------------------------------- --- * - The type of the parent Component 'model' --- | * - The type of the parent Component 'props' accessible to the child --- | | * - The type of the current Component's 'model' --- | | | * - The type of the action that updates the 'model' --- | | | | --- counter :: 'Component' ROOT () Int Action --- counter = 'vcomp' m u v --- where --- m :: Int --- m = 0 --- --- u :: Action -> 'Effect' ROOT () Int Action --- u = \\case --- Add -> 'this' += 1 --- Subtract -> 'this' -= 1 --- --- v :: () -> Int -> 'View' Int Action --- v _ x = 'vfrag' --- [ H.button_ [ HE.onClick Add, HP.id_ "add" ] [ "+" ] --- , text (ms x) --- , H.button_ [ HE.onClick Subtract, HP.id_ "subtract" ] [ "-" ] --- ] --- ----------------------------------------------------------------------------- --- main :: IO () --- main = 'startApp' 'defaultEvents' counter --- ----------------------------------------------------------------------------- --- data Action --- = Add --- | Subtract --- deriving (Eq, Show) --- ----------------------------------------------------------------------------- --- @ --- --- = Running your first t'Component' --- --- The 'startApp' (or 'miso') functions are used to run the above t'Component'. --- --- @ --- main :: IO () --- main = 'startApp' 'defaultEvents' counter --- @ --- --- The 'startApp' function is what we recommend using first. It sets up event listeners and performs the initial page draw. --- The 'startApp' function assumes that @\@ is empty, and it will begin drawing the 'Component' 'View' from @\@. --- --- The 'miso' function (and also the 'prerender' function) assume that @\@ has already been populated by the results of the 'view' function. --- Instead of drawing, 'miso' will perform hydration. --- If the structures do not match 'miso' will fallback to drawing the page from scratch (clearing the contents of @\@ first). --- --- It is possible to execute an initial action when a t'Component' is first mounted. See the 'mount' (and similarly 'unmount') hooks. --- --- @ --- --- data Action = Init --- --- main :: IO () --- main = 'startApp' 'defaultEvents' counter { 'mount' = Just Init } --- --- update :: 'App' model Action --- update = \\case --- Init -> 'io_' ('consoleLog' "hello world!") --- @ --- --- = 'Component' composition --- --- @miso@ 'Component' can contain other 'Component'. This is --- accomplished through the 'Component' mounting combinator ('+>'). This combinator --- is responsible for encoding a typed 'Component' hierarchy, allowing 'Component' --- type-safe read-only access to their @parent@ model state. --- --- This combinator unifies the parent @model@ with the child @parent@, and --- subsequently the grandchild @parent@ unifies with the child @model@. This --- gives us a correct-by-construction 'Component' hierarchy. --- --- @ --- ('+>') --- :: forall child model action a . Eq child --- => 'MisoString' --- -> 'Component' model () child action --- -> 'View' model a --- key '+>' vcomp = 'VComp' (Just (toKey key)) ('SomeComponent' vcomp) --- @ --- --- Practically, using this combinator looks like: --- --- @ --- view :: () -> Int -> 'View' Int action --- view x = 'div_' [ 'id_' "container" ] [ "counter" '+>' counter ] --- @ --- --- You'll notice the @\"counter\"@ string was specified. This is a unique 'Key' --- to identify a 'Component' at runtime. These keys are very important when --- diffing two 'Component' together. When intentionally replacing 'Component' it is important --- to specify a new 'Key', otherwise the 'Component' will not be unmounted. --- --- It is possible to mount a component using the 'mount_' function, which avoids specifying a 'key_', but this should only be used --- when the user is certain they will not be diffing their 'Component' with another 'Component'. When in doubt, use the ('+>') combinator --- and 'key_' your 'Component'. --- --- Lastly, note also the signature of 'startApp'. --- --- @ --- 'startApp' :: 'Eq' model => 'Events' -> 'App' model action -> IO () --- @ --- --- The 'App' type signature is a synonym for 'Component' 'ROOT' --- --- @ --- type 'App' model action = 'Component' 'ROOT' () model action --- @ --- --- 'ROOT' is a type tag that encodes a 'Component' as top-level. Which means it has no @parent@, hence we mark @parent@ as 'ROOT'. --- --- @ --- data 'ROOT' --- @ --- --- 'startApp' and 'miso' will always infer @parent@ as 'ROOT'. --- --- = Props --- --- Inspired by [React props](https://react.dev/learn/passing-props-to-a-component), --- @miso@ allows a parent 'Component' to pass read-only data down to a child 'Component' --- via a mechanism called /props/ (short for /properties/). --- --- == Props vs. Component-local state --- --- * __model__: Component-local state. It is owned and mutated exclusively by the 'Component' --- itself through its 'Miso.Types.update' function. No other 'Component' can write to it directly. --- --- * __props__: Data /inherited/ from the @parent@ 'Component'. Props flow downward through --- the component hierarchy and are read-only from the child's perspective. The parent decides --- what props to pass at mount time; the child cannot mutate them. Props that change in a --- the parent cause the child to re-render. --- --- This mirrors the distinction in React between component state (@useState@) and props --- received from above (@function MyComponent({ name }) { ... }@). --- --- === When to use props --- --- Props are best suited for /metadata/ β€” contextual or configuration data that the child needs --- to know about but should not own. Good examples: a user's display name, a theme token, a --- locale string, or a read-only identifier used to customise rendering. --- --- If the data drives the child's own business logic β€” counters it increments, form fields it --- edits, async state it manages β€” that data belongs in the child's @model@ instead. Putting --- mutable business-logic state in @props@ would require the parent to own and thread through --- every change, creating unnecessary coupling. Prefer @props@ for \"what the child should --- know\" and @model@ for \"what the child should do\". --- --- == Props in 'Miso.Types.view' --- --- The 'Miso.Types.view' field of a 'Component' always takes @props@ as its first argument: --- --- @ --- view :: props -> model -> 'View' model action --- @ --- --- Top-level applications have no parent, so @props@ is always @()@: --- --- @ --- view :: () -> model -> 'View' model action --- view _props model = … --- @ --- --- == Props in 'Effect' \/ 'Miso.Types.update' --- --- Use 'getProps' inside the 'Effect' monad to read the current value of @props@: --- --- @ --- update :: Action -> 'Effect' parent props Model Action --- update = \\case --- SomeAction -> do --- p <- 'getProps' --- 'io_' ('consoleLog' (ms (show p))) --- @ --- --- Alternatively, use the 'Miso.Lens.view' combinator with the 'props' lens: --- --- @ --- update = \\case --- SomeAction -> do --- p <- 'Miso.Lens.view' 'props' --- … --- @ --- --- == 'ROOT' β€” the top-level 'Component' --- --- When a 'Component' is passed to 'startApp' (or 'miso') it has no parent. --- The @parent@ type is specialized to 'ROOT' and @props@ is fixed to @()@: --- --- @ --- type 'App' model action = 'Component' 'ROOT' () model action --- @ --- --- Because there is no parent to inherit from, @props@ will always be @()@ for a --- root-level 'Component'. You can simply ignore the first argument in 'view' and --- skip 'getProps' in 'Miso.Types.update'. --- --- == Passing props to a child 'Component' --- --- Use 'mountWithProps_' (keyed) or 'mountWithProps' (unkeyed) in the parent's 'view' to --- mount a child and supply its props: --- --- @ --- 'mountWithProps_' --- :: ('Eq' child, 'Eq' props) --- => 'MisoString' --- -> props --- -> 'Component' parent props child action --- -> 'View' parent a --- @ --- --- == Example: child reading parent-supplied props --- --- The following shows a parent 'Component' that maintains a greeting string in its --- @model@ and passes it as @props@ to a child 'Component'. The child renders the --- greeting and can also read it from within its 'Miso.Types.update' function. --- --- @ --- ----------------------------------------------------------------------------- --- -- The props type: what the parent shares with the child --- newtype Greeting = Greeting 'MisoString' deriving ('Eq') --- ----------------------------------------------------------------------------- --- -- Child component --- -- --- -- parent props model action --- -- | | | | --- child :: 'Component' ParentModel Greeting () ChildAction --- child = 'vcomp' () updateChild viewChild --- where --- viewChild :: Greeting -> () -> 'View' () ChildAction --- viewChild (Greeting g) _ = --- 'div_' [] [ 'text' ("Hello, " <> g <> "!") ] --- --- updateChild :: ChildAction -> 'Effect' ParentModel Greeting () ChildAction --- updateChild = \\case --- ReadGreeting -> do --- Greeting g <- 'getProps' --- 'io_' ('consoleLog' g) --- ----------------------------------------------------------------------------- --- -- Parent component: owns the greeting, passes it to the child as props --- parent :: 'App' ParentModel ParentAction --- parent = 'vcomp' (ParentModel "World") 'noop' viewParent --- where --- viewParent :: () -> ParentModel -> 'View' ParentModel ParentAction --- viewParent _ (ParentModel g) = --- 'mountWithProps_' "child" (Greeting g) child --- ----------------------------------------------------------------------------- --- newtype ParentModel = ParentModel 'MisoString' deriving ('Eq') --- data ChildAction = ReadGreeting --- data ParentAction --- @ --- --- A few things to notice: --- --- * The child's @parent@ type parameter is @ParentModel@. This must match the --- parent 'Component' @model@ type β€” 'mountWithProps_' enforces this at compile time. --- * 'getProps' inside the child's 'Miso.Types.update' yields a @Greeting@, not --- the full @ParentModel@. The child only sees what the parent explicitly chose to share. --- * The root 'App' always has @props ~ ()@; no extra plumbing is needed when calling 'startApp'. --- --- = 'VComp' lifecycle hooks --- --- 'Component' are mounted on the fly during diffing. All t'Component` are equipped with `mount` and `unmount` hooks. This allows the defining of custom actions that will be processed in response to lifecycle events. --- --- * 'Miso.Types.mount' --- * 'Miso.Types.unmount' --- --- = 'VNode' lifecycle hooks --- --- Similar to t'Component' lifecycle hooks, all 'Miso.Types.VNode' also expose lifecycle hooks. --- --- * 'Miso.Event.onBeforeCreated' --- * 'Miso.Event.onCreated' / 'Miso.Event.onCreatedWith' --- * 'Miso.Event.onBeforeDestroyed' / 'Miso.Event.onBeforeDestroyedWith' --- * 'Miso.Event.onDestroyed' --- --- These are convenient for initializing and deinitializing third-party libraries (as seen below with [highlight.js](https://highlightjs.org/)) --- --- @ --- {-# LANGUAGE QuasiQuotes -#} --- {-# LANGUAGE MultilineStrings -#} --- --- import Miso --- import Miso.FFI.QQ (js) --- --- data Action = Highlight DOMRef --- --- update :: Action -> 'Effect' parent props model Action --- update = \\case --- Highlight domRef -> 'io_' $ do --- ['js'| hljs.highlight(${domRef}) |] --- --- view :: model -> 'View' model Action --- view x = --- 'code_' --- [ 'onCreatedWith' Highlight --- ] --- [ """ --- function addOne (x) { return x + 1; } --- """ --- ] --- @ --- --- As a convention, the @*with@ variant of 'VNode' lifecycle hooks (e.g. 'Miso.Event.onCreatedWith') provide the target 'DOMRef' in the callback function (shown above). --- --- = 'VFrag' (Fragment nodes) --- --- Similar to the [React Fragment](https://react.dev/reference/react/Fragment) API (@\@ or @\<\>\<\/\>@ syntax), and to @DocumentFragment@ in the browser DOM API. @miso@ provides a 'VFrag' constructor for grouping together sibling nodes without introducing an extra wrapper element in the DOM. --- --- @ --- -- Renders two \ elements as direct siblings, no enclosing element --- 'fragment' [ 'li_' [] [ 'text' "Item A" ], 'li_' [] [ 'text' "Item B" ] ] --- @ --- --- A 'VFrag' may optionally carry a 'Key'. Keyed fragments participate in the same --- reconciliation algorithm as keyed 'VNode' and 'VText' nodes, allowing the virtual --- DOM differ to identify, reorder, and reuse groups of siblings efficiently. --- --- @ --- -- Keyed fragment β€” survives reordering without full teardown\/remount --- 'vfrag_' "my-key" [ 'li_' [] [ 'text' "A" ], 'li_' [] [ 'text' "B" ] ] --- @ --- --- Fragments may be nested β€” a 'VFrag' child may itself be a 'VFrag'. The diff function --- recurses into nested fragments and processes all fragments as if they were --- flat sequence of sibling DOM nodes, so nesting carries no runtime cost beyond the extra 'VFrag' constructor allocation. --- --- Empty fragments (@'fragment' []@) in child nodes are erased from the virtual DOM tree in the --- Haskell layer before they reach diffing in JavaScript and are therefore a no-op. --- --- The smart constructors for 'VFrag' are: --- --- * 'fragment' β€” unkeyed fragment --- * 'vfrag' β€” unkeyed fragment (alias) --- * 'fragment_' β€” keyed fragment --- * 'vfrag_' β€” keyed fragment (alias, infix-friendly: @\"key\" \`vfrag_\` [...]@) --- --- = 'Key' --- --- A 'Key' is a unique identifier used to optimize diffing. --- --- Virtual DOM nodes can be \"keyed\" (See 'key_'). Keys have multiple meanings in @miso@ (and react). --- --- * Keys are used to optimize child node list diffing. --- --- When two lists of elements are being diffed, as long as they all have unique keys, diffing large child lists will be much faster. This optimization automatically occurs when all the elements in a 'VNode' child list contain unique keys. Unless all 'View' nodes in a child list are keyed, this optimization will not fire. --- --- * Keys are used to compare two identical nodes. --- --- If two `VNode` are being compared (or two `VComp`) and their keys differ, the old node will be destroyed and a new one created. Otherwise, the underlying DOM node won't be removed, but its properties will be diffed. In the case of diffing two t'Component' (the 'VComp' case), if the keys differ, the 'unmount' phase will be triggered for the old 'VComp' and the 'mount' phase will be triggered for the new 'Component'. The underlying DOM reference will be replaced. --- --- See the 'key_' property for usage (and smart constructors like 'textKey_' and ('+>') as well). --- --- @ --- 'ul_' --- [] --- [ 'li_' [ 'key_' "key-1" ] [ "a" ] --- , 'li_' [ 'key_' "key-2" ] [ "b" ] --- , "key-3" '+>' counter --- , 'textKey' "key-4" "text here" --- , 'vfrag_' "key-5" [ "foo", "bar" ] --- ] --- @ --- --- = 'Events' --- --- * Event Delegation --- --- By default all events are delegated through @\@. Miso supports both @capture@ and @bubble@ phases of browser events. --- Users can handle both phases in their applications. --- --- * Using events --- --- Miso exposes a 'defaultEvents' for convenience, these events are commonly used events and listened for on @\@. They get routed through the 'View' to the virtual DOM node that raised the event. Other 'Events' are exposed as conveniences (e.g. 'touchEvents'). All events required by all 'Component' must be combined together for use when running your application (e.g. @keyboardEvents <> touchEvents@). --- --- @ --- 'touchEvents' :: 'Events' --- 'touchEvents' = M.fromList --- [ ("touchstart", 'BUBBLE') --- , ("touchcancel", 'BUBBLE') --- , ("touchmove", 'BUBBLE') --- , ("touchend", 'BUBBLE') --- ] --- @ --- --- * Defining event handlers --- --- Users can define their own event handlers using the 'Miso.Event.on' combinator. By default this will define an event in the 'Miso.Event.Types.BUBBLE' phase. See 'Miso.Event.onCapture' for handling events during the 'Miso.Event.Types.CAPTURE' phase. See the the module "Miso.Html.Event" for many predefined events. --- --- @ --- 'onChangeWith' :: ('MisoString' -> 'DOMRef' -> action) -> 'Attribute' action --- 'onChangeWith' = 'on' "change" 'valueDecoder' --- @ --- --- The @*with@ variant of events (e.g. 'Miso.Event.onChangeWith') provides the target 'DOMRef' in the callback function. --- --- * Decoding events --- --- After an event has been raised, one can extract information from the event for use in their application. This is accomplished through a 'Decoder'. Many common decoders are available for use in "Miso.Event.Decoder". --- --- @ --- data 'Decoder' a --- = 'Decoder' --- { 'decoder' :: 'Value' -> 'Parser' a --- , 'decodeAt' :: 'DecodeTarget' --- } --- --- -- | Example of a custom 'Decoder' for the @value@ property of an event target. --- 'valueDecoder' :: 'Decoder' 'MisoString' --- 'valueDecoder' = Decoder {..} --- where --- decodeAt = 'DecodeTarget' ["target"] --- decoder = 'withObject' "target" $ \\o -> o .: "value" --- @ --- --- = Attributes / Properties --- --- The 'Attribute' type allows us to define web handlers that map browser events to --- Haskell data types (e.g. 'Miso.Html.Event.onClick'), along with specifying properties on DOM elements --- (like 'Miso.Html.Property.className' and 'Miso.Html.Property.id_'). See "Miso.Property" and "Miso.Html.Property" for more information. --- --- @ --- 'div_' [ 'id_' "some-id", 'className' "some-class" ] [ ] --- @ --- --- = 'Effect' --- --- The 'Effect' type is used to mutate the @model@ over time in response to @action@. --- 'Effect' also allows 'IO' to be scheduled for evaluation by the @miso@ scheduler. --- --- Note: 'IO' is never evaluated inside of 'Effect', it is only scheduled. --- There is no 'MonadIO' instance for 'Effect'. --- --- The 'Effect' type is defined as a 'RWS'. --- --- @ --- type 'Effect' parent props model action = 'RWS' ('ComponentInfo' parent props) ['Schedule' action] model () --- @ --- --- * The 'Control.Monad.Reader' portion of 'Effect' is 'ComponentInfo'. 'ask', 'asks', 'Miso.Lens.view' can be used to access its fields. --- * The 'Control.Monad.Writer' portion of 'Effect' is used to schedule t'IO' actions. 'tell' can be used to create a 'Schedule' for an 'IO' action that is executed according to 'Synchronicity'. See also 'withSink' for usage. --- * The 'Control.Monad.State' portion of 'Effect' is used to manipulate the @model@. 'get', 'put', 'modify', and the 'Control.Monad.State.MonadState' lenses in t'Miso.Lens.Lens' can be used to modify the @model@. --- --- 'IO' can be performed either synchronously or asynchronously. By default all 'IO' is asynchronous --- --- == Asynchronous 'IO' --- --- * 'io': Used to introduce asynchronous 'io' into the system, see also the 'io_' variant. --- --- * 'withSink': The core function (from which most other combinators are defined) --- that gives users access to the underlying event 'Sink'. This also allows us to --- introduce 'IO' into the system. The @miso@ scheduler attaches exception --- handlers to all 'IO' actions. --- --- * For maximum flexibility, the 'MonadWriter' instance ('tell') can be used to schedule 'IO' (see the 'withSink' implementation). --- --- == Synchronous 'IO' --- --- * 'sync': Forces the scheduler to evaluate 'IO' synchronously. It is --- recommended to use the 'io' function by default, 'sync' *will* block the scheduler. --- --- == 'Sink' --- --- @ --- type 'Sink' a => a -> 'IO' () --- @ --- --- The 'Sink' function allows one to write any @action@ to the global event queue. See 'withSink' for more information. --- --- == Managing 'model' state. --- --- Any 'MonadState' function is allowed for use when manipulating @model@, 'Miso.State.get', 'Miso.State.put', etc. See "Miso.State". --- --- The 'MonadReader' instances allows the retrieval of 'ComponentInfo' within 'Effect'. --- 'ComponentInfo' provides the current 'ComponentId' the @parent@ 'ComponentId', and the 'DOMRef' ('_componentDOMRef') that the 'Component' is mounted on. --- --- = 'Component' communication --- --- == Asynchronous communication --- --- 'Component' are able to communicate asynchronously via a message-passing system. --- The miso runtime exposes a few primitives to allow t'Component' communication. --- --- * 'broadcast' --- * 'mail' --- * 'mailParent' --- * 'mailChildren' --- * 'mailAncestors' --- --- All t'Component' have a 'mailbox' that can receive messages (as t'Miso.JSON.Value') from other t'Component'. --- This is meant to be used with the 'checkMail' function. The 'mail' function allows a 'Component' to send a specific message (as 'Value') to another t'Component' via its t'ComponentId'. --- The 'ComponentId' can be found in the 'Effect' monad. Using 'ask' will return a t'ComponentInfo'. The 'Component' receiving --- the message will find it in its 'mailbox'. --- --- * "Miso.PubSub" --- --- miso has support for the publisher / subscriber concurrency pattern. See the "Miso.PubSub" module for more information. --- --- == Synchronous communication --- --- * "Miso.Binding" --- --- Experimental support for data bindings (where 'Component' model can synchronize fields via a 'Miso.Lens.Lens' in response to model differences along the parent-child relationship). See the "Miso.Binding" module for more information, and the [miso-reactive](https://github.com/haskell-miso/miso-reactive) example. *Warning*: This is still considered experimental. --- --- == Parent access --- --- * 'parent' --- --- While not direct communication, a 'Component' can asynchronously receive read-only access to its @parent@ state via the 'parent' function. --- --- = Subscriptions --- --- A t'Sub' is any long-running operation that is external to a 'Component', but that can write --- to a 'Component' 'Sink'. 'Sub' come in two flavors, a dynamic 'Sub' (via 'startSub' / 'stopSub') and 'subs'. --- --- * 'subs' --- --- @ --- main :: IO () --- main = 'startApp' 'defaultEvents' app { 'subs' = [ timerSub ] } --- --- timerSub :: 'Sub' Action --- timerSub sink = 'forever' $ ('threadDelay' 100000) >> sink Log --- --- data Action = Log --- @ --- --- The 'subs' field of 'Component' contains 'Sub' that exist for the lifetime of that 'Component'. --- When a 'Component' unmounts, these 'Sub' will be stopped, and their resources finalized. --- --- @ --- 'onLineSub' :: (Bool -> action) -> 'Sub' action --- 'onLineSub' f sink = 'Miso.Subscription.Util.createSub' acquire release sink --- where --- release (cb1, cb2) = do --- FFI.windowRemoveEventListener "online" cb1 --- FFI.windowRemoveEventListener "offline" cb2 --- acquire = do --- cb1 <- FFI.windowAddEventListener "online" (const $ sink (f True)) --- cb2 <- FFI.windowAddEventListener "offline" (const $ sink (f False)) --- pure (cb1, cb2) --- @ --- --- * 'startSub' / 'stopSub' --- --- At times its necessary to dynamically generate a 'Sub' in reponse to an event (e.g. starting a "Miso.WebSocket" connection --- when a user logs in). The 'startSub' and 'stopSub' functions facilitate dynamic 'Sub' creation / removal. --- --- @ --- update = \\case --- StartTimer -> 'startSub' ("timer" :: MisoString) timerSub --- StopTimer -> 'stopSub' "timer" --- Log -> 'io_' ('consoleLog' "log") --- where --- timerSub :: 'Sub' Action --- timerSub sink = 'Control.Monad.forever' $ ('Control.Concurrent.threadDelay' 100000) >> sink Log --- --- data Action = Log --- @ --- --- * 'Miso.Subscription.Util.createSub' --- --- 'Miso.Subscription.Util.createSub' is a helper function for creating a 'Sub' using the 'Control.Exception.bracket' pattern. --- This ensures that event listeners can be unregistered when a 'Component' unmounts. For example usage --- please see the "Miso.Subscription" sub modules. 'createSub' is only meant to be used in scenarios where --- custom event listeners are required. --- --- = (2D/3D) Canvas support --- --- Miso has full 2D and 3D canvas support. See the "Miso.Canvas" module, the [miso-canvas](https://github.com/haskell-miso/miso-canvas2d) example, along with the [three-miso](https://github.com/haskell-miso/three-miso) package. --- --- = 'Control.Monad.State.State' management --- --- A simple 'Miso.Lens.Lens' implementation is included with miso, this was done for convenience, to minimize dependencies, reduce payload size, and provide a simpler interface. See "Miso.Lens". This is a simple lens formulation that exposes many common 'MonadState' lenses (e.g. @'+='@) that work in the 'Effect' monad. "Miso.Lens" is not required for use, any lens library will also work with miso. --- --- = HTML --- --- Miso's virtual DOM DSL ('Miso.Types.View') type can be repurposed to render HTML. See the "Miso.Html.Render" module for more information. This uses the 'Miso.Html.Render.ToHtml' class. --- --- = JavaScript EDSL --- --- Miso provides a Javascript DSL (inspired by [jsaddle](https://hackage.haskell.org/package/jsaddle)) via "Miso.DSL". --- See the 'Miso.DSL.ToJSVal' / 'Miso.DSL.FromJSVal' typeclasses when marshaling to and from Haskell to JavaScript. See also the 'Miso.DSL.jsg' --- function for accessing JavaScript objects that exist in the global scope. --- --- @ --- document :: 'JSVal' <- 'jsg' "document" :: IO 'JSVal' --- len :: 'Int' <- 'fromJSValUnchecked' =<< (document ! "body" ! "children" ! "length") --- @ --- --- = QuasiQuotation (@inline-js@) --- --- Along with "Miso.DSL", a JavaScript QuasiQuoter is now included (See "Miso.FFI.QQ"). This makes it easy to --- integrate miso with any third-party JavaScript library. The bindings in scope can be used inside the QuasiQuoter, which --- will utilize their 'Miso.DSL.ToJSVal' instances. When returning values from the QuasiQuoter, the 'Miso.DSL.FromJSVal' instance will --- be used Haskell. --- --- @ --- --- {-# LANGUAGE QuasiQuotes #-} --- --- import Miso.FFI.QQ ('js') --- --- update :: Action -> 'Effect' parent props model Action --- update = \\case --- Log msg -> io_ [js| console.log(${msg}) |] --- --- data Action = Log MisoString --- @ --- --- = Routing --- --- miso exposes its own internal router. See "Miso.Router" for more information. The router is inspired by both the [servant](https://hackage.haskell.org/package/servant) and the [web-routes](https://hackage.haskell.org/package/web-routes) package. The router has its own 'Sub' called 'Miso.Router.routerSub' meant for easy integration with the History API. --- --- = 'MisoString' --- --- miso includes its own string type named t'MisoString'. This is the preferred string type to use --- in order to maximize application performance. Since strings are ubiquitous in applications we --- want to minimize the copying of these strings between the JS and Haskell heaps. t'MisoString' accomplishes this. --- t'MisoString' is a synonym for t'JSString' when using the JS / WASM backends. When using vanilla GHC --- it is t'Data.Text'. See "Miso.String" for more information. --- --- For string conversions see the 'ms', 'fromMisoString' functions and 'ToMisoString' / 'FromMisoString' classes. --- --- t'MisoString' is also used in the "Miso.Util.Lexer" and "Miso.Util.Parser" modules. --- --- = JSON --- --- "Miso.JSON" is a [microaeson](https://hackage.haskell.org/package/microaeson) --- implementation that uses t'MisoString'. This is done for performance reasons and to minimize the dependency burden. "Miso.JSON" is used --- in "Miso.Event.Decoder", "Miso.Fetch", "Miso.WebSocket" modules respectively. --- --- = Styles --- --- Miso prescribes no exact CSS style usage. It is up to the user's discretion on how best to handle styles in their application. Inline styles, external stylesheets and the "Miso.CSS" DSL can all be used. See also [miso-ui](https://ui.haskell-miso.org) for an example of what is possible. --- --- = Development --- --- When developing miso applications interactively it is possible to append 'styles' and 'scripts' to the @\@ portion of --- the page when the 'Component' mounts. This is a convenience only meant to be used in development. We recommend guarding the usage behind a flag. --- --- @ --- main :: 'IO' () --- main = 'startApp' 'defaultEvents' counter --- where --- app = counter --- #ifdef INTERACTIVE --- { 'scripts' = [ 'Src' "https://ajax.googleapis.com/ajax/libs/jquery/3.7.1/jquery.min.js" ] --- , 'styles' = [ 'Href' "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/css/bootstrap.min.css" ] --- } --- #endif --- @ --- --- See the [miso-sampler](https://github.com/haskell-miso/miso-sampler) repository for more information. --- --- = Debugging --- --- Sometimes things can go wrong. Common errors like using `onClick` but not listening for the the 'click' event are common. --- These are errors that cannot be caught statically. These can be detected by enabling 'DebugAll'. Currently, debugging event delegation --- and page hydration is supported. --- --- * 'DebugHydrate' --- * 'DebugEvents' --- --- @ --- counter { 'logLevel' = 'DebugAll' } --- @ --- --- = Internals --- --- Internally miso uses a global event queue and a scheduler to process all events raised by 'Component' throughout the lifetime of --- an application. Events are processed in FIFO order, batched by the 'Component' that raised them. --- --- = Prerendering --- --- Prerendering is the process of delivering HTML from a web server before the client loads and performs any drawing to the page. In miso it comes in two flavors, static --- or dynamic prerendering. Static prerendering assumes no model state needs to be shared between the server and client. Dynamic uses 'hydrateModel' to share @model@ state. --- --- == Static prerendering --- --- miso provides the 'prerender' and 'miso' functions to facilitate static prerendering. Any page can be generated from a miso 'View' using the 'Miso.Render.toHtml' instance. --- --- A simple example of static prerendering would be an @index.html@ page with some HTML --- --- @ --- echo "\\\<\/head\>\hello world\<\/body\>\" > index.html --- @ --- --- And a miso application that looks like: --- --- @ --- main :: IO () --- main = 'prerender' 'defaultEvents' $ ('vcomp' () 'noop' $ \\() -> "hello world") { 'logLevel' = 'DebugPrerender' } --- @ --- --- Assuming the JS / WASM payload and @index.html@ are delivered together from the web server, the console should output below --- --- > [DEBUG_HYDRATE] Successfully prerendered page --- --- See the [Haskell miso](https://haskell-miso.org) website console for an example usage of static prerendering with 'miso' and [miso-ui](https://ui.haskell-miso.org) for 'prerender' usage. --- --- == Dynamic prerendering --- --- More advanced usage of prerendering entails sharing the @model@ between the server and client. In such scenarios the 'hydateModel' function should be specified inside the t'Component'. --- The SSR flag (`-fssr`) must be specified when using this feature. --- --- 'hydrateModel' is used to load initial data into a Component's 'model' that is necessary for hydration. --- ------------------------------------------------------------------------------ -module Miso - ( -- * API - -- ** Miso - miso - , prerender - , (🍜) - -- ** App - , App - , startApp - , renderApp - -- ** Component - , Component (..) - , component - , vcomp - , (+>) - , mount_ - -- ** View - , vcomp - , vnode - , vtext - -- ** Sink - , withSink - , Sink - -- ** Mail - , mail - , checkMail - , parent - , mailParent - , mailChildren - , mailAncestors - , broadcast - -- ** Subscriptions - , startSub - , stopSub - , Sub - -- ** Effect - , issue - , batch - , io - , io_ - , sync - , sync_ - , for - -- ** JS file embedding -#ifdef WASM - , evalFile -#endif - , withJS - -- * Bindings - -- | Primitives for synchronizing parent and child models. - , module Miso.Binding - -- * DSL - -- | A JavaScript DSL for easy FFI interoperability - , module Miso.DSL - -- * Effect - -- | 'Effect', 'Sub', and 'Sink' types for defining update functions and subscriptions. - , module Miso.Effect - -- * Event - -- | Functions for specifying component lifecycle events and event handlers. - , module Miso.Event - -- * Fetch - -- | Interface to the Fetch API for making HTTP requests. - , module Miso.Fetch - -- * PubSub - -- | Publish / Subscribe primitives for communication between components. - , module Miso.PubSub - -- * Property - -- | Construct custom properties on DOM elements. - , module Miso.Property - -- * Reload - -- | Support for clearing the page during live-reloading w/ WASM browser mode. - , module Miso.Reload - -- * Subscriptions - -- | Subscriptions for external events (mouse, keyboard, window, history, etc.). - , module Miso.Subscription - -- * Storage - -- | Web Storage API (Local and Session storage) interface. - , module Miso.Storage - -- * Types - -- | Core types for Miso applications. - , module Miso.Types - -- * Util - -- | Utility functions for views, parsing, and general purpose combinators. - , module Miso.Util - -- * FFI - -- | Foreign Function Interface (FFI) utilities for interacting with JavaScript. - , module Miso.FFI - -- * State management - -- | State management for Miso applications. - , module Miso.State - ) where ------------------------------------------------------------------------------ -import Miso.Binding -import Miso.DSL -import Miso.Effect -import Miso.Event -import Miso.Fetch -import Miso.FFI -import qualified Miso.FFI.Internal as FFI -import Miso.Property -import Miso.PubSub -import Miso.Reload -import Miso.Router -import Miso.Runtime -import Miso.State -import Miso.Storage -import Miso.Subscription -import Miso.Types -import Miso.Util ----------------------------------------------------------------------------- --- | Runs an @miso@ application. --- --- Assumes the pre-rendered DOM is already present. --- Always mounts to \. Copies page into the virtual DOM. --- --- @ --- main :: 'IO' () --- main = 'miso' 'defaultEvents' (\\uri -> app uri)) --- @ -miso - :: Eq model - => Events - -- ^ Globally delegated Events - -> (URI -> App model action) - -- ^ The Component application, with the current URI as an argument - -> IO () -miso events f = do - vcomp_ <- f <$> getURI - initComponent events Hydrate vcomp_ { mountPoint = Nothing } ----------------------------------------------------------------------------- --- | Like 'miso', except discards the 'URI' argument. --- --- Use this function if you'd like to prerender, but not use navigation. --- --- @ --- main :: 'IO' () --- main = 'prerender' 'defaultEvents' app --- @ -prerender - :: Eq model - => Events - -- ^ Globally delegated 'Events' - -> App model action - -- ^ 'Component' application - -> IO () -prerender events comp = initComponent events Hydrate comp { mountPoint = Nothing } ------------------------------------------------------------------------------ --- | Like 'miso', except it does not perform page hydration. --- --- This function draws your application on an empty --- --- You will most likely want to use this function for your application --- unless you are using prerendering. --- --- @ --- main :: 'IO' () --- main = 'startApp' 'defaultEvents' app --- @ --- -startApp - :: Eq model - => Events - -- ^ Globally delegated 'Events' - -> App model action - -- ^ 'Component' application - -> IO () -startApp events = initComponent events Draw ------------------------------------------------------------------------------ --- | Alias for 'Miso.miso'. -(🍜) - :: Eq model - => Events - -- ^ Globally delegated 'Events' - -> (URI -> App model action) - -- ^ 'Component' application, with the current URI as an argument - -> IO () -(🍜) = miso ----------------------------------------------------------------------------- --- | Runs a 'miso' application, but with a custom rendering engine. --- --- The 'MisoString' specified here is the variable name of a globally-scoped --- JS object that implements the context interface per @ts\/miso\/context\/dom.ts@ --- This is necessary for native support. --- --- It is expected to be run on an empty @\@ --- --- @ --- main :: IO () --- main = 'renderApp' 'defaultEvents' "my-context" app --- @ -renderApp - :: Eq model - => Events - -- ^ Globally delegated 'Events' - -> MisoString - -- ^ Name of the JS object that contains the drawing context - -> App model action - -- ^ 'Component' application - -> IO () -renderApp events renderer comp = do - FFI.setDrawingContext renderer - initComponent events Draw comp +{-# LANGUAGE CPP #-} +----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wno-duplicate-exports #-} +----------------------------------------------------------------------------- +-- | +-- Module : Miso +-- Copyright : (C) 2016-2026 David M. Johnson (@dmjio) +-- License : BSD3-style (see the file LICENSE) +-- Maintainer : David M. Johnson +-- Stability : experimental +-- Portability : non-portable +-- +-- = miso 🍜 +-- +-- @miso@ is a library for building web and native user interface applications in Haskell. See the [GitHub group](https://github.com/haskell-miso). +-- +-- It provides a [React](https://react.dev)-like programming experience for a simple [Haskell](https://haskell.org) dialect that emphasizes +-- +-- * performance +-- * purity +-- * simplicity +-- * extensibility +-- * composability +-- +-- miso addresses common areas of web development: +-- +-- * __DOM manipulation__: @miso@ uses a [Virtual DOM](https://en.wikipedia.org/wiki/Virtual_DOM) with a diffing algorithm that is +-- responsible for all DOM modification and 'Component' lifecycle hooks. +-- +-- * __Event delegation__: All event listeners are attached to a top-level element +-- (typically @\@). When raised, events are routed through the virtual DOM +-- to Haskell event handlers which cause application state changes. Internally @miso@ +-- virtualizes both the @capture@ and @bubble@ phases of the browser when it performs event routing. +-- +-- * __Prerendering__: Prerendering is a process where the server delivers HTML +-- to the client before the JavaScript (or WebAssembly) application bootstraps. +-- Instead of performing an initial draw, the application will create and populate the virtual DOM from the actual DOM. +-- This is a process known as \"hydration\". This avoids unnecessary page draws on initial page +-- load and enhances search engine optimization. @miso@ provides its own HTML rendering +-- ("Miso.Html.Render") to render HTML on the server and the 'miso' function exists on the client to \"hydrate\" +-- the virtual DOM with the DOM. +-- +-- * __Components__: A 'Component' can be considered an instance of a @miso@ application. A 'Component' +-- contains user-defined state, logic for updating this state, and a function +-- for creating UI templates from this user-defined state. 'Component' can nest other 'Component', +-- enabling arbitrarily deep UI trees. +-- +-- * __Custom renderers__: The underlying DOM operations are able to be abstracted. +-- This allows a custom rendering engine to be used. This is seen in the [miso-lynx](https://github.com/haskell-miso/miso-lynx) project +-- (which allows miso to target mobile phone devices). +-- +-- * __Lifecycle hooks__: 'Component' expose 'Miso.Types.mount' and 'Miso.Types.unmount' lifecycle hooks. This allows users to define custom logic that will +-- execute when a 'Component' mounts or unmounts. 'Miso.Event.onCreated' and 'Miso.Event.onDestroyed' are 'VNode' specific lifecycle hooks. +-- These hooks are commonly used for 'Component' communication and for third-party integration with JavaScript libraries. +-- +-- * __State management__: 'Component' @model@ state can be manipulated using "Miso.Lens" or "Miso.State" in response to application events. +-- +-- = Architecture +-- +-- * __React__: miso implements a subset of the [React](https://react.dev) architecture including 'Component', Lifecycle Hooks, Virtual DOM, Event delegation, +-- [Fragment](https://react.dev/reference/react/Fragment) and [Props](https://react.dev/learn/passing-props-to-a-component). +-- +-- * __Elm__: miso also implements the [Elm](https://elm-lang.org) architecture (MVU) and the 'mailbox' communication pattern. +-- +-- = The Model-View-Update pattern +-- +-- The core type of miso is 'Component'. The 'Component' API adheres to the [Elm](https://elm-lang.org) +-- MVU (model-view-update) interface. This is similar to a left-fold over @action@s β€” the 'Component' +-- @model@ is updated by 'Miso.Types.update' and rendered by 'Miso.Types.view'. +-- +-- * __'model'__: This can be any user-defined type in Haskell. An 'Eq' constraint +-- is required. We recommend using the default derived 'Eq' instance. +-- +-- * __'view'__: This is the templating function that is used to construct a new virtual DOM +-- (or HTML if rendering on the server). +-- +-- * __'update'__: The 'update' function handles how the 'model' evolves over time in response +-- to events that are raised by the application. This function takes any @action@, +-- updating the @model@ and optionally introduces 'IO' into the system. +-- +-- = Your first t'Miso.Types.Component' +-- +-- To define a t'Miso.Types.Component', the 'component' smart constructor can be used. +-- Below is an example of a simple counter 'Component'. +-- +-- @ +-- ----------------------------------------------------------------------------- +-- module Main where +-- ----------------------------------------------------------------------------- +-- import "Miso" +-- import "Miso.Lens" +-- import qualified "Miso.Html.Element" as H +-- import qualified "Miso.Html.Event" as HE +-- import qualified "Miso.Html.Property" as HP +-- ----------------------------------------------------------------------------- +-- * - The type of the parent 'Component' 'model' +-- | * - The type of the parent 'Component' 'props' accessible to the child +-- | | * - The type of the current 'Component' 'model' +-- | | | * - The type of the action that updates the 'model' +-- | | | | +-- counter :: 'Component' 'ROOT' () 'Int' Action +-- counter = 'vcomp' m u v +-- where +-- -- | Initial 'model' value +-- m :: 'Int' +-- m = 0 +-- * - The type of the parent 'Component' 'model' +-- | * - The type of the parent 'Component' 'props' accessible to the child +-- | | * - The type of the current 'Component' 'model' +-- | | | * - The type of the action that updates the 'model' +-- | | | | +-- u :: Action -> 'Effect' 'ROOT' () 'Int' Action +-- u = \\case +-- Add -> 'Miso.Lens.this' += 1 +-- Subtract -> 'Miso.Lens.this' -= 1 +-- +-- * - The type of the parent 'Component' props +-- | * - The type of the current 'Component' 'model' +-- | | * - The type of the 'Component' 'model' (used for 'Component' mounting with '+>') +-- | | | * - The type of the action that updates 'Component' 'model' +-- | | | | +-- v :: () -> 'Int' -> 'View' 'Int' Action +-- v _props x = 'vfrag' +-- [ H.'Miso.Html.Element.button_' [ HE.'Miso.Html.Event.onClick' Add, HP.'Miso.Html.Property.id_' "add" ] [ "+" ] +-- , 'text' ('ms' x) +-- , H.'Miso.Html.Elemment.button_' [ HE.'Miso.Html.Event.onClick' Subtract, HP.'Miso.Html.Property.id_' "subtract" ] [ "-" ] +-- ] +-- ----------------------------------------------------------------------------- +-- main :: 'IO' () +-- main = 'startApp' 'defaultEvents' counter +-- ----------------------------------------------------------------------------- +-- data Action +-- = Add +-- | Subtract +-- deriving ('Eq', 'Show') +-- ----------------------------------------------------------------------------- +-- @ +-- +-- = Running your first t'Component' +-- +-- The 'startApp' (or 'miso') functions are used to run the above t'Component'. +-- +-- @ +-- main :: 'IO' () +-- main = 'startApp' 'defaultEvents' counter +-- @ +-- +-- We recommend 'startApp' as the starting point β€” it sets up event listeners, performs the initial page draw, +-- and assumes @\@ is empty. +-- +-- The 'miso' function (and 'prerender') assume that @\@ has already been populated by the results of the 'view' function. +-- Instead of drawing, 'miso' will perform hydration. +-- If the structures do not match, 'miso' will fall back to drawing the page from scratch (clearing the contents of @\@ first). +-- +-- It is possible to execute an initial action when a t'Component' is first mounted. See the 'mount' (and similarly 'unmount') hooks. +-- +-- @ +-- +-- data Action = Init +-- +-- main :: 'IO' () +-- main = 'startApp' 'defaultEvents' counter { 'mount' = Just Init } +-- +-- update :: 'App' model Action +-- update = \\case +-- Init -> 'io_' ('consoleLog' "hello world!") +-- @ +-- +-- Note also the signature of 'startApp'. +-- +-- @ +-- 'startApp' :: 'Eq' model => 'Events' -> 'App' model action -> 'IO' () +-- @ +-- +-- The 'App' type synonym is defined as: +-- +-- @ +-- type 'App' model action = 'Component' 'ROOT' () model action +-- @ +-- +-- 'ROOT' is a type tag for top-level 'Component' β€” one with no @parent@. +-- +-- @ +-- data 'ROOT' +-- @ +-- +-- 'startApp' and 'miso' will always infer @parent@ as 'ROOT'. +-- +-- = t'View' DSL +-- +-- The 'View' type represents the virtual DOM β€” a [Rose tree](https://en.wikipedia.org/wiki/Rose_tree) +-- of nodes mutually recursive with 'Component' via the 'view' function. +-- +-- @ +-- data 'View' model action +-- = 'VNode' 'Namespace' 'Tag' ['Attribute' action] ['View' model action] +-- | 'VText' (Maybe 'Key') 'MisoString' +-- | 'VComp' (Maybe 'Key') ('SomeComponent' model) +-- | 'VFrag' (Maybe 'Key') ['View' model action] +-- @ +-- +-- 'VNode' and 'VText' have a one-to-one mapping from the virtual DOM to the physical DOM. The 'VComp' and 'VFrag' constructors are abstract (live only on the virtual DOM) and do not contain a reference to the physical DOM. The existential 'SomeComponent' is what allows embedding polymorphic 'Component' within a 'View'. +-- +-- @ +-- data 'SomeComponent' parent +-- = forall model action props . ('Eq' model, 'Eq' props) +-- => 'SomeComponent' props ('Component' parent props model action) +-- @ +-- +-- The smart constructors: +-- +-- * 'node', 'vnode' β€” build a 'VNode' +-- * 'text', 'vtext' β€” build a 'VText' +-- * 'component', 'vcomp' β€” build a 'VComp' ('vcomp' is a synonym for 'component') +-- * 'fragment', 'vfrag', 'fragment_', 'vfrag_' β€” build a 'VFrag' +-- * ('+>') β€” key and mount a child 'Component' +-- +-- A full list of element smart constructors built on 'node' (e.g. 'Miso.Html.Element.Miso.Html.Element.div_') can be found in "Miso.Html.Element". +-- +-- = 'VComp' +-- +-- == Composition +-- +-- @miso@ 'Component' can contain other 'Component'. This is +-- accomplished through the 'Component' mounting combinator ('+>'). This combinator +-- is responsible for encoding a typed 'Component' hierarchy, allowing 'Component' +-- type-safe read-only access to their @parent@ model state. +-- +-- This combinator unifies the parent @model@ with the child @parent@, and +-- subsequently the grandchild @parent@ unifies with the child @model@. This +-- gives us a correct-by-construction 'Component' hierarchy. +-- +-- @ +-- ('+>') +-- :: forall child model action a . Eq child +-- => 'MisoString' +-- -> 'Component' model () child action +-- -> 'View' model a +-- key '+>' comp = 'VComp' (Just ('toKey' key)) ('SomeComponent' () comp) +-- @ +-- +-- Practically, using this combinator looks like: +-- +-- @ +-- viewModel :: props -> Int -> 'View' Int action +-- viewModel _ _ = 'Miso.Html.Element.div_' [ 'Miso.Html.Property.id_' "container" ] [ "counter" '+>' counter ] +-- @ +-- +-- The @\"counter\"@ string is a unique 'Key' that identifies the 'Component' at runtime. These keys are very important when +-- diffing two 'Component' together. When intentionally replacing 'Component' it is important +-- to specify a new 'Key', otherwise the 'Component' will not be unmounted. +-- +-- It is possible to mount a component using the 'mount_' function, which avoids specifying a 'key_', but this should only be used +-- when the user is certain they will not be diffing their 'Component' with another 'Component'. When in doubt, use the ('+>') combinator +-- and 'key_' your 'Component'. +-- +-- == Lifecycle hooks +-- +-- 'Component's are mounted during diffing. All t'Component' are equipped with 'Miso.Types.mount' and 'Miso.Types.unmount' hooks, allowing custom actions to be dispatched in response to lifecycle events. +-- +-- * 'Miso.Types.mount' +-- * 'Miso.Types.unmount' +-- +-- = 'VNode' (Element nodes) +-- +-- A 'VNode' represents a [DOM element node](https://developer.mozilla.org/en-US/docs/Web/API/Element) β€” the most common kind of virtual DOM node. +-- It carries a 'Namespace', a tag name, a list of 'Attribute' values, and a list of child 'View' nodes: +-- +-- @ +-- 'VNode' 'HTML' "div" [ 'Miso.Html.Property.id_' "container" ] [ "Hello, world!" ] +-- @ +-- +-- In practice you will rarely construct 'VNode' directly. Instead use the element smart constructors +-- from "Miso.Html.Element", which fix the namespace and tag for you: +-- +-- @ +-- 'Miso.Html.Element.div_' [ 'Miso.Html.Property.id_' "container" ] [ "Hello, world!" ] +-- 'Miso.Html.Element.button_' [ 'Miso.Html.Event.onClick' DoSomething ] [ "Click me" ] +-- 'Miso.Html.Element.h1_' [ 'Miso.Html.Property.className' "title" ] [ 'text' ('Miso.String.ms' pageTitle) ] +-- @ +-- +-- For elements not covered by "Miso.Html.Element", use 'node' (or its synonym 'vnode') directly: +-- +-- @ +-- 'node' 'HTML' "details" [] [ 'node' 'HTML' "summary" [] [ "More info" ] ] +-- @ +-- +-- SVG and MathML elements use the 'SVG' and 'MATHML' namespaces respectively, +-- and are covered by the smart constructors in "Miso.Svg.Element" and "Miso.Mathml.Element". +-- +-- Unlike 'VComp' and 'VFrag', 'VNode' has a one-to-one correspondence with a physical DOM element: +-- each 'VNode' in the virtual DOM maps to exactly one element in the browser. +-- +-- The smart constructors for 'VNode' are: +-- +-- * 'node' β€” raw constructor, takes 'Namespace', tag, attributes, children +-- * 'vnode' β€” synonym for 'node' +-- * All combinators in "Miso.Html.Element", "Miso.Svg.Element", "Miso.Mathml.Element" +-- +-- == Lifecycle hooks +-- +-- Like t'Component', 'VNode' elements expose lifecycle hooks. +-- +-- * 'Miso.Event.onBeforeCreated' +-- * 'Miso.Event.onCreated' / 'Miso.Event.onCreatedWith' +-- * 'Miso.Event.onBeforeDestroyed' / 'Miso.Event.onBeforeDestroyedWith' +-- * 'Miso.Event.onDestroyed' +-- +-- These are useful for initializing and tearing down third-party libraries, as in the example below using [highlight.js](https://highlightjs.org/) +-- +-- @ +-- {-# LANGUAGE QuasiQuotes -#} +-- {-# LANGUAGE MultilineStrings -#} +-- +-- import "Miso" +-- import "Miso.FFI.QQ" ('Miso.FFI.QQ.js') +-- +-- data Action = Highlight t'Miso.Effect.DOMRef' +-- +-- update :: Action -> 'Effect' parent props model Action +-- update = \\case +-- Highlight domRef -> 'io_' $ do +-- ['Miso.FFI.QQ.js'| hljs.highlight(${domRef}) |] +-- +-- view :: props -> model -> 'View' model Action +-- view _ x = +-- 'Miso.Html.Element.code_' +-- [ 'onCreatedWith' Highlight +-- ] +-- [ """ +-- function addOne (x) { return x + 1; } +-- """ +-- ] +-- @ +-- +-- As a convention, the @*with@ variant of 'VNode' lifecycle hooks (e.g. 'Miso.Event.onCreatedWith') provides the target 'DOMRef' in the callback. +-- +-- = 'VText' (Text nodes) +-- +-- A 'VText' node represents a [DOM text node](https://developer.mozilla.org/en-US/docs/Web/API/Text). +-- Unlike 'VComp' and 'VFrag', 'VText' has a one-to-one correspondence with a physical DOM node: +-- each 'VText' in the virtual DOM maps to exactly one @Text@ node in the browser. +-- +-- The simplest way to produce a 'VText' is via the 'IsString' instance on @'View' model action@. +-- String literals inside a child list are automatically promoted to 'VText' nodes without +-- any extra imports: +-- +-- @ +-- 'Miso.Html.Element.Miso.Html.Element.div_' [] [ "Hello, world!" ] +-- @ +-- +-- For dynamic content, use the 'text' smart constructor with a 'MisoString': +-- +-- @ +-- 'Miso.Html.Element.div_' [] [ 'text' ('ms' userName) ] +-- @ +-- +-- == HTML Encoding +-- +-- When compiling with the @ssr@ flag (server-side rendering), 'text' automatically +-- HTML-encodes its argument β€” @\<@, @\>@, @&@, @\"@, and @\'@ are replaced with their +-- respective HTML entities. This prevents accidental XSS when rendering user-supplied +-- strings on the server. +-- +-- @ +-- -- SSR output: <b>bold<\/b> +-- 'text' "\bold\<\/b\>" +-- @ +-- +-- To embed pre-rendered or trusted content without escaping, use 'textRaw'. It is a +-- no-op on the client and bypasses encoding on the server: +-- +-- @ +-- 'textRaw' "\bold\<\/b\>" -- server and client: \bold\<\/b\> +-- @ +-- +-- == Concatenating Multiple Strings +-- +-- 'text_' accepts a list of 'MisoString' values and joins them with a single space, +-- which is useful when building text from multiple pieces without manual concatenation: +-- +-- @ +-- -- Renders: Hello world +-- 'Miso.Html.Element.div_' [] [ 'text_' [ \"Hello\", \"world\" ] ] +-- @ +-- +-- == Keyed Text Nodes +-- +-- A 'VText' may optionally carry a 'Key'. Keyed text nodes participate in the same +-- reconciliation algorithm as keyed 'VNode' and 'VFrag' nodes. Providing a stable key +-- lets the differ identify the node across renders, preventing unnecessary DOM text node +-- replacement when sibling order changes. +-- +-- @ +-- 'Miso.Html.Element.ul_' [] (renderItem '<$>' items) +-- +-- data Item = Item { itemId, itemLabel :: 'MisoString' } +-- +-- renderItem :: Item -> 'View' model Action +-- renderItem item = 'Miso.Html.Element.li_' [] [ 'textKey' (itemId item) (itemLabel item) ] +-- @ +-- +-- 'keyed' can also attach a key to any existing 'View', including a 'VText' produced +-- by a string literal or 'text': +-- +-- @ +-- 'keyed' "greeting" ("Hello!" :: 'View' model action) +-- @ +-- +-- The smart constructors for 'VText' are: +-- +-- * 'text' β€” single string, HTML-encoded on the server +-- * 'vtext' β€” synonym for 'text' +-- * 'textRaw' β€” single string, never HTML-encoded +-- * 'text_' β€” list of strings joined with a space +-- * 'textKey' β€” single keyed string +-- * 'textKey_' β€” list of keyed strings joined with a space +-- * 'keyed' β€” attach a key to any 'View', including 'VText' +-- +-- = 'VFrag' (Fragment nodes) +-- +-- 'VFrag' groups sibling nodes without a wrapper element in the DOM, analogous to the [React Fragment](https://react.dev/reference/react/Fragment) API (@\<\>\<\/\>@) and the browser's @DocumentFragment@. +-- +-- @ +-- -- Renders two \ elements as direct siblings, no enclosing element +-- 'fragment' [ 'Miso.Html.Element.li_' [] [ 'text' "Item A" ], 'Miso.Html.Element.li_' [] [ 'text' "Item B" ] ] +-- @ +-- +-- A 'VFrag' may optionally carry a 'Key'. Keyed fragments participate in the same +-- reconciliation algorithm as keyed 'VNode' and 'VText' nodes, allowing the virtual +-- DOM differ to identify, reorder, and reuse groups of siblings efficiently. +-- +-- @ +-- -- Keyed fragment β€” survives reordering without full teardown\/remount +-- 'vfrag_' "my-key" [ 'Miso.Html.Element.li_' [] [ 'text' "Item A" ], 'Miso.Html.Element.li_' [] [ 'text' "Item B" ] ] +-- @ +-- +-- Fragments may be nested β€” a 'VFrag' child may itself be a 'VFrag'. The diff function +-- recurses into nested fragments and processes all fragments as if they were +-- a flat sequence of sibling DOM nodes, so nesting carries no runtime cost beyond the extra 'VFrag' constructor allocation. +-- +-- Empty fragments (@'fragment' []@) in child nodes are erased from the virtual DOM tree in the +-- Haskell layer before they reach diffing in JavaScript and are therefore a no-op. +-- +-- The smart constructors for 'VFrag' are: +-- +-- * 'fragment' β€” unkeyed fragment +-- * 'vfrag' β€” unkeyed fragment (alias) +-- * 'fragment_' β€” keyed fragment +-- * 'vfrag_' β€” keyed fragment (alias, infix-friendly: @\"key\" \`vfrag_\` [...]@) +-- +-- = 'Key' +-- +-- A 'Key' is a unique identifier used to optimize diffing. +-- +-- Virtual DOM nodes can be \"keyed\" (See 'key_'). Keys have multiple meanings in @miso@ (and react). +-- +-- * Keys are used to optimize child node list diffing. +-- +-- When two lists of elements are being diffed, as long as they all have unique keys, diffing large child lists will be much faster. This optimization automatically occurs when all the elements in a 'VNode' child list contain unique keys. Unless all 'View' nodes in a child list are keyed, this optimization will not fire. +-- +-- * Keys are used to compare two identical nodes. +-- +-- If two `VNode` are being compared (or two `VComp`) and their keys differ, the old node will be destroyed and a new one created. Otherwise, the underlying DOM node won't be removed, but its properties will be diffed. In the case of diffing two t'Component' (the 'VComp' case), if the keys differ, the 'unmount' phase will be triggered for the old 'VComp' and the 'mount' phase will be triggered for the new 'Component'. The underlying DOM reference will be replaced. +-- +-- See the 'key_' property for usage (and smart constructors like 'textKey_' and ('+>') as well). +-- +-- @ +-- 'Miso.Html.Element.ul_' +-- [] +-- [ 'Miso.Html.Element.li_' [ 'key_' "key-1" ] [ "a" ] +-- , 'Miso.Html.Element.li_' [ 'key_' "key-2" ] [ "b" ] +-- , "key-3" '+>' counter +-- , 'textKey' "key-4" "text here" +-- , 'vfrag_' "key-5" [ "foo", "bar" ] +-- ] +-- @ +-- +-- = 'Events' +-- +-- * Event Delegation +-- +-- By default all events are delegated through @\@. Miso supports both @capture@ and @bubble@ phases of browser events. +-- Users can handle both phases in their applications. +-- +-- * Using events +-- +-- Miso exposes a 'defaultEvents' for convenience, these events are commonly used events and listened for on @\@. They get routed through the 'View' to the virtual DOM node that raised the event. Other 'Events' are exposed as conveniences (e.g. 'touchEvents'). All events required by all 'Component' must be combined together for use when running your application (e.g. @keyboardEvents <> touchEvents@). +-- +-- @ +-- 'touchEvents' :: 'Events' +-- 'touchEvents' = M.'Data.Map.fromList' +-- [ ("touchstart", 'BUBBLE') +-- , ("touchcancel", 'BUBBLE') +-- , ("touchmove", 'BUBBLE') +-- , ("touchend", 'BUBBLE') +-- ] +-- @ +-- +-- * Defining event handlers +-- +-- Users can define their own event handlers using the 'Miso.Event.on' combinator. By default this will define an event in the 'Miso.Event.Types.BUBBLE' phase. See 'Miso.Event.onCapture' for handling events during the 'Miso.Event.Types.CAPTURE' phase. See the module "Miso.Html.Event" for many predefined events. +-- +-- @ +-- 'onChangeWith' :: ('MisoString' -> 'DOMRef' -> action) -> 'Attribute' action +-- 'onChangeWith' = 'on' "change" 'valueDecoder' +-- @ +-- +-- The @*with@ variant of events (e.g. 'Miso.Event.onChangeWith') provides the target 'DOMRef' in the callback function. +-- +-- * Decoding events +-- +-- After an event has been raised, one can extract information from the event for use in their application. This is accomplished through a 'Decoder'. Many common decoders are available for use in "Miso.Event.Decoder". +-- +-- @ +-- data 'Decoder' a +-- = 'Decoder' +-- { 'decoder' :: 'Miso.JSON.Value' -> 'Miso.Util.Parser.Parser' a +-- , 'decodeAt' :: 'DecodeTarget' +-- } +-- +-- -- | Example of a custom 'Decoder' for the @value@ property of an event target. +-- 'valueDecoder' :: 'Decoder' 'MisoString' +-- 'valueDecoder' = 'Decoder' {..} +-- where +-- 'Miso.Event.decodeAt' = 'Miso.Event.DecodeTarget' ["target"] +-- 'Miso.Event.decoder' = 'Miso.JSON.withObject' "target" $ \\o -> o 'Miso.JSON..:' "value" +-- @ +-- +-- = Attributes / Properties +-- +-- The 'Attribute' type carries everything that can be attached to a DOM element: +-- +-- @ +-- data 'Attribute' action +-- = 'Property' 'MisoString' 'Miso.JSON.Value' -- ^ DOM property (key/value) +-- | 'ClassList' ['MisoString'] -- ^ 'CSS' class list +-- | 'On' ('Sink' action -> ...) -- ^ Event handler +-- | 'Styles' ('Data.Map.Strict.Map' 'MisoString' 'MisoString') -- ^ Inline style map +-- @ +-- +-- In practice you never construct these directly. Use the smart constructors from +-- "Miso.Html.Property", "Miso.Html.Event", "Miso.Property", and "Miso.CSS": +-- +-- @ +-- 'Miso.Html.Element.div_' +-- [ 'Miso.Html.Property.id_' "container" -- 'textProp' "id" +-- , 'Miso.Html.Property.className' "card active" -- 'textProp' "class" +-- , 'Miso.Html.Property.classList' ["card", "active"] -- 'ClassList' +-- , 'Miso.Html.Property.disabled_' -- 'boolProp' "disabled" 'True' +-- , 'Miso.Html.Event.onClick' MyAction -- 'On' event handler +-- , 'Miso.CSS.style_' [ 'Miso.CSS.display' "flex" ] -- 'Styles' map +-- ] +-- [] +-- @ +-- +-- == Custom properties +-- +-- Use 'prop' (or the typed variants 'textProp', 'boolProp', 'intProp', 'doubleProp', +-- 'objectProp') from "Miso.Property" to set arbitrary DOM properties: +-- +-- @ +-- 'prop' "data-index" (42 :: 'Int') -- sets element.data-index = 42 +-- 'textProp' "placeholder" "Search…" -- sets element.placeholder +-- 'boolProp' "checked" True -- sets element.checked = true +-- @ +-- +-- Note that DOM /properties/ and HTML /attributes/ are distinct. Miso tries to set +-- properties on the DOM node object (e.g. @node.checked@) first, then falls back to setting +-- the HTML attribute (e.g. @setAttribute("checked", ...)@). This matches what +-- the browser actually exposes in JavaScript and avoids common pitfalls with +-- boolean attributes. +-- +-- == Keys +-- +-- 'key_' (and its alias 'keyProp') attaches a reconciliation key to any element. +-- See the @'Key'@ section for details. +-- +-- @ +-- +-- data Item = Item { itemId, itemLabel :: 'MisoString' } +-- +-- 'Miso.Html.Element.li_' [ 'key_' (itemId item) ] [ 'text' (itemLabel item) ] +-- @ +-- +-- = 'Effect' +-- +-- The 'Effect' type is used to mutate the @model@ over time in response to @action@. +-- 'Effect' also allows 'IO' to be scheduled for evaluation by the @miso@ scheduler. +-- +-- Note: 'IO' is never evaluated inside of 'Effect', it is only scheduled. +-- There is no 'MonadIO' instance for 'Effect'. +-- +-- The 'Effect' type is defined as a 'Control.Monad.RWS.RWS'. +-- +-- @ +-- type 'Effect' parent props model action = 'Control.Monad.RWS.RWS' ('ComponentInfo' parent props) ['Schedule' action] model () +-- @ +-- +-- * The 'Control.Monad.Reader' portion of 'Effect' is 'ComponentInfo'. 'ask', 'asks', 'Miso.Lens.view' can be used to access its fields. +-- * The 'Control.Monad.Writer' portion of 'Effect' is used to schedule t'IO' actions. 'tell' can be used to create a 'Schedule' for an 'IO' action that is executed according to 'Synchronicity'. See also 'withSink' for usage. +-- * The 'Control.Monad.State' portion of 'Effect' is used to manipulate the @model@. 'get', 'put', 'modify', and the 'Control.Monad.State.MonadState' lenses in t'Miso.Lens.Lens' can be used to modify the @model@. +-- +-- 'IO' can be performed either synchronously or asynchronously. By default all 'IO' is asynchronous +-- +-- == Asynchronous 'IO' +-- +-- * 'io': Used to introduce asynchronous 'io' into the system, see also the 'io_' variant. +-- +-- * 'withSink': The core function (from which most other combinators are defined) +-- that gives users access to the underlying event 'Sink'. This also allows us to +-- introduce 'IO' into the system. The @miso@ scheduler attaches exception +-- handlers to all 'IO' actions. +-- +-- * For maximum flexibility, the 'MonadWriter' instance ('tell') can be used to schedule 'IO' (see the 'withSink' implementation). +-- +-- == Synchronous 'IO' +-- +-- * 'sync': Forces the scheduler to evaluate 'IO' synchronously. It is +-- recommended to use the 'io' function by default, 'sync' *will* block the scheduler. +-- +-- == 'Sink' +-- +-- @ +-- type 'Sink' action = action -> 'IO' () +-- @ +-- +-- The 'Sink' function allows one to write any @action@ to the global event queue. See 'withSink' for more information. +-- +-- == Managing 'model' state. +-- +-- Any 'MonadState' function is allowed for use when manipulating @model@, 'Miso.State.get', 'Miso.State.put', etc. See "Miso.State". +-- +-- The 'MonadReader' instances allows the retrieval of 'ComponentInfo' within 'Effect'. +-- 'ComponentInfo' provides the current 'ComponentId' the @parent@ 'ComponentId', and the 'DOMRef' ('_componentDOMRef') that the 'Component' is mounted on. +-- +-- = 'Component' communication +-- +-- Miso provides three mechanisms for 'Component' to exchange data: +-- +-- * __Props__ β€” synchronous, parent-to-child read-only data passed at mount time (see below). +-- * __Async mailbox__ β€” message-passing via 'mail', 'broadcast', 'checkMail'; any 'Component' can send a t'Miso.JSON.Value' to any other by 'ComponentId'. +-- * __PubSub__ ("Miso.PubSub") β€” publish\/subscribe for fan-out messaging across unrelated 'Component'. +-- +-- == Props +-- +-- Inspired by [React props](https://react.dev/learn/passing-props-to-a-component), +-- @miso@ allows a parent 'Component' to pass read-only data down to a child 'Component' +-- via a mechanism called /props/ (short for /properties/). +-- +-- === Props vs. Component-local state +-- +-- * __model__: Component-local state. It is owned and mutated exclusively by the 'Component' +-- itself through its 'Miso.Types.update' function. No other 'Component' can write to it directly. +-- +-- * __props__: Data /inherited/ from the @parent@ 'Component'. Props flow downward through +-- the component hierarchy and are read-only from the child's perspective. The parent decides +-- what props to pass at mount time; the child cannot mutate them. Props that change in a +-- the parent cause the child to re-render. +-- +-- This mirrors the distinction in React between component state (@useState@) and props +-- received from above (@function MyComponent({ name }) { ... }@). +-- +-- ==== When to use props +-- +-- Props are best suited for /metadata/ β€” contextual or configuration data that the child needs +-- to know about but should not own. Good examples: a user's display name, a theme token, a +-- locale string, or a read-only identifier used to customise rendering. +-- +-- If the data drives the child's own business logic β€” counters it increments, form fields it +-- edits, async state it manages β€” that data belongs in the child's @model@ instead. Putting +-- mutable business-logic state in @props@ would require the parent to own and thread through +-- every change, creating unnecessary coupling. Prefer @props@ for \"what the child should +-- know\" and @model@ for \"what the child should do\". +-- +-- === Props in 'Miso.Types.view' +-- +-- The 'Miso.Types.view' field of a 'Component' always takes @props@ as its first argument: +-- +-- @ +-- view :: props -> model -> 'View' model action +-- @ +-- +-- Top-level applications have no parent, so @props@ is always @()@: +-- +-- @ +-- view :: () -> model -> 'View' model action +-- view _props model = … +-- @ +-- +-- === Props in 'Effect' \/ 'Miso.Types.update' +-- +-- Use 'getProps' inside the 'Effect' monad to read the current value of @props@: +-- +-- @ +-- update :: Action -> 'Effect' parent props Model Action +-- update = \\case +-- SomeAction -> do +-- p <- 'getProps' +-- 'io_' ('consoleLog' (ms (show p))) +-- @ +-- +-- Alternatively, use the 'Miso.Lens.view' combinator with the 'props' lens: +-- +-- @ +-- update = \\case +-- SomeAction -> do +-- p <- 'Miso.Lens.view' 'props' +-- … +-- @ +-- +-- === 'ROOT' β€” the top-level 'Component' +-- +-- When a 'Component' is passed to 'startApp' (or 'miso') it has no parent. +-- The @parent@ type is specialized to 'ROOT' and @props@ is fixed to @()@: +-- +-- @ +-- type 'App' model action = 'Component' 'ROOT' () model action +-- @ +-- +-- Because there is no parent to inherit from, @props@ will always be @()@ for a +-- root-level 'Component'. You can simply ignore the first argument in 'view' and +-- skip 'getProps' in 'Miso.Types.update'. +-- +-- === Passing props to a child 'Component' +-- +-- Use 'mountWithProps_' (keyed) or 'mountWithProps' (unkeyed) in the parent's 'view' to +-- mount a child and supply its props: +-- +-- @ +-- 'mountWithProps_' +-- :: ('Eq' child, 'Eq' props) +-- => 'MisoString' +-- -> props +-- -> 'Component' parent props child action +-- -> 'View' parent a +-- @ +-- +-- === Example: child reading parent-supplied props +-- +-- The following shows a parent 'Component' that maintains a greeting string in its +-- @model@ and passes it as @props@ to a child 'Component'. The child renders the +-- greeting and can also read it from within its 'Miso.Types.update' function. +-- +-- @ +-- ----------------------------------------------------------------------------- +-- -- The props type: what the parent shares with the child +-- newtype Greeting = Greeting 'MisoString' deriving ('Eq') +-- ----------------------------------------------------------------------------- +-- -- Child component +-- -- +-- -- parent props model action +-- -- | | | | +-- child :: 'Component' ParentModel Greeting () ChildAction +-- child = 'vcomp' () updateChild viewChild +-- where +-- viewChild :: Greeting -> () -> 'View' () ChildAction +-- viewChild (Greeting g) _ = +-- 'Miso.Html.Element.div_' [] [ 'text' ("Hello, " <> g <> "!") ] +-- +-- updateChild :: ChildAction -> 'Effect' ParentModel Greeting () ChildAction +-- updateChild = \\case +-- ReadGreeting -> do +-- Greeting g <- 'getProps' +-- 'io_' ('consoleLog' g) +-- ----------------------------------------------------------------------------- +-- -- Parent component: owns the greeting, passes it to the child as props +-- parent :: 'App' ParentModel ParentAction +-- parent = 'vcomp' (ParentModel \"World\") 'noop' viewParent +-- where +-- viewParent :: () -> ParentModel -> 'View' ParentModel ParentAction +-- viewParent _ (ParentModel g) = 'mountWithProps_' "child" (Greeting g) child +-- ----------------------------------------------------------------------------- +-- newtype ParentModel = ParentModel 'MisoString' deriving ('Eq') +-- +-- data ChildAction = ReadGreeting +-- data ParentAction +-- @ +-- +-- A few things to notice: +-- +-- * The child's @parent@ type parameter is @ParentModel@. This must match the +-- parent 'Component' @model@ type β€” 'mountWithProps_' enforces this at compile time. +-- * 'getProps' inside the child's 'Miso.Types.update' yields a @Greeting@, not +-- the full @ParentModel@. The child only sees what the parent explicitly chose to share. +-- * The root 'App' always has @props ~ ()@; no extra plumbing is needed when calling 'startApp'. +-- +-- +-- == Asynchronous communication +-- +-- Every 'Component' has a 'mailbox' β€” a slot that receives t'Miso.JSON.Value' messages +-- sent by other components. Messages are dispatched asynchronously via the event queue. +-- +-- === Sending +-- +-- * 'mail' @componentId msg@ β€” send to a specific 'ComponentId' (obtained via 'ask' inside 'Effect') +-- * 'mailParent' @msg@ β€” send to the direct parent +-- * 'mailChildren' @msg@ β€” send to all immediate children +-- * 'mailAncestors' @msg@ β€” walk up the hierarchy, delivering to every ancestor +-- * 'mailDescendants' @msg@ β€” walk down the hierarchy, delivering to every descendant +-- * 'broadcast' @msg@ β€” deliver to every mounted 'Component' except the sender +-- +-- === Receiving with 'checkMail' +-- +-- Wire up the 'mailbox' field on 'Component' using 'checkMail', which handles +-- JSON parsing and routes to success\/error actions: +-- +-- @ +-- data Action +-- = ReceivedMsg MyMsg +-- | MailError t'Miso.String.MisoString' +-- +-- myComp :: 'Component' parent props model Action +-- myComp = ('vcomp' m u v) { 'mailbox' = 'checkMail' ReceivedMsg MailError } +-- @ +-- +-- === Looking up a 'ComponentId' +-- +-- Inside 'Effect', use 'ask' to obtain a t'ComponentInfo': +-- +-- @ +-- update = \\case +-- SendMsg targetId -> do +-- 'io_' ('mail' targetId ("hello" :: 'MisoString')) +-- GetMyId -> do +-- info <- 'ask' +-- let myId = '_componentInfoId' info +-- ... +-- @ +-- +-- * "Miso.PubSub" β€” publish\/subscribe pattern for fan-out messaging across unrelated components. +-- +-- == Synchronous communication +-- +-- * "Miso.Binding" +-- +-- Experimental support for data bindings (where 'Component' model can synchronize fields via a 'Miso.Lens.Lens' in response to model differences along the parent-child relationship). See the "Miso.Binding" module for more information, and the [miso-reactive](https://github.com/haskell-miso/miso-reactive) example. *Warning*: This is still considered experimental. +-- +-- == Parent access +-- +-- * 'parent' +-- +-- While not direct communication, a 'Component' can asynchronously receive read-only access to its @parent@ state via the 'parent' function. +-- +-- = Subscriptions +-- +-- A t'Sub' is any long-running operation that is external to a 'Component', but that can write +-- to a 'Component' 'Sink'. 'Sub' come in two flavors, a dynamic 'Sub' (via 'startSub' / 'stopSub') and 'subs'. +-- +-- * 'subs' +-- +-- @ +-- main :: t'IO' () +-- main = 'startApp' 'defaultEvents' app { 'subs' = [ timerSub ] } +-- +-- timerSub :: 'Sub' Action +-- timerSub sink = 'Control.Monad.forever' $ ('Control.Concurrent.threadDelay' 100000) >> sink Log +-- +-- data Action = Log +-- @ +-- +-- The 'subs' field of 'Component' contains 'Sub' that exist for the lifetime of that 'Component'. +-- When a 'Component' unmounts, these 'Sub' will be stopped, and their resources finalized. +-- +-- @ +-- 'onLineSub' :: ('Bool' -> action) -> 'Sub' action +-- 'onLineSub' f sink = 'Miso.Subscription.Util.createSub' acquire release sink +-- where +-- release (cb1, cb2) = do +-- 'Miso.FFI.windowRemoveEventListener' "online" cb1 +-- 'Miso.FFI.windowRemoveEventListener' "offline" cb2 +-- acquire = do +-- cb1 <- 'Miso.FFI.windowAddEventListener' "online" (const $ sink (f True)) +-- cb2 <- 'Miso.FFI.windowAddEventListener' "offline" (const $ sink (f False)) +-- pure (cb1, cb2) +-- @ +-- +-- * 'startSub' / 'stopSub' +-- +-- At times its necessary to dynamically generate a 'Sub' in reponse to an event (e.g. starting a "Miso.WebSocket" connection +-- when a user logs in). The 'startSub' and 'stopSub' functions facilitate dynamic 'Sub' creation / removal. +-- +-- @ +-- update = \\case +-- StartTimer -> 'startSub' ("timer" :: MisoString) timerSub +-- StopTimer -> 'stopSub' "timer" +-- Log -> 'io_' ('consoleLog' "log") +-- where +-- timerSub :: 'Sub' Action +-- timerSub sink = 'Control.Monad.forever' $ ('Control.Concurrent.threadDelay' 100000) >> sink Log +-- +-- data Action = Log +-- @ +-- +-- * 'Miso.Subscription.Util.createSub' +-- +-- 'Miso.Subscription.Util.createSub' is a helper function for creating a 'Sub' using the 'Control.Exception.bracket' pattern. +-- This ensures that event listeners can be unregistered when a 'Component' unmounts. For example usage +-- please see the "Miso.Subscription" sub modules. 'createSub' is only meant to be used in scenarios where +-- custom event listeners are required. +-- +-- = 'Control.Monad.State.State' management +-- +-- Miso bundles a lightweight lens library in "Miso.Lens" to minimise dependencies +-- and payload size. Any lens library (optics, lens) also works β€” "Miso.Lens" is not required. +-- +-- == Basic lens operations +-- +-- @ +-- 'view' l -- read a field (MonadReader) +-- 'set' l v -- write a field +-- 'over' l f -- modify a field +-- r '^.' l -- infix read +-- r '&' l '.~' v -- infix write +-- @ +-- +-- == 'MonadState' operators (for use inside 'Effect') +-- +-- @ +-- l '+=' n -- increment a numeric field +-- l '-=' n -- decrement +-- l '*=' n -- multiply +-- @ +-- +-- == 'Miso.Lens.this' β€” the identity lens +-- +-- When the model /is/ the field (e.g. the model is a plain @Int@), use 'this': +-- +-- @ +-- update = \\case +-- Increment -> 'Miso.Lens.this' 'Miso.Lens.+=' 1 +-- Decrement -> 'Miso.Lens.this' 'Miso.Lens.-=' 1 +-- @ +-- +-- == Generating lenses +-- +-- Three approaches, pick one: +-- +-- * __Template Haskell__ ("Miso.Lens.TH"): 'Miso.Lens.makeLenses' / 'Miso.Lens.makeClassy' splice lenses for each record field. +-- +-- @ +-- {-# LANGUAGE TemplateHaskell #-} +-- +-- import "Miso.Lens.TH" ('Miso.Lens.TH.makeLenses') +-- +-- data Model = Model { _count :: Int, _name :: 'MisoString' } +-- +-- 'Miso.Lens.TH.makeLenses' ''Model +-- +-- update = \\case +-- Increment -> count 'Miso.Lens.+=' 1 +-- Rename n -> name 'Miso.Lens..=' n +-- @ +-- +-- * __Generics__ ("Miso.Lens.Generic"): 'field' \/ 'HasLens' derive lenses at compile time +-- using @GHC.Generics@ β€” no TH splice required. Requires @TypeApplications@ and, +-- optionally, @OverloadedLabels@ for the @#field@ shorthand. +-- +-- @ +-- {-# LANGUAGE DataKinds #-} +-- {-# LANGUAGE DeriveGeneric #-} +-- {-# LANGUAGE OverloadedLabels #-} +-- {-# LANGUAGE TypeApplications #-} +-- +-- import GHC.Generics (Generic) +-- import "Miso.Lens.Generic" ('Miso.Lens.Generic.field') +-- +-- data Model = Model { count :: Int, name :: 'MisoString' } +-- deriving (Eq, Generic) +-- +-- update = \\case +-- Increment -> 'field' \@\"count\" 'Miso.Lens.+=' 1 -- via TypeApplications +-- Rename n -> #name '.=' n -- via OverloadedLabels +-- @ +-- +-- * __Hand-written__: construct a 'Lens' directly using 'lens' and the @'Lens' s a@ synonym. +-- +-- @ +-- name :: 'Miso.Lens.Lens' Person 'MisoString' +-- name = 'Miso.Lens.lens' _name $ \\p n -> p { _name = n } +-- @ +-- +-- = (2D/3D) Canvas support +-- +-- Miso has full 2D and 3D canvas support via "Miso.Canvas". See also the +-- [miso-canvas](https://github.com/haskell-miso/miso-canvas2d) example and the +-- [three-miso](https://github.com/haskell-miso/three-miso) package for Three.js integration. +-- +-- == The 'Miso.Canvas.Canvas' monad +-- +-- Drawing commands run in the 'Miso.Canvas.Canvas' monad, which is a 'Control.Monad.Reader.ReaderT' over a +-- 'Miso.Canvas.CanvasContext2D' (the raw JavaScript 'Miso.Canvas.CanvasContext2D'): +-- +-- @ +-- type t'Miso.Canvas.Canvas' a = 'Control.Monad.Reader.ReaderT' 'Miso.Canvas.CanvasContext2D' 'IO' a +-- @ +-- +-- == Embedding a canvas in the 'view' +-- +-- Use the 'Miso.Canvas.canvas' smart constructor. +-- It takes an /init/ callback (runs once on mount, returns state) and a +-- /draw/ callback (runs on every render with the current state): +-- +-- @ +-- 'Miso.Canvas.canvas' +-- [ HP.'Miso.Html.Property.width_' "800", HP.'Miso.Html.Property.height_' "480" ] +-- (\\_ -> pure ()) -- init: called once on canvas initialization +-- (\\() -> drawScene myModel) -- draw: called many times, on each 'Miso.Diff.diff'. +-- @ +-- +-- 'Miso.Canvas.canvas_' is the variant that threads no init state at all (always passes @()@). +-- +-- == Drawing commands +-- +-- Common 2D primitives: +-- +-- @ +-- drawScene :: Model -> 'Miso.Canvas.Canvas' () +-- drawScene model = do +-- 'Miso.Canvas.clearRect' (0, 0, 800, 480) +-- 'Miso.Canvas.fillStyle' ('Miso.CSS.Color.RGB' 30 144 255) +-- 'Miso.Canvas.beginPath' () +-- 'Miso.Canvas.arc' (400, 240, 50, 0, 2 * pi) +-- 'Miso.Canvas.fill' () +-- 'Miso.Canvas.font' "24px sans-serif" +-- 'Miso.Canvas.fillText' ("Score: " \<\> ms (score model), 10, 30) +-- @ +-- +-- Available primitives include: 'Miso.Canvas.clearRect', 'Miso.Canvas.fillRect', 'Miso.Canvas.strokeRect', +-- 'Miso.Canvas.beginPath', 'Miso.Canvas.closePath', 'Miso.Canvas.moveTo', 'Miso.Canvas.lineTo', +-- 'Miso.Canvas.arc', 'Miso.Canvas.arcTo', 'Miso.Canvas.fill', 'Miso.Canvas.stroke', +-- 'Miso.Canvas.fillText', 'Miso.Canvas.drawImage'. +-- +-- Style setters: 'Miso.Canvas.fillStyle', 'Miso.Canvas.strokeStyle', 'Miso.Canvas.lineWidth', 'Miso.Canvas.font'. +-- 'Miso.Canvas.fillStyle' and 'Miso.Canvas.strokeStyle' accept a 'Miso.Canvas.StyleArg' β€” use +-- 'Miso.Canvas.color' (not 'Miso.CSS.color') to construct one from a t'Miso.CSS.Color.Color' value. +-- See the __Canonical Import Pattern__ section for how to avoid the name collision +-- between 'Miso.Canvas.color' and 'Miso.CSS.color'. +-- +-- == Animation loop +-- +-- For smooth 60 FPS canvas animations, use 'Miso.Subscription.RAF.rAFSub' from +-- "Miso.Subscription.RAF" instead of a manual 'threadDelay' loop. +-- It hooks into the browser's @requestAnimationFrame@ API and delivers a +-- [DOMHighResTimeStamp](https://developer.mozilla.org/en-US/docs/Web/API/DOMHighResTimeStamp) +-- (milliseconds) on each frame: +-- +-- @ +-- data Action = Tick 'Double' +-- +-- main :: IO () +-- main = 'startApp' 'defaultEvents' comp { 'subs' = [ 'Miso.Subscription.RAF.rAFSub' Tick ] } +-- @ +-- +-- = HTML +-- +-- Miso's 'View' type doubles as an HTML serialiser via the 'ToHtml' class in +-- "Miso.Html.Render". This is used for server-side rendering (SSR): build a +-- 'View' with the normal DSL and render it to a lazy 'Data.ByteString.Lazy.ByteString' +-- on the server. +-- +-- @ +-- class 'Miso.Html.ToHtml' a where +-- 'Miso.Html.ToHtml.toHtml' :: a -> 'Data.ByteString.Lazy.ByteString' +-- @ +-- +-- Instances are provided for @'View' m a@ and @['View' m a]@: +-- +-- @ +-- import "Miso.Html.Render" ('Miso.Html.Render.toHtml') +-- +-- pageHtml :: 'Data.ByteString.Lazy.ByteString' +-- pageHtml = 'toHtml' $ 'Miso.Html.Element.div_' [ 'Miso.Html.Property.id_' "root" ] [ "Hello, world!" ] +-- @ +-- +-- This is typically wired into a Servant handler on the server using the +-- [servant-miso-html](https://github.com/haskell-miso/servant-miso-html) package, +-- which provides an @HTML@ content-type that serialises 'View' and 'Component' +-- values directly β€” no manual 'ByteString' conversion needed: +-- +-- @ +-- import Servant.Miso.Html (HTML) +-- +-- type Home = \"home\" :\> Get '[HTML] ('Component' model action) +-- type About = \"about\" :\> Get '[HTML] ('View' model action) +-- type Contact = \"contact\" :\> Get '[HTML] ['View' model action] +-- type API = Home :\<|\> About :\<|\> Contact +-- @ +-- +-- On the client, pass the matching 'Component' to 'miso' (instead of 'startApp') +-- so it hydrates the server-rendered markup rather than redrawing from scratch. +-- See the __Prerendering__ section for the full flow. +-- +-- = JavaScript EDSL +-- +-- "Miso.DSL" provides a JavaScript DSL inspired by [jsaddle](https://hackage.haskell.org/package/jsaddle) +-- for interacting with the browser from Haskell. +-- +-- == Key operators +-- +-- * '(Miso.DSL.!)' β€” property access: @obj '!' "key"@ reads @obj.key@ +-- * '(Miso.DSL.#)' β€” method call: @obj '#' "method" args@ calls @obj.method(args)@ +-- * 'Miso.DSL.jsg' β€” access a global JS variable by name +-- * 'Miso.DSL.jsgf' β€” call a global JS function by name with arguments +-- +-- @ +-- -- Read document.body.children.length +-- document <- 'Miso.DSL.jsg' "document" +-- len :: 'Int' <- 'Miso.DSL.fromJSValUnchecked' =<< (document 'Miso.DSL.!' "body" 'Miso.DSL.!' "children" 'Miso.DSL.!' "length") +-- +-- -- Call console.log("hello") +-- console <- 'Miso.DSL.jsg' "console" +-- console 'Miso.DSL.#' "log" $ ["hello" :: 'MisoString'] +-- @ +-- +-- == Marshalling +-- +-- 'Miso.DSL.ToJSVal' converts Haskell values to 'Miso.DSL.JSVal' for passing into JavaScript. +-- 'Miso.DSL.FromJSVal' converts 'Miso.DSL.JSVal' back to Haskell. +-- 'Miso.DSL.fromJSValUnchecked' throws on failure; use 'Miso.DSL.fromJSVal' for a safe @Maybe@ variant. +-- +-- = QuasiQuotation (@inline-js@) +-- +-- "Miso.FFI.QQ" provides the 'Miso.FFI.QQ.js' QuasiQuoter for embedding inline JavaScript +-- directly in Haskell source. Any Haskell binding in scope can be interpolated into +-- the JavaScript body with @${varName}@ syntax β€” miso uses the binding's 'Miso.DSL.ToJSVal' +-- instance to marshal it across the boundary at runtime. +-- +-- @ +-- {-# LANGUAGE QuasiQuotes #-} +-- +-- import "Miso.FFI.QQ" ('Miso.FFI.QQ.js') +-- +-- update :: Action -> 'Miso.Effect.Effect' parent props model Action +-- update = \\case +-- Log msg -> 'io_' ['Miso.FFI.QQ.js'| console.log(${msg}) |] +-- +-- data Action = Log 'MisoString' +-- @ +-- +-- == Returning values from JavaScript +-- +-- The return type is inferred from the call site via 'Miso.DSL.FromJSVal'. +-- Use an explicit type annotation or a @do@-binding to drive inference: +-- +-- @ +-- factorial :: 'Int' -> IO 'Int' +-- factorial n = ['Miso.FFI.QQ.js'| +-- let x = 1; +-- for (let i = 1; i <= ${n}; i++) { x *= i; } +-- return x; +-- |] +-- @ +-- +-- Haskell variables referenced inside the quoter must be in scope at the splice +-- site; the compiler will report an error if a @${name}@ has no corresponding binding. +-- +-- = Routing +-- +-- "Miso.Router" provides a reversible, type-safe client-side router. A @Route@ +-- type encodes URL structure; the 'Router' class converts between routes and +-- 'URI' values in both directions. Use it with 'Miso.Subscription.History.routerSub' +-- or 'Miso.Subscription.History.uriSub' to react to browser navigation. +-- +-- == Defining a 'Router' with Generics +-- +-- Derive 'Router' via "GHC.Generics" β€” constructor names become path segments +-- (camel-case uses only the first hump). Use t'Capture', t'Path', t'QueryParam', +-- and t'QueryFlag' as constructor fields to describe the URL shape: +-- +-- @ +-- {-# LANGUAGE DeriveGeneric #-} +-- {-# LANGUAGE DeriveAnyClass #-} +-- +-- import GHC.Generics +-- import "Miso.Router" +-- +-- data Route +-- = Index -- matches "/" +-- | About -- matches "/about" +-- | Product ('Miso.Router.Capture' "id" Int) ('Miso.Router.QueryParam' "tab" 'MisoString') -- matches "/product/42?tab=info" +-- deriving stock ('Show', 'Eq', 'GHC.Generics.Generic') +-- deriving anyclass 'Miso.Router.Router' +-- @ +-- +-- The router is /reversible/ β€” 'Miso.Router.prettyRoute' re-serialises any route back to a URL: +-- +-- @ +-- 'Miso.Router.prettyRoute' (Product ('Miso.Router.Capture' 42) ('Miso.Router.QueryParam' (Just "info"))) +-- -- "\/product\/42?tab=info" +-- @ +-- +-- == Defining a 'Router' manually +-- +-- For full control, implement 'Miso.Router.routeParser' and 'Miso.Router.fromRoute' directly: +-- +-- @ +-- data Route = Product Int +-- +-- instance 'Miso.Router.Router' Route where +-- 'Miso.Router.routeParser' = 'Miso.Router.routes' [ Product \<$\> ('path' "product" *\> 'capture') ] +-- 'Miso.Router.fromRoute' (Product n) = [ 'Miso.Router.toPath' "product", 'Miso.Router.toCapture' n ] +-- @ +-- +-- == Subscribing to URI changes +-- +-- 'Miso.Subscription.History.routerSub' listens to @popstate@ events and delivers +-- the parsed route (or a 'Miso.Router.RoutingError') to your 'update' function: +-- +-- @ +-- app = ('vcomp' m u v) { 'subs' = [ 'Miso.Router.routerSub' HandleRoute ] } +-- +-- update = \\case +-- HandleRoute (Right Index) -> page 'Miso.Lens..=' HomePage +-- HandleRoute (Right About) -> page 'Miso.Lens..=' AboutPage +-- HandleRoute (Left _) -> page 'Miso.Lens..=' NotFound +-- @ +-- +-- 'Miso.Subscription.History.uriSub' is the lower-level variant β€” it delivers +-- the raw 'Miso.Router.URI' without parsing, useful when you want to handle routing yourself. +-- +-- == Navigating programmatically +-- +-- @ +-- 'Miso.Router.pushURI' uri -- push a raw 'URI' onto the History stack +-- 'Miso.Router.pushRoute' route -- push a typed route (serialised via 'Router') +-- 'Miso.Router.replaceURI' uri -- replace the current history entry +-- 'Miso.Router.back' -- go back one entry +-- 'Miso.Router.forward' -- go forward one entry +-- @ +-- +-- == Type-safe links in 'view' +-- +-- 'Miso.Router.href_' produces a type-safe @href@ attribute from any route: +-- +-- @ +-- 'Miso.Html.Element.button_' [ 'Miso.Router.href_' (Product ('Miso.Router.Capture' 10) ('Miso.Router.QueryParam' Nothing)) ] [ "Go to product 10" ] +-- @ +-- +-- = 'MisoString' +-- +-- t'MisoString' is miso's canonical string type, chosen to minimise copying between +-- the Haskell and JavaScript heaps: +-- +-- * __JS / WASM backends__: t'MisoString' is @JSString@, a direct reference to a +-- JavaScript string β€” no marshalling cost when passing to the DOM or FFI. +-- * __Server / vanilla GHC__ (@ssr@ flag): t'MisoString' is t'Data.Text'. +-- +-- Use t'MisoString' anywhere you would otherwise reach for 'String' or 'Text' in a +-- miso application. See "Miso.String" for the full API. +-- +-- == Converting to 'MisoString' +-- +-- The 'ms' function (shorthand for 'toMisoString') converts any type with a +-- 'ToMisoString' instance: +-- +-- @ +-- 'ms' "hello" -- 'String' -> 'MisoString' +-- 'ms' (42 :: 'Int') -- 'Int' -> 'MisoString' +-- 'ms' (3.14 :: 'Double') -- 'Double' -> 'MisoString' +-- 'ms' myText -- 'Data.Text.Text' -> 'MisoString' +-- @ +-- +-- 'Miso.String.ToMisoString' instances are provided for 'String', t'Data.Text.Text', +-- t'Data.Text.Lazy.Text', t'Data.ByteString.ByteString', 'Int', 'Word', +-- 'Double', 'Float', and 'Char'. +-- +-- == Converting from 'MisoString' +-- +-- 'fromMisoString' parses a t'MisoString' back into another type (throws on failure). +-- Use 'fromMisoStringEither' for a safe variant: +-- +-- @ +-- 'Miso.String.fromMisoString' "42" :: 'Int' -- 42 +-- 'Miso.String.fromMisoString' "3.14" :: 'Double' -- 3.14 +-- 'Miso.String.fromMisoStringEither' s :: Either 'String' 'Int' +-- @ +-- +-- 'Miso.String.FromMisoString' instances are provided for 'String', t'Data.Text.Text', +-- t'Data.Text.Lazy.Text', t'Data.ByteString.ByteString', 'Int', 'Word', +-- 'Double', and 'Float'. +-- +-- == Multiline literals +-- +-- "Miso.String.QQ" provides a QuasiQuoter for multiline t'MisoString' literals: +-- +-- @ +-- {-# LANGUAGE QuasiQuotes #-} +-- +-- import "Miso.String.QQ" ('Miso.String.QQ.misoString') +-- +-- snippet :: 'MisoString' +-- snippet = ['Miso.String.QQ.misoString'| +-- line one +-- line two +-- |] +-- @ +-- +-- t'MisoString' is also the element type used throughout "Miso.Util.Lexer" and +-- "Miso.Util.Parser". +-- +-- = JSON +-- +-- "Miso.JSON" is a [microaeson](https://hackage.haskell.org/package/microaeson)-inspired +-- JSON library specialised to t'MisoString'. On the JS\/WASM backends it delegates +-- encoding and decoding to the JavaScript runtime (@JSON.stringify@ \/ @JSON.parse@) +-- for performance. On the server (@ssr@ flag) it uses a pure Haskell implementation. +-- "Miso.JSON" is used internally by "Miso.Event.Decoder", "Miso.Fetch", and "Miso.WebSocket". +-- +-- == 'Miso.JSON.Value' +-- +-- The JSON t'Miso.JSON.Value' type mirrors the JSON specification: +-- +-- @ +-- data 'Miso.JSON.Value' +-- = 'Miso.JSON.Number' 'Double' +-- | 'Miso.JSON.Bool' 'Bool' +-- | 'Miso.JSON.String' 'MisoString' +-- | 'Miso.JSON.Array' ['Miso.JSON.Value'] +-- | 'Miso.JSON.Object' 'Miso.JSON.Object' +-- | 'Miso.JSON.Null' +-- @ +-- +-- == Encoding +-- +-- Encode any 'Miso.JSON.ToJSON' instance to a t'MisoString': +-- +-- @ +-- 'Miso.JSON.encode' value -- uses JS runtime on client, pure on server +-- 'Miso.JSON.encodePure' value -- always uses pure Haskell implementation +-- @ +-- +-- == Decoding +-- +-- @ +-- 'Miso.JSON.decode' s :: 'Maybe' a -- returns 'Nothing' on failure +-- 'Miso.JSON.eitherDecode' s :: Either 'MisoString' a +-- @ +-- +-- == 'Miso.JSON.ToJSON' \/ 'Miso.JSON.FromJSON' +-- +-- Derive instances via @GHC.Generics@: +-- +-- @ +-- {-# LANGUAGE DeriveGeneric #-} +-- +-- import "GHC.Generics" +-- import "Miso.JSON" +-- +-- data User = User { name :: 'MisoString', age :: 'Int' } +-- deriving ('GHC.Generics.Generic') +-- +-- instance 'Miso.JSON.ToJSON' User +-- instance 'Miso.JSON.FromJSON' User +-- @ +-- +-- Use 'Miso.JSON.genericToJSON' \/ 'Miso.JSON.genericParseJSON' with 'Options' to customise field and +-- constructor names. 'camelTo2' is provided for converting @camelCase@ to +-- @snake_case@ (or any separator): +-- +-- @ +-- instance 'Miso.JSON.ToJSON' User where +-- 'Miso.JSON.toJSON' = 'Miso.JSON.genericToJSON' 'Miso.JSON.defaultOptions' { 'Miso.JSON.fieldLabelModifier' = 'Miso.JSON.camelTo2' \'_\' } +-- @ +-- +-- == Building and Parsing Objects +-- +-- @ +-- -- Build +-- 'Miso.JSON.object' [ "name" 'Miso.JSON..=' 'ms' "Alice", "age" 'Miso.JSON..=' (30 :: Int) ] +-- +-- -- Parse (inside a 'withObject' callback or event decoder) +-- 'Miso.JSON.withObject' "User" $ \\o -> User +-- '<$>' o 'Miso.JSON..:' "name" -- required field +-- '<*>' o 'Miso.JSON..:' "age" +-- +-- o 'Miso.JSON..:?' "nickname" -- optional field β†’ Maybe a +-- o 'Miso.JSON..:!' "nickname" -- optional field, explicit null β†’ Maybe a +-- p 'Miso.JSON..!=' "anon" -- provide a default for a Maybe parser +-- @ +-- +-- == Pretty-Printing +-- +-- @ +-- 'Miso.JSON.encodePretty' value -- indented with 'Miso.JSON.defConfig' (2-space indent) +-- 'Miso.JSON.encodePretty'' config value -- indented with custom 'Miso.JSON.Config' +-- @ +-- +-- == @miso-aeson@ +-- +-- If you prefer to use the [aeson](https://hackage.haskell.org/package/aeson) library directly, +-- the [miso-aeson](https://github.com/haskell-miso/miso-aeson) package provides a compatibility +-- shim that bridges @aeson@\'s 'Data.Aeson.ToJSON' \/ 'Data.Aeson.FromJSON' instances with miso\'s +-- event decoder and fetch API, so existing @aeson@-derived instances can be used without rewriting them. +-- +-- = Styles +-- +-- Miso does not prescribe a single CSS strategy. Three approaches work out of the box: +-- +-- == 1. Structured DSL ("Miso.CSS") +-- +-- 'Miso.CSS.style_' takes a list of @'Style'@ values (which are @(MisoString, MisoString)@ pairs). +-- Miso manages individual properties on the 'DOMRef', merging and diffing them efficiently: +-- +-- @ +-- import qualified "Miso.CSS" as CSS +-- import "Miso.CSS.Color" ('Miso.CSS.Color.RGB'(..)) +-- +-- 'Miso.Html.Element.div_' +-- [ CSS.'Miso.CSS.style_' +-- [ CSS.'Miso.CSS.display' "flex" +-- , CSS.'Miso.CSS.flexDirection' "column" +-- , CSS.'Miso.CSS.backgroundColor' ('Miso.CSS.Color.RGB' 30 30 30) +-- , CSS.'Miso.CSS.color' ('Miso.CSS.Color.RGB' 255 255 255) +-- ] +-- ] +-- [] +-- @ +-- +-- Custom properties can be constructed with the '=:' operator (re-exported from "Miso.Util"): +-- +-- @ +-- "user-select" '=:' "none" +-- @ +-- +-- == 2. Inline string ('Miso.CSS.styleInline_') +-- +-- For simple or dynamic style strings, 'styleInline_' sets the element's @style@ +-- attribute as a raw string: +-- +-- @ +-- CSS.'Miso.CSS.styleInline_' "display:flex; gap:8px; padding:16px" +-- @ +-- +-- == 3. External stylesheets +-- +-- Link external CSS files from the @\@ via the 'styles' field on 'Component' +-- (see the __Development__ section), or include them in your HTML template directly. +-- This is the most common approach for production apps using Tailwind, Bootstrap, etc. +-- +-- See [miso-ui](https://ui.haskell-miso.org) for a larger example. +-- +-- = Development +-- +-- When developing miso applications interactively it is possible to append 'styles' and 'scripts' to the @\@ portion of +-- the page when the 'Component' mounts. This is a convenience only meant to be used in development. We recommend guarding the usage behind a flag. +-- +-- @ +-- main :: 'IO' () +-- main = 'startApp' 'defaultEvents' app +-- where +-- app = counter +-- #ifdef INTERACTIVE +-- { 'scripts' = [ 'Src' "https://ajax.googleapis.com/ajax/libs/jquery/3.7.1/jquery.min.js" ('False' :: 'CacheBust') ] +-- , 'styles' = [ 'Href' "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/css/bootstrap.min.css" ('False' :: 'CacheBust') ] +-- } +-- #endif +-- @ +-- +-- See the [miso-sampler](https://github.com/haskell-miso/miso-sampler) repository for more information. +-- +-- = Debugging +-- +-- Sometimes things can go wrong. Common errors like using `onClick` but not listening for the 'click' event are common. +-- These are errors that cannot be caught statically (unless we use a dependently-typed language like [Idris](https://idris-lang.org)). These can be detected by enabling 'DebugAll'. Currently, debugging event delegation and page hydration is supported. +-- +-- * 'DebugHydrate' +-- * 'DebugEvents' +-- +-- @ +-- counter { 'logLevel' = 'DebugAll' } +-- @ +-- +-- = Internals +-- +-- Internally miso uses a global event queue and a scheduler to process all +-- events raised by 'Component' throughout the lifetime of an application. +-- Events are processed in FIFO order, batched by the 'Component' that raised them. +-- +-- * __Event queue__: All actions dispatched via a 'Sink' (from event handlers, +-- subscriptions, or 'io' callbacks) are enqueued and drained by the scheduler. +-- +-- * __Scheduler__: The scheduler pulls actions off the queue one batch at a time, +-- runs the 'update' function for each, collects the resulting 'IO' work, and +-- executes it. Rendering (VDOM diff + patch) is triggered after each batch. +-- +-- * __'Waiter'__: A 'Miso.Concurrent.Waiter' is a synchronization primitive used +-- internally to coordinate the event loop β€” it blocks the scheduler thread until +-- new work arrives, avoiding busy-waiting. +-- +-- * __Event delegation__: Rather than attaching listeners to individual DOM nodes, +-- miso attaches a single capture and a single bubble listener to @\@. +-- Incoming events are routed through the virtual DOM tree to the matching handler. +-- This minimises listener churn when the VDOM is patched. +-- +-- * __VDOM diffing__: The diff algorithm in "Miso.Diff" compares old and new +-- 'View' trees and emits the minimal set of DOM mutations. Keyed children (see +-- the 'Key' section) significantly speed up child list reconciliation. +-- +-- = Prerendering +-- +-- Prerendering is the process of delivering HTML from a web server before the client loads and performs any drawing to the page. In miso it comes in two flavors, static +-- or dynamic prerendering. Static prerendering assumes no model state needs to be shared between the server and client. Dynamic uses 'hydrateModel' to share @model@ state. +-- +-- == Static prerendering +-- +-- miso provides the 'prerender' and 'miso' functions to facilitate static prerendering. Any page can be generated from a miso 'View' using the 'Miso.Html.Render.toHtml' instance. +-- +-- A simple example of static prerendering would be an @index.html@ page with some HTML +-- +-- @ +-- echo "\\\<\/head\>\hello world\<\/body\>\" > index.html +-- @ +-- +-- And a miso application that looks like: +-- +-- @ +-- main :: IO () +-- main = 'prerender' 'defaultEvents' $ ('vcomp' () 'noop' $ \\_ () -> "hello world") { 'logLevel' = 'DebugPrerender' } +-- @ +-- +-- Assuming the JS / WASM payload and @index.html@ are delivered together from the web server, the console should output below +-- +-- > [DEBUG_HYDRATE] Successfully prerendered page +-- +-- See the [Haskell miso](https://haskell-miso.org) website console for an example usage of static prerendering with 'miso' and [miso-ui](https://ui.haskell-miso.org) for 'prerender' usage. +-- +-- == Dynamic prerendering +-- +-- Dynamic prerendering shares @model@ state between the server and client so the +-- client can hydrate from a meaningful initial state rather than a blank model. +-- The @-fssr@ Cabal flag must be enabled when compiling the server. +-- +-- The 'hydrateModel' field on 'Component' is @Maybe (IO model)@. When set, the +-- action runs once at hydration time to produce the initial model; it is ignored +-- on subsequent remounts. A typical pattern embeds the model as JSON in the +-- server response and reads it back on the client via the JS DSL: +-- +-- @ +-- myComp :: 'App' Model Action +-- myComp = ('vcomp' defaultModel updateModel viewModel) +-- { 'hydrateModel' = Just $ do +-- val <- 'Miso.DSL.jsg' "window" 'Miso.DSL.!' "__initialModel__" +-- 'Miso.DSL.fromJSValUnchecked' val +-- } +-- @ +-- +-- On the server, populate @window.__initialModel__@ by embedding the JSON +-- in a @\@ tag alongside the rendered HTML: +-- +-- @ +-- serverView :: Model -> 'View' Model Action +-- serverView m = +-- 'Miso.Html.Element.div_' [] +-- [ 'Miso.Html.Element.script_' [] [ 'textRaw' ("window.__initialModel__ = " \<\> 'Miso.JSON.encode' m) ] +-- , appView m +-- ] +-- @ +-- +-- When 'hydrateModel' is @Nothing@, the static 'model' field is used instead β€” +-- equivalent to static prerendering. +-- +----------------------------------------------------------------------------- +module Miso + ( -- * API + -- ** Miso + miso + , prerender + , (🍜) + -- ** App + , App + , startApp + , renderApp + -- ** Component + , Component (..) + , component + , vcomp + , (+>) + , mount_ + -- ** View + , vnode + , vtext + -- ** Sink + , withSink + , Sink + -- ** Mail + , mail + , checkMail + , parent + , mailParent + , mailChildren + , mailDescendants + , mailAncestors + , broadcast + -- ** Subscriptions + , startSub + , stopSub + , Sub + -- ** Effect + , issue + , batch + , io + , io_ + , sync + , sync_ + , for + -- ** JS file embedding +#ifdef WASM + , evalFile +#endif + , withJS + -- * Bindings + -- | Primitives for synchronizing parent and child models. + , module Miso.Binding + -- * DSL + -- | A JavaScript DSL for easy FFI interoperability + , module Miso.DSL + -- * Effect + -- | 'Effect', 'Sub', and 'Sink' types for defining update functions and subscriptions. + , module Miso.Effect + -- * Event + -- | Functions for specifying component lifecycle events and event handlers. + , module Miso.Event + -- * Fetch + -- | Interface to the Fetch API for making HTTP requests. + , module Miso.Fetch + -- * PubSub + -- | Publish / Subscribe primitives for communication between components. + , module Miso.PubSub + -- * Property + -- | Construct custom properties on DOM elements. + , module Miso.Property + -- * Reload + -- | Support for clearing the page during live-reloading w/ WASM browser mode. + , module Miso.Reload + -- * Subscriptions + -- | Subscriptions for external events (mouse, keyboard, window, history, etc.). + , module Miso.Subscription + -- * Storage + -- | Web Storage API (Local and Session storage) interface. + , module Miso.Storage + -- * Types + -- | Core types for Miso applications. + , module Miso.Types + -- * Util + -- | Utility functions for views, parsing, and general purpose combinators. + , module Miso.Util + -- * FFI + -- | Foreign Function Interface (FFI) utilities for interacting with JavaScript. + , module Miso.FFI + -- * State management + -- | State management for Miso applications. + , module Miso.State + ) where +----------------------------------------------------------------------------- +import Miso.Binding +import Miso.DSL +import Miso.Effect +import Miso.Event +import Miso.Fetch +import Miso.FFI +import qualified Miso.FFI.Internal as FFI +import Miso.Property +import Miso.PubSub +import Miso.Reload +import Miso.Runtime +import Miso.State +import Miso.Storage +import Miso.Subscription +import Miso.Types +import Miso.Util +---------------------------------------------------------------------------- +-- | Runs an @miso@ application. +-- +-- Assumes the pre-rendered DOM is already present. +-- Always mounts to \. Copies page into the virtual DOM. +-- +-- @ +-- main :: 'IO' () +-- main = 'miso' 'defaultEvents' app +-- @ +miso + :: Eq model + => Events + -- ^ Globally delegated Events + -> (URI -> App model action) + -- ^ The Component application, with the current URI as an argument + -> IO () +miso events f = do + comp <- f <$> getURI + initComponent events Hydrate False comp { mountPoint = Nothing } +---------------------------------------------------------------------------- +-- | Like 'miso', except discards the 'Miso.Router.URI' argument. +-- +-- Use this function if you'd like to prerender, but not use navigation. +-- +-- @ +-- main :: 'IO' () +-- main = 'prerender' 'defaultEvents' app +-- @ +prerender + :: Eq model + => Events + -- ^ Globally delegated 'Events' + -> App model action + -- ^ 'Component' application + -> IO () +prerender events comp = initComponent events Hydrate False comp { mountPoint = Nothing } +----------------------------------------------------------------------------- +-- | Like 'miso', except it does not perform page hydration. +-- +-- This function draws your application on an empty +-- +-- You will most likely want to use this function for your application +-- unless you are using prerendering. +-- +-- @ +-- main :: 'IO' () +-- main = 'startApp' 'defaultEvents' app +-- @ +-- +startApp + :: Eq model + => Events + -- ^ Globally delegated 'Events' + -> App model action + -- ^ 'Component' application + -> IO () +startApp events = initComponent events Draw False +----------------------------------------------------------------------------- +-- | Alias for 'Miso.miso'. +(🍜) + :: Eq model + => Events + -- ^ Globally delegated 'Events' + -> (URI -> App model action) + -- ^ 'Component' application, with the current URI as an argument + -> IO () +(🍜) = miso +---------------------------------------------------------------------------- +-- | Runs a 'miso' application, but with a custom rendering engine. +-- +-- The 'MisoString' specified here is the variable name of a globally-scoped +-- JS object that implements the context interface per @ts\/miso\/context\/dom.ts@ +-- This is necessary for native support. +-- +-- It is expected to be run on an empty @\@ +-- +-- @ +-- main :: IO () +-- main = 'renderApp' 'defaultEvents' "my-context" app +-- @ +renderApp + :: Eq model + => Events + -- ^ Globally delegated 'Events' + -> MisoString + -- ^ Name of the JS object that contains the drawing context + -> App model action + -- ^ 'Component' application + -> IO () +renderApp events renderer comp = do + FFI.setDrawingContext renderer + initComponent events Draw False comp ---------------------------------------------------------------------------- diff --git a/src/Miso/Binding.hs b/src/Miso/Binding.hs --- a/src/Miso/Binding.hs +++ b/src/Miso/Binding.hs @@ -17,17 +17,61 @@ -- -- = Data Bindings -- --- miso includes an experimental feature that allows fields of different models to be synchronized --- against each another in response to model changes. See 'Miso.Binding'. Note this feature is --- experimental, it is recommended to use asynchronous Component communication (like 'broadcast') by default. +-- "Miso.Binding" provides an experimental mechanism for synchronizing +-- model fields between a parent and child t'Miso.Component' using +-- 'Miso.Lens.Lens'-based /bindings/. Rather than coordinating state +-- through explicit message passing, a 'Binding' declares a directed or +-- bidirectional edge between two model fields. When the runtime detects +-- that a bound field has changed, it propagates the new value to the +-- connected component automatically. -- --- This module exposes combinators to construct a 'Binding' which holds two lenses that will alter --- t'Component' model state along the parent-child relationship using a 'Lens'. Practically, this means when --- one t'Component' is marked as dirty, another t'Component' will also potentially will be marked as --- dirty if they are connected along an edge ('Binding'). +-- __Note:__ This feature is experimental. For production inter-component +-- communication, prefer asynchronous messaging via @broadcast@ or +-- "Miso.PubSub". -- --- See the [miso-reactive](https://github.com/haskell-miso/miso-reactive) project for more information. +-- == How It Works -- +-- A 'Binding' encodes a directed /edge/ in the component graph. Each +-- edge is described by a pair of lenses β€” one projecting into the parent +-- model and one into the child model β€” that must share a common @field@ +-- type. After each update cycle the runtime reads the source field +-- through its lens and writes it into the destination model through the +-- other lens, according to the edge direction. +-- +-- == Example +-- +-- Suppose a parent component tracks a user's name, and a child component +-- independently maintains a display name. Declaring a bidirectional +-- binding keeps both fields in sync automatically: +-- +-- @ +-- {-\# LANGUAGE TemplateHaskell \#-} +-- +-- import "Miso" +-- import "Miso.Binding" +-- import "Miso.Lens.TH" ('Miso.Lens.TH.makeLenses') +-- import "Miso.String" ('Miso.String.MisoString') +-- +-- data ParentModel = ParentModel { _userName :: 'Miso.String.MisoString' } deriving 'Eq' +-- data ChildModel = ChildModel { _displayName :: 'Miso.String.MisoString' } deriving 'Eq' +-- +-- 'Miso.Lens.makeLenses' ''ParentModel +-- 'Miso.Lens.makeLenses' ''ChildModel +-- +-- -- Declare the child t'Miso.Types.Component' with a bidirectional 'Binding'. +-- -- Changes to either field will be reflected in the other. +-- +-- childComp :: t'Miso.Component' ParentModel () ChildModel ChildAction +-- childComp = ('Miso.component' initialChild updateChild viewChild) +-- { 'Miso.bindings' = [ userName @'<-->'@ displayName ] } +-- @ +-- +-- On mount, the parent field takes precedence by default (see 'Precedence'). +-- To invert that behaviour, use @'<<-->'@ instead. +-- +-- See the [miso-reactive](https://github.com/haskell-miso/miso-reactive) +-- project for extended examples. +-- ---------------------------------------------------------------------------- module Miso.Binding ( -- ** Types @@ -51,56 +95,91 @@ ---------------------------------------------------------------------------- import Miso.Lens (Lens, Lens', LensCore(..)) ---------------------------------------------------------------------------- --- | t'Binding' is used to synchronize parent and child model changes at the granularity specified by a t'Miso.Lens.Lens' +-- | A 'Binding' encodes a directed or bidirectional synchronization edge +-- between a field in a parent model and a field in a child model. The +-- field is projected via a pair of lenses that must share a common type. -- --- This can be thought of as establishing an "edge" in the 'Miso.Types.Component' graph, --- whereby events cause model change synchronization to "ripple" or "pulsate" --- through the views. The "reactivity" of the graph is constructed manually --- by the end-user, using the edge primitives `-->`, `<--`, `<-->` (reactive combinators). +-- After each update cycle the runtime evaluates all bindings registered +-- in a t'Miso.Types.Component' and propagates field values along each edge according +-- to its direction. On initial mount the 'Precedence' value determines +-- which side wins when both fields carry different values. -- --- @ --- main :: IO () --- main = run app { bindings = [ parentLens \<--\> childLens ] } --- @ +-- Construct 'Miso.Types.bindings' using the operator combinators rather than the data +-- constructors directly. For miso 'Miso.Lens.Lens': -- +-- * @'-->'@ β€” parentβ†’child +-- * @'<--'@ β€” childβ†’parent +-- * @'<-->'@ β€” bidirectional ('Parent' precedence on mount) +-- +-- For van Laarhoven 'Miso.Lens.Lens'': +-- +-- * @'--->'@ β€” parentβ†’child +-- * @'<---'@ β€” childβ†’parent +-- * @'<--->'@ β€” bidirectional ('Parent' precedence on mount) +-- -- @since 1.9.0.0 data Binding parent child = forall field . ParentToChild (parent -> field) (field -> child -> child) | forall field . ChildToParent (field -> parent -> parent) (child -> field) | forall field . Bidirectional Precedence (parent -> field) (field -> parent -> parent) (child -> field) (field -> child -> child) ----------------------------------------------------------------------------- --- | Data type used to express if the Child state should take precendence --- over the parent state during 'Component' mount. +-- | Determines which side of a 'Bidirectional' binding wins when parent +-- and child fields carry different values at t'Component' mount time. +-- After the initial mount both sides are kept in sync, so 'Precedence' +-- only affects the very first reconciliation. data Precedence = Child | Parent deriving (Eq, Show) ----------------------------------------------------------------------------- --- | Unidirectionally binds a parent field to a child field +-- | Constructs a unidirectional 'Binding' that propagates a field from +-- the parent model into the child model. Changes to the child field are +-- not reflected back to the parent. -- +-- Uses the miso 'Miso.Lens.Lens' representation. For van Laarhoven +-- lenses use @'--->'@. +-- -- @since 1.9.0.0 infixr 0 --> (-->) :: Lens parent a -> Lens model a -> Binding parent model parent --> child = ParentToChild (_get parent) (_set child) ----------------------------------------------------------------------------- --- | Unidirectionally binds a child field to a parent field +-- | Constructs a unidirectional 'Binding' that propagates a field from +-- the child model back into the parent model. Changes to the parent +-- field are not reflected into the child. -- +-- Uses the miso 'Miso.Lens.Lens' representation. For van Laarhoven +-- lenses use @'<---'@. +-- -- @since 1.9.0.0 infixl 0 <-- (<--) :: Lens parent a -> Lens model a -> Binding parent model parent <-- child = ChildToParent (_set parent) (_get child) ----------------------------------------------------------------------------- --- | Bidirectionally binds a child field to a parent field, using @Lens@ +-- | Constructs a bidirectional 'Binding' between a parent field and a +-- child field using the miso 'Miso.Lens.Lens' representation. Changes +-- to either field are propagated to the other after each update cycle. -- --- This is a bidirectional reactive combinator for a miso @Lens@. +-- On t'Component' mount, the parent field takes 'Precedence' over the +-- child field. Use @'<-->'@ to invert this and let the child win, or +-- @'<<-->'@ to state the parent precedence explicitly. -- +-- For van Laarhoven lenses use @'<--->'@. +-- -- @since 1.9.0.0 infix 0 <--> (<-->) :: Lens parent field -> Lens child field -> Binding parent child p <--> c = Bidirectional Parent (_get p) (_set p) (_get c) (_set c) ----------------------------------------------------------------------------- --- | Bidirectionally binds a child field to a parent field, using @Lens'@ +-- | Constructs a bidirectional 'Binding' between a parent field and a +-- child field using the van Laarhoven 'Miso.Lens.Lens'' representation. +-- Changes to either field are propagated to the other after each update +-- cycle. -- --- This is a bidirectional reactive combinator for a van Laarhoven @Lens'@ +-- On t'Component' mount, the parent field takes 'Precedence' over the +-- child field. Use @'<<--->'@ to invert this and let the child win, or +-- @'<--->>'@ to state the parent 'Precedence' explicitly. -- +-- For miso lenses use @'<-->'@. +-- -- @since 1.9.0.0 infix 0 <---> (<--->) :: Lens' parent field -> Lens' child field -> Binding parent child @@ -109,7 +188,10 @@ get_ lens_ record = getConst (lens_ Const record) set_ lens_ field = runIdentity . lens_ (\_ -> Identity field) ----------------------------------------------------------------------------- --- | Like '<--->' but biases to inherit 'Parent' state on 'Component' 'mount'. +-- | Like @'<--->'@ but explicitly sets 'Precedence' to 'Parent', so +-- the parent field overwrites the child field on t'Component' mount. +-- This is the default behaviour of @'<--->'@; use this combinator +-- when you want to be explicit about the 'Precedence'. -- -- @since 1.10.0.0 (<--->>) @@ -121,7 +203,10 @@ Bidirectional _ w x y z -> Bidirectional Parent w x y z _ -> error "impossible" ----------------------------------------------------------------------------- --- | Like '<--->' but biases to inherit 'Child' state on 'Component' 'mount'. +-- | Like @'<--->'@ but sets 'Precedence' to 'Child', so the child +-- field overwrites the parent field on t'Component' mount. Use this +-- when the child component owns the authoritative initial value for +-- the shared field. -- -- @since 1.10.0.0 (<<--->) @@ -133,9 +218,13 @@ Bidirectional _ w x y z -> Bidirectional Child w x y z _ -> error "impossible" ----------------------------------------------------------------------------- --- | Unidirectionally binds a parent field to a child field, for van Laarhoven --- style @Lens'@ +-- | Constructs a unidirectional 'Binding' that propagates a field from +-- the parent model into the child model. Changes to the child field are +-- not reflected back to the parent. -- +-- Uses the van Laarhoven 'Miso.Lens.Lens'' representation. For miso +-- lenses use @'-->'@. +-- -- @since 1.9.0.0 infixr 0 ---> (--->) :: Lens' parent field -> Lens' child field -> Binding parent child @@ -144,7 +233,10 @@ get_ lens_ record = getConst (lens_ Const record) set_ lens_ field = runIdentity . lens_ (\_ -> Identity field) ----------------------------------------------------------------------------- --- | Like '<-->' but biases to inherit 'Parent' state on 'Component' 'mount'. +-- | Like @'<-->'@ but explicitly sets 'Precedence' to 'Parent', so +-- the parent field overwrites the child field on t'Component' mount. +-- This is the default behaviour of @'<-->'@ use this combinator +-- when you want to be explicit about the precedence. -- -- @since 1.10.0.0 (<-->>) @@ -156,7 +248,10 @@ Bidirectional _ w x y z -> Bidirectional Parent w x y z _ -> error "impossible" ----------------------------------------------------------------------------- --- | Like '<-->' but biases to inherit 'Child' state on 'Component' 'mount'. +-- | Like @'<-->'@ but sets 'Precedence' to 'Child', so the child +-- field overwrites the parent field on t'Component' mount. Use this +-- when the child component owns the authoritative initial value for +-- the shared field. -- -- @since 1.10.0.0 (<<-->) @@ -168,8 +263,12 @@ Bidirectional _ w x y z -> Bidirectional Child w x y z _ -> error "impossible" ----------------------------------------------------------------------------- --- | Unidirectionally binds a child field to a parent field, for van Laarhoven --- style @Lens'@ +-- | Constructs a unidirectional 'Binding' that propagates a field from +-- the child model back into the parent model. Changes to the parent +-- field are not reflected into the child. +-- +-- Uses the van Laarhoven 'Miso.Lens.Lens'' representation. For miso +-- lenses use @'<--'@. -- -- @since 1.9.0.0 infixl 0 <--- diff --git a/src/Miso/CSS.hs b/src/Miso/CSS.hs --- a/src/Miso/CSS.hs +++ b/src/Miso/CSS.hs @@ -9,8 +9,102 @@ -- Stability : experimental -- Portability : non-portable -- --- Module for constructing CSS styles and stylesheets in miso +-- = Overview -- +-- "Miso.CSS" is a typed DSL for constructing CSS properties, stylesheets, +-- animations, and media queries in miso applications. Two styling modes are +-- available: +-- +-- * __Structured styles__ ('style_'): CSS properties are stored in a +-- 'Data.Map.Map' and diffed by the virtual DOM, so only changed properties +-- are written to the DOM node on each render. Prefer this for dynamic styles. +-- +-- * __Inline string styles__ ('styleInline_'): a raw CSS string is set on the +-- @style@ attribute verbatim and is not diffed. Useful for static one-liners +-- or values that the structured combinators do not yet cover. +-- +-- = Quick start +-- +-- @ +-- import qualified "Miso.CSS" as CSS +-- import "Miso.CSS.Color" ('Miso.CSS.Color.red', 'Miso.CSS.Color.rgba') +-- +-- myView :: 'Miso.Types.View' Model Action +-- myView = +-- 'Miso.Html.Element.div_' +-- [ CSS.'Miso.CSS.style_' +-- [ CSS.'Miso.CSS.display' "flex" +-- , CSS.'Miso.CSS.flexDirection' "column" +-- , CSS.'Miso.CSS.gap' (CSS.'Miso.CSS.px' 8) +-- , CSS.'Miso.CSS.padding' (CSS.'Miso.CSS.px' 16) +-- , CSS.'Miso.CSS.backgroundColor' 'Miso.CSS.Color.red' +-- , CSS.'Miso.CSS.borderRadius' (CSS.'Miso.CSS.px' 4) +-- ] +-- ] [ 'Miso.text' "Hello, miso!" ] +-- @ +-- +-- = Global Stylesheets +-- +-- Construct a 'StyleSheet' with 'sheet_' and 'selector_', then render it to +-- a 'MisoString' with 'renderStyleSheet' for injection into a @\@ tag: +-- +-- @ +-- mySheet :: 'StyleSheet' +-- mySheet = 'sheet_' +-- [ 'selector_' "body" +-- [ CSS.'margin' (CSS.'px' 0) +-- , CSS.'fontFamily' "sans-serif" +-- ] +-- , 'selector_' ".card" +-- [ CSS.'backgroundColor' ('rgba' 255 255 255 0.9) +-- , CSS.'borderRadius' (CSS.'px' 4) +-- ] +-- ] +-- @ +-- +-- = Animations and Media Queries +-- +-- @ +-- myAnimation :: 'Styles' +-- myAnimation = 'keyframes_' "slide-in" +-- [ 'from_' [ CSS.'transform' "translateX(-100%)" ] +-- , 'to_' [ CSS.'transform' "translateX(0)" ] +-- ] +-- +-- myMedia :: 'Styles' +-- myMedia = 'media_' ('screen_' \`and_\` 'minWidth_' (CSS.'px' 480)) +-- [ 'rule_' "header" [ CSS.'height' "auto" ] +-- , 'rule_' "nav" [ CSS.'display' "flex" ] +-- ] +-- @ +-- +-- = CSS Units +-- +-- Use the unit helpers to build length and time values: +-- 'px', 'pt', 'em', 'rem', 'vh', 'vw', 'pct', 'ms', 's', 'deg', 'rad', 'turn'. +-- +-- @ +-- CSS.'style_' +-- [ CSS.'width' (CSS.'pct' 100) +-- , CSS.'fontSize' (CSS.'rem' 1.5) +-- , CSS.'transition' ("opacity " <> CSS.'ms' 300 <> " ease") +-- ] +-- @ +-- +-- = Colors +-- +-- The 'Color' type and named colors are re-exported from "Miso.CSS.Color": +-- +-- @ +-- CSS.'backgroundColor' (CSS.'rgb' 30 144 255) +-- CSS.'color' CSS.'white' +-- CSS.'borderColor' (CSS.'rgba' 0 0 0 0.2) +-- @ +-- +-- __Note:__ 'color' in this module and 'Miso.Canvas.color' share the same +-- name but have different types. Always qualify @import qualified Miso.CSS as CSS@ +-- when also importing "Miso.Canvas". +-- ----------------------------------------------------------------------------- module Miso.CSS ( -- *** Types @@ -84,9 +178,12 @@ , boxShadow , boxSizing , clipPath + , accentColor + , appearance + , backdropFilter + , caretColor , color , columnGap - , cssVariable , cursor , direction , display @@ -101,15 +198,19 @@ , flexWrap , fontFamily , fontSize + , fontStretch , fontStyle + , fontVariant , fontWeight , gap , gridAutoColumns , gridAutoFlow , gridAutoRows + , gridColumn , gridColumnEnd , gridColumnSpan , gridColumnStart + , gridRow , gridRowEnd , gridRowSpan , gridRowStart @@ -144,11 +245,20 @@ , maxWidth , minHeight , minWidth + , mixBlendMode + , objectFit + , objectPosition , opacity , order + , outline + , outlineColor + , outlineOffset + , outlineStyle + , outlineWidth , overflow , overflowX , overflowY + , overscrollBehavior , paddingBottom , paddingInlineEnd , paddingInlineStart @@ -157,6 +267,7 @@ , paddingRight , paddingTop , perspective + , pointerEvents , position , relativeAlignBottom , relativeAlignInlineEnd @@ -173,8 +284,10 @@ , relativeLeftOf , relativeRightOf , relativeTopOf + , resize , right , rowGap + , scrollBehavior , stroke , strokeWidth , textAlign @@ -185,18 +298,44 @@ , textStrokeColor , textStroke , textStrokeWidth + , textTransform , top , transform + , transforms , transformOrigin + -- *** Transform functions + , translate + , translateX + , translateY + , translateZ + , translate3d + , rotate + , rotateX + , rotateY + , rotateZ + , rotate3d + , scale + , scaleXY + , scale3d + , scaleX + , scaleY + , scaleZ + , perspectiveFn + , matrix3d + , skew + , skewX + , skewY , transitionDelay , transitionDuration , transition , transitionProperty , transitionTimingFunction + , userSelect , verticalAlign , visibility , whiteSpace , width + , willChange , wordBreak , xAutoFontSize , xAutoFontSizePresetSizes @@ -225,8 +364,27 @@ , matrix -- *** Animation , keyframes_ + , from_ + , to_ + , at -- *** Media Queries , media_ + , rule_ + -- *** Media query combinators + , screen_ + , print_ + , all_ + , and_ + , or_ + , not_ + , minWidth_ + , maxWidth_ + , minHeight_ + , maxHeight_ + , orientation_ + , prefersColorScheme_ + , prefersReducedMotion_ + , hover_ ) where ----------------------------------------------------------------------------- import qualified Data.Map as M @@ -361,24 +519,40 @@ ms :: Double -> MisoString ms x = MS.ms x <> "ms" ----------------------------------------------------------------------------- --- | CSS function for specifying a [URL](https://developer.mozilla.org/en-US/docs/Web/API/StyleSheet) +-- | Wraps a value in the CSS @url()@ function, used for background images and similar. -- -- @ -- >>> url "dog.png" --- "url(\"dog.png\")" +-- "url(dog.png)" -- @ -- +-- @ +-- backgroundImage (url "banner.png") +-- @ +-- +-- +-- url :: MisoString -> MisoString url x = "url(" <> x <> ")" ----------------------------------------------------------------------------- --- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/matrix +-- | Constructs a 2D CSS transformation matrix string: @matrix(a, b, c, d, tx, ty)@. +-- +-- The six parameters define a 2D affine transformation: @a@ and @d@ scale, +-- @b@ and @c@ skew, and @tx@\/@ty@ translate. +-- +-- @ +-- transform (matrix 1 0 0 1 50 100) -- translate by (50, 100) +-- @ +-- +-- +-- matrix - :: Double - -> Double - -> Double - -> Double - -> Double - -> Double + :: Double -- ^ a β€” scale x + -> Double -- ^ b β€” skew y + -> Double -- ^ c β€” skew x + -> Double -- ^ d β€” scale y + -> Double -- ^ tx β€” translate x + -> Double -- ^ ty β€” translate y -> MisoString matrix a b c d tx ty = "matrix(" <> values <> ")" where @@ -392,49 +566,93 @@ , MS.ms ty ] ----------------------------------------------------------------------------- --- | https://developer.mozilla.org/en-US/docs/Web/CSS/percentage +-- | Percentage unit. +-- +-- @ +-- >>> pct 50.0 +-- "50.0%" +-- @ +-- +-- pct :: Double -> MisoString pct x = MS.ms x <> "%" ----------------------------------------------------------------------------- --- | ppx unit of measure +-- | Physical pixel unit (@ppx@), used in some native\/mobile rendering contexts. +-- +-- @ +-- >>> ppx 2.0 +-- "2.0ppx" +-- @ +-- ppx :: Double -> MisoString ppx x = MS.ms x <> "ppx" ----------------------------------------------------------------------------- --- | Used when constructing a t'StyleSheet' +-- | Constructs a 'Styles' entry pairing a CSS selector with a list of properties. +-- Combine multiple entries with 'sheet_'. -- -- @ -- sheet_ --- [ selector_ ".name" --- [ backgroundColor red --- , alignContent "top" --- ] +-- [ selector_ ".card" [ backgroundColor white, borderRadius (px 4) ] +-- , selector_ ".title" [ fontSize (rem 1.5), fontWeight "bold" ] -- ] -- @ -- selector_ :: MisoString -> [Style] -> Styles selector_ k v = Styles (k,v) ----------------------------------------------------------------------------- --- | Smart constructor for t'StyleSheet' +-- | Constructs a 'StyleSheet' from a list of 'Styles' entries. +-- +-- Combine with 'selector_', 'keyframes_', and 'media_' to build a full +-- stylesheet, then render it to a 'MisoString' with 'renderStyleSheet'. +-- +-- @ +-- mySheet :: StyleSheet +-- mySheet = sheet_ +-- [ selector_ "body" [ margin (px 0), fontFamily "sans-serif" ] +-- , selector_ "button" [ cursor "pointer", borderRadius (px 4) ] +-- ] +-- @ +-- sheet_ :: [Styles] -> StyleSheet sheet_ = StyleSheet ----------------------------------------------------------------------------- --- | @style_@ is an attribute that will set the @style@ --- attribute of the associated DOM node to @attrs@. +-- | Constructs a structured @style@ attribute from a list of CSS properties. -- --- @style@ attributes not contained in @attrs@ will be deleted. +-- Each 'Style' is a @(property, value)@ pair produced by the combinators in +-- this module. Miso tracks the properties as a 'Data.Map.Map', diffs them on +-- each render, and applies only the changed properties to the DOM. Properties +-- absent from the list are removed from the node. -- --- > div_ [ style_ [ backgroundColor "red" ] [ ] +-- @ +-- div_ +-- [ style_ +-- [ display "flex" +-- , flexDirection "column" +-- , gap (px 8) +-- , backgroundColor red +-- ] +-- ] [] +-- @ -- +-- See also 'styleInline_' for setting raw CSS strings. +-- -- -- style_ :: [Style] -> Attribute action style_ = MT.Styles . M.fromList ----------------------------------------------------------------------------- --- | Set "style" property +-- | Sets the @style@ attribute to a raw CSS string. -- --- > view m = div_ [ styleInline_ "background-color:red;color:blue;" ] [ "foo" ] +-- Unlike 'style_', the string is applied verbatim and is not tracked or +-- diffed by the virtual DOM. Suitable for static styles or CSS values that +-- the structured combinators do not yet cover. -- --- https://developer.mozilla.org/en-US/docs/Web/CSS +-- @ +-- div_ [ styleInline_ "background-color:red; color:blue;" ] [ "foo" ] +-- @ +-- +-- +-- styleInline_ :: MisoString -> Attribute action styleInline_ = textProp "style" ----------------------------------------------------------------------------- @@ -474,53 +692,145 @@ , "}\n" ] ----------------------------------------------------------------------------- --- | Render t'StyleSheet' as 'MisoString' +-- | Renders a 'StyleSheet' to a 'MisoString' suitable for injection into a +-- @\@ tag. -- +-- @ +-- view_ :: View model action +-- view_ = style [] [ text (renderStyleSheet mySheet) ] +-- @ +-- renderStyleSheet :: StyleSheet -> MisoString renderStyleSheet styleSheet = MS.intercalate "\n" [ renderStyles 0 styles | styles <- getStyleSheet styleSheet ] ----------------------------------------------------------------------------- --- | https://developer.mozilla.org/en-US/docs/Web/CSS/@keyframes +-- | Constructs a CSS @\@keyframes@ animation rule. -- +-- The first argument is the animation name; the second is a list of +-- @(keyframe-selector, [Style])@ pairs. Keyframe selectors are either +-- @"from"@\/@"to"@ or a percentage string produced by 'pct'. +-- -- @ --- testKeyFrame :: Styles --- testKeyFrame = keyframes "slide-in" --- [ "from" =: --- [ transform "translateX(0%)" --- ] --- , "to" =: --- [ transform "translateX(100%)" --- , backgroundColor red --- , backgroundSize "10px" --- , backgroundRepeat "true" --- ] --- , pct 10 =: --- [ "foo" =: "bar" --- ] --- ] +-- slideIn :: Styles +-- slideIn = keyframes_ "slide-in" +-- [ from_ [ transform "translateX(-100%)" ] +-- , at (pct 50) [ opacity 0.5 ] +-- , to_ [ transform "translateX(0)" ] +-- ] -- @ -- -keyframes_ :: MisoString -> [(MisoString, [Style])] -> Styles -keyframes_ = KeyFrame +-- +-- +keyframes_ :: MisoString -> [KeyframeStop] -> Styles +keyframes_ name stops = KeyFrame name (map getKeyframeStop stops) ----------------------------------------------------------------------------- --- | https://developer.mozilla.org/en-US/docs/Web/CSS/@media +-- | The @from@ stop in a '@keyframes' rule (equivalent to @0%@). +from_ :: [Style] -> KeyframeStop +from_ styles = KeyframeStop ("from", styles) +----------------------------------------------------------------------------- +-- | The @to@ stop in a '@keyframes' rule (equivalent to @100%@). +to_ :: [Style] -> KeyframeStop +to_ styles = KeyframeStop ("to", styles) +----------------------------------------------------------------------------- +-- | A keyframe stop at a given position, typically built with 'pct'. -- +-- > at (pct 50) [ opacity 0.5 ] +-- +at :: MisoString -> [Style] -> KeyframeStop +at stop styles = KeyframeStop (stop, styles) +----------------------------------------------------------------------------- +-- | Constructs a CSS @\@media@ query rule. +-- +-- The first argument is the media condition string; the second is a list of +-- @(selector, [Style])@ pairs scoped to that query. +-- -- @ --- media_ "screen and (min-width: 480px)" --- [ "header" =: --- [ height "auto" --- ] --- , "ul" =: --- [ display "block" --- ] +-- responsive :: 'Styles' +-- responsive = 'media_' ('screen_' \`and_\` 'minWidth_' (px 480)) +-- [ 'rule_' "header" [ 'height' "auto" ] +-- , 'rule_' "ul" [ 'display' "block" ] -- ] -- @ -- -media_ :: MisoString -> [(MisoString, [Style])] -> Styles -media_ = Media +-- +-- +media_ :: MediaQuery -> [MediaRule] -> Styles +media_ (MediaQuery q) rules = Media q (map getMediaRule rules) ----------------------------------------------------------------------------- +-- | A selector rule inside a 'media_' block. +-- +-- > rule_ "header" [ height "auto" ] +-- +rule_ :: MisoString -> [Style] -> MediaRule +rule_ sel styles = MediaRule (sel, styles) +----------------------------------------------------------------------------- +-- | The @screen@ media type. +screen_ :: MediaQuery +screen_ = MediaQuery "screen" +----------------------------------------------------------------------------- +-- | The @print@ media type. +print_ :: MediaQuery +print_ = MediaQuery "print" +----------------------------------------------------------------------------- +-- | The @all@ media type (matches all devices). +all_ :: MediaQuery +all_ = MediaQuery "all" +----------------------------------------------------------------------------- +-- | Logical @and@ for media queries. +-- +-- > screen_ \`and_\` minWidth_ (px 480) +-- +and_ :: MediaQuery -> MediaQuery -> MediaQuery +and_ (MediaQuery a) (MediaQuery b) = MediaQuery (a <> " and " <> b) +----------------------------------------------------------------------------- +-- | Logical @or@ for media queries (comma-separated). +-- +-- > screen_ \`or_\` print_ +-- +or_ :: MediaQuery -> MediaQuery -> MediaQuery +or_ (MediaQuery a) (MediaQuery b) = MediaQuery (a <> ", " <> b) +----------------------------------------------------------------------------- +-- | Logical @not@ for media queries. +-- +-- > not_ print_ +-- +not_ :: MediaQuery -> MediaQuery +not_ (MediaQuery q) = MediaQuery ("not " <> q) +----------------------------------------------------------------------------- +-- | @min-width@ media feature. Use unit constructors like 'px' or 'em'. +minWidth_ :: MisoString -> MediaQuery +minWidth_ x = MediaQuery ("(min-width: " <> x <> ")") +----------------------------------------------------------------------------- +-- | @max-width@ media feature. +maxWidth_ :: MisoString -> MediaQuery +maxWidth_ x = MediaQuery ("(max-width: " <> x <> ")") +----------------------------------------------------------------------------- +-- | @min-height@ media feature. +minHeight_ :: MisoString -> MediaQuery +minHeight_ x = MediaQuery ("(min-height: " <> x <> ")") +----------------------------------------------------------------------------- +-- | @max-height@ media feature. +maxHeight_ :: MisoString -> MediaQuery +maxHeight_ x = MediaQuery ("(max-height: " <> x <> ")") +----------------------------------------------------------------------------- +-- | @orientation@ media feature. Use @\"portrait\"@ or @\"landscape\"@. +orientation_ :: MisoString -> MediaQuery +orientation_ x = MediaQuery ("(orientation: " <> x <> ")") +----------------------------------------------------------------------------- +-- | @prefers-color-scheme@ media feature. Use @\"light\"@ or @\"dark\"@. +prefersColorScheme_ :: MisoString -> MediaQuery +prefersColorScheme_ x = MediaQuery ("(prefers-color-scheme: " <> x <> ")") +----------------------------------------------------------------------------- +-- | @prefers-reduced-motion@ media feature. Use @\"reduce\"@ or @\"no-preference\"@. +prefersReducedMotion_ :: MisoString -> MediaQuery +prefersReducedMotion_ x = MediaQuery ("(prefers-reduced-motion: " <> x <> ")") +----------------------------------------------------------------------------- +-- | @hover@ media feature. Use @\"hover\"@ or @\"none\"@. +hover_ :: MisoString -> MediaQuery +hover_ x = MediaQuery ("(hover: " <> x <> ")") +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/align-content -- alignContent :: MisoString -> Style @@ -551,7 +861,7 @@ animationDuration :: MisoString -> Style animationDuration x = "animation-duration" =: x ----------------------------------------------------------------------------- --- | https://animation-mozilla.org/en-US/docs/Web/CSS/align-content/animation-fill-mode +-- | -- animationFillMode :: MisoString -> Style animationFillMode x = "animation-fill-mode" =: x @@ -571,8 +881,7 @@ animationName :: MisoString -> Style animationName x = "animation-name" =: x ----------------------------------------------------------------------------- --- | https://developer.mozilla.org/en-US/docs/Web/CSS/animation-play-state --- > style_ [ animationPlayState =: "value" ] +-- | -- animationPlayState :: MisoString -> Style animationPlayState x = "animation-play-state" =: x @@ -827,6 +1136,26 @@ clipPath :: MisoString -> Style clipPath x = "clip-path" =: x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/accent-color +-- +accentColor :: Color -> Style +accentColor x = "accent-color" =: renderColor x +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/appearance +-- +appearance :: MisoString -> Style +appearance x = "appearance" =: x +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/backdrop-filter +-- +backdropFilter :: MisoString -> Style +backdropFilter x = "backdrop-filter" =: x +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/caret-color +-- +caretColor :: Color -> Style +caretColor x = "caret-color" =: renderColor x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/color -- color :: Color -> Style @@ -837,11 +1166,6 @@ columnGap :: MisoString -> Style columnGap x = "column-gap" =: x ----------------------------------------------------------------------------- --- | https://developer.mozilla.org/en-US/docs/Web/CSS/css-variable --- -cssVariable :: MisoString -> Style -cssVariable x = "css-variable" =: x ------------------------------------------------------------------------------ -- | https://developer.mozilla.org/en-US/docs/Web/CSS/direction -- direction :: MisoString -> Style @@ -852,10 +1176,12 @@ display :: MisoString -> Style display x = "display" =: x ----------------------------------------------------------------------------- --- | https://developer.mozilla.org/en-US/docs/Web/CSS/fill +-- | SVG [fill](https://developer.mozilla.org/en-US/docs/Web/CSS/fill) color. -- -fill :: MisoString -> Style -fill x = "fill" =: x +-- > fill red +-- +fill :: Color -> Style +fill x = "fill" =: renderColor x ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/filter -- @@ -879,8 +1205,8 @@ ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/flex-grow -- -flexGrow :: MisoString -> Style -flexGrow x = "flex-grow" =: x +flexGrow :: Double -> Style +flexGrow x = "flex-grow" =: MS.ms x ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/flex -- @@ -889,8 +1215,8 @@ ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/flex-shrink -- -flexShrink :: MisoString -> Style -flexShrink x = "flex-shrink" =: x +flexShrink :: Double -> Style +flexShrink x = "flex-shrink" =: MS.ms x ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/flex-wrap -- @@ -907,11 +1233,21 @@ fontSize :: MisoString -> Style fontSize x = "font-size" =: x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/font-stretch +-- +fontStretch :: MisoString -> Style +fontStretch x = "font-stretch" =: x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/font-style -- fontStyle :: MisoString -> Style fontStyle x = "font-style" =: x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/font-variant +-- +fontVariant :: MisoString -> Style +fontVariant x = "font-variant" =: x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/font-weight -- fontWeight :: MisoString -> Style @@ -942,6 +1278,11 @@ gridAutoRows :: MisoString -> Style gridAutoRows x = "grid-auto-rows" =: x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/grid-column +-- +gridColumn :: MisoString -> Style +gridColumn x = "grid-column" =: x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/grid-column-end -- gridColumnEnd :: MisoString -> Style @@ -957,6 +1298,11 @@ gridColumnStart :: MisoString -> Style gridColumnStart x = "grid-column-start" =: x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/grid-row +-- +gridRow :: MisoString -> Style +gridRow x = "grid-row" =: x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/grid-row-end -- gridRowEnd :: MisoString -> Style @@ -1127,16 +1473,56 @@ minWidth :: MisoString -> Style minWidth x = "min-width" =: x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/mix-blend-mode +-- +mixBlendMode :: MisoString -> Style +mixBlendMode x = "mix-blend-mode" =: x +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/object-fit +-- +objectFit :: MisoString -> Style +objectFit x = "object-fit" =: x +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/object-position +-- +objectPosition :: MisoString -> Style +objectPosition x = "object-position" =: x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/opacity -- -opacity :: MisoString -> Style -opacity x = "opacity" =: x +opacity :: Double -> Style +opacity x = "opacity" =: MS.ms x ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/order -- -order :: MisoString -> Style -order x = "order" =: x +order :: Int -> Style +order x = "order" =: MS.ms x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/outline +-- +outline :: MisoString -> Style +outline x = "outline" =: x +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/outline-color +-- +outlineColor :: Color -> Style +outlineColor x = "outline-color" =: renderColor x +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/outline-offset +-- +outlineOffset :: MisoString -> Style +outlineOffset x = "outline-offset" =: x +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/outline-style +-- +outlineStyle :: MisoString -> Style +outlineStyle x = "outline-style" =: x +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/outline-width +-- +outlineWidth :: MisoString -> Style +outlineWidth x = "outline-width" =: x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/overflow -- overflow :: MisoString -> Style @@ -1152,6 +1538,11 @@ overflowY :: MisoString -> Style overflowY x = "overflow-y" =: x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/overscroll-behavior +-- +overscrollBehavior :: MisoString -> Style +overscrollBehavior x = "overscroll-behavior" =: x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/padding-bottom -- paddingBottom :: MisoString -> Style @@ -1192,6 +1583,11 @@ perspective :: MisoString -> Style perspective x = "perspective" =: x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/pointer-events +-- +pointerEvents :: MisoString -> Style +pointerEvents x = "pointer-events" =: x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/position -- position :: MisoString -> Style @@ -1272,6 +1668,11 @@ relativeTopOf :: MisoString -> Style relativeTopOf x = "relative-top-of" =: x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/resize +-- +resize :: MisoString -> Style +resize x = "resize" =: x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/right -- right :: MisoString -> Style @@ -1282,11 +1683,18 @@ rowGap :: MisoString -> Style rowGap x = "row-gap" =: x ----------------------------------------------------------------------------- --- | https://developer.mozilla.org/en-US/docs/Web/CSS/stroke +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/scroll-behavior -- -stroke :: MisoString -> Style -stroke x = "stroke" =: x +scrollBehavior :: MisoString -> Style +scrollBehavior x = "scroll-behavior" =: x ----------------------------------------------------------------------------- +-- | SVG [stroke](https://developer.mozilla.org/en-US/docs/Web/CSS/stroke) color. +-- +-- > stroke black +-- +stroke :: Color -> Style +stroke x = "stroke" =: renderColor x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/stroke-width -- strokeWidth :: MisoString -> Style @@ -1332,6 +1740,11 @@ textStrokeWidth :: MisoString -> Style textStrokeWidth x = "text-stroke-width" =: x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/text-transform +-- +textTransform :: MisoString -> Style +textTransform x = "text-transform" =: x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/top -- top :: MisoString -> Style @@ -1342,11 +1755,157 @@ transform :: MisoString -> Style transform x = "transform" =: x ----------------------------------------------------------------------------- +-- | Apply a list of t'TransformFn' values as a @transform@ style. +-- +-- @ +-- transforms [ translate (px 10) (pct 50), rotate (deg 45), scaleX 1.5 ] +-- @ +-- +transforms :: [TransformFn] -> Style +transforms fns = "transform" =: MS.intercalate " " (map renderTransformFn fns) +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-origin -- transformOrigin :: MisoString -> Style transformOrigin x = "transform-origin" =: x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/translate +-- +-- >>> renderTransformFn (translate (px 10) (pct 50)) +-- "translate(10px,50.0%)" +-- +translate :: MisoString -> MisoString -> TransformFn +translate x y = TransformFn $ "translate(" <> x <> "," <> y <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/translateX +-- +translateX :: MisoString -> TransformFn +translateX x = TransformFn $ "translateX(" <> x <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/translateY +-- +translateY :: MisoString -> TransformFn +translateY y = TransformFn $ "translateY(" <> y <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/translateZ +-- +translateZ :: MisoString -> TransformFn +translateZ z = TransformFn $ "translateZ(" <> z <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/translate3d +-- +translate3d :: MisoString -> MisoString -> MisoString -> TransformFn +translate3d x y z = TransformFn $ "translate3d(" <> MS.intercalate "," [x, y, z] <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/rotate +-- +-- >>> renderTransformFn (rotate (deg 45)) +-- "rotate(45.0deg)" +-- +rotate :: MisoString -> TransformFn +rotate a = TransformFn $ "rotate(" <> a <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/rotateX +-- +rotateX :: MisoString -> TransformFn +rotateX a = TransformFn $ "rotateX(" <> a <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/rotateY +-- +rotateY :: MisoString -> TransformFn +rotateY a = TransformFn $ "rotateY(" <> a <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/rotateZ +-- +rotateZ :: MisoString -> TransformFn +rotateZ a = TransformFn $ "rotateZ(" <> a <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/rotate3d +-- x, y, z are unitless direction vector components; angle uses a unit constructor like 'deg'. +-- +rotate3d :: Double -> Double -> Double -> MisoString -> TransformFn +rotate3d x y z a = TransformFn $ "rotate3d(" <> MS.intercalate "," [MS.ms x, MS.ms y, MS.ms z, a] <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/scale +-- Uniform scale on both axes. +-- +-- >>> renderTransformFn (scale 1.5) +-- "scale(1.5)" +-- +scale :: Double -> TransformFn +scale n = TransformFn $ "scale(" <> MS.ms n <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/scale +-- Non-uniform scale: separate X and Y factors. +-- +scaleXY :: Double -> Double -> TransformFn +scaleXY x y = TransformFn $ "scale(" <> MS.ms x <> "," <> MS.ms y <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/scale3d +-- +scale3d :: Double -> Double -> Double -> TransformFn +scale3d x y z = TransformFn $ "scale3d(" <> MS.intercalate "," [MS.ms x, MS.ms y, MS.ms z] <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/scaleX +-- +scaleX :: Double -> TransformFn +scaleX n = TransformFn $ "scaleX(" <> MS.ms n <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/scaleY +-- +scaleY :: Double -> TransformFn +scaleY n = TransformFn $ "scaleY(" <> MS.ms n <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/scaleZ +-- +scaleZ :: Double -> TransformFn +scaleZ n = TransformFn $ "scaleZ(" <> MS.ms n <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/perspective +-- The @perspective()@ transform function, distinct from the @perspective@ CSS property. +-- +-- >>> renderTransformFn (perspectiveFn (px 500)) +-- "perspective(500px)" +-- +perspectiveFn :: MisoString -> TransformFn +perspectiveFn d = TransformFn $ "perspective(" <> d <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/matrix3d +-- 4x4 homogeneous matrix in column-major order; each tuple is one column. +-- +-- > matrix3d (1,0,0,0) (0,1,0,0) (0,0,1,0) (10,20,0,1) +-- +matrix3d + :: (Double, Double, Double, Double) + -> (Double, Double, Double, Double) + -> (Double, Double, Double, Double) + -> (Double, Double, Double, Double) + -> TransformFn +matrix3d (a1,b1,c1,d1) (a2,b2,c2,d2) (a3,b3,c3,d3) (a4,b4,c4,d4) = + TransformFn $ "matrix3d(" <> values <> ")" + where + values = MS.intercalate "," + [ MS.ms a1, MS.ms b1, MS.ms c1, MS.ms d1 + , MS.ms a2, MS.ms b2, MS.ms c2, MS.ms d2 + , MS.ms a3, MS.ms b3, MS.ms c3, MS.ms d3 + , MS.ms a4, MS.ms b4, MS.ms c4, MS.ms d4 + ] +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/skew +-- +skew :: MisoString -> MisoString -> TransformFn +skew x y = TransformFn $ "skew(" <> x <> "," <> y <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/skewX +-- +skewX :: MisoString -> TransformFn +skewX a = TransformFn $ "skewX(" <> a <> ")" +----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/skewY +-- +skewY :: MisoString -> TransformFn +skewY a = TransformFn $ "skewY(" <> a <> ")" +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/transition-delay -- transitionDelay :: MisoString -> Style @@ -1372,6 +1931,11 @@ transitionTimingFunction :: MisoString -> Style transitionTimingFunction x = "transition-timing-function" =: x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/user-select +-- +userSelect :: MisoString -> Style +userSelect x = "user-select" =: x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/vertical-align -- verticalAlign :: MisoString -> Style @@ -1392,6 +1956,11 @@ width :: MisoString -> Style width x = "width" =: x ----------------------------------------------------------------------------- +-- | https://developer.mozilla.org/en-US/docs/Web/CSS/will-change +-- +willChange :: MisoString -> Style +willChange x = "will-change" =: x +----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/word-break -- wordBreak :: MisoString -> Style @@ -1419,6 +1988,6 @@ ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/CSS/z-index -- -zIndex :: MisoString -> Style -zIndex x = "z-index" =: x +zIndex :: Int -> Style +zIndex x = "z-index" =: MS.ms x ----------------------------------------------------------------------------- diff --git a/src/Miso/CSS/Color.hs b/src/Miso/CSS/Color.hs --- a/src/Miso/CSS/Color.hs +++ b/src/Miso/CSS/Color.hs @@ -14,6 +14,73 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.CSS.Color" provides the 'Color' type and smart constructors for every +-- CSS color format, plus the full set of +-- . +-- +-- Colors are produced by smart constructors ('rgb', 'rgba', 'hsl', 'hsla', +-- 'oklch', 'oklcha', 'hex', 'var') and consumed by 'renderColor', which +-- serialises a 'Color' to a 'Miso.String.MisoString' suitable for use as a +-- CSS property value. All color constructors are re-exported from "Miso.CSS". +-- +-- = Color formats +-- +-- ['rgb' r g b] @rgb(r,g,b)@ β€” +-- ['rgba' r g b a] @rgba(r,g,b,a)@ β€” +-- ['hsl' h s l] @hsl(h,s,l)@ β€” +-- ['hsla' h s l a] @hsla(h,s,l,a)@ β€” +-- ['oklch' l c h] @oklch(l% c h)@ β€” +-- ['oklcha' l c h a] @oklch(l% c h / a)@ β€” +-- ['hex' s] @#s@ β€” +-- ['var' name] @var(--name)@ β€” +-- +-- = Quick start +-- +-- @ +-- import qualified "Miso.CSS" as CSS +-- import "Miso.CSS.Color" +-- +-- myView :: 'Miso.Types.View' Model Action +-- myView = +-- 'Miso.Html.Element.div_' +-- [ CSS.'Miso.CSS.style_' +-- [ CSS.'Miso.CSS.backgroundColor' 'cornflowerblue' +-- , CSS.'Miso.CSS.color' ('rgba' 255 255 255 0.9) +-- , CSS.'Miso.CSS.borderColor' ('hex' "333") +-- ] +-- ] [] +-- @ +-- +-- = Overloaded hex literals +-- +-- With @-XOverloadedLabels@, hex color strings can be written as label +-- literals directly where a 'Color' or 'Miso.String.MisoString' is expected. +-- The leading @#@ is inserted automatically: +-- +-- @ +-- {-\# LANGUAGE OverloadedLabels \#-} +-- +-- myColor :: 'Color' +-- myColor = #ff6347 -- equivalent to 'hex' \"ff6347\" +-- +-- myString :: 'Miso.String.MisoString' +-- myString = #cccccc -- equivalent to \"#cccccc\" +-- @ +-- +-- = Named colors +-- +-- All 148 +-- are available as top-level values (e.g. 'red', 'blue', 'cornflowerblue'). +-- Each is defined as an 'rgba' value with full opacity (@alpha = 1@) and +-- renders to its @rgba(…)@ form via 'renderColor'. +-- +-- = See also +-- +-- * "Miso.CSS" β€” CSS property DSL that consumes 'Color' values +-- * "Miso.CSS.Types" β€” low-level CSS types ----------------------------------------------------------------------------- module Miso.CSS.Color ( -- *** Types @@ -332,8 +399,8 @@ ----------------------------------------------------------------------------- -- | Smart constructor for a 'Hex' 'Color' -- --- >>> renderColor (hsla 0 0 0 1.0) --- "hsl(0,0,0,1.0)" +-- >>> renderColor (hex "ccc") +-- "#ccc" -- hex :: MisoString -> Color hex = Hex @@ -346,7 +413,7 @@ oklch :: Double -> Double -> Double -> Color oklch = OKLCH ----------------------------------------------------------------------------- --- | Smart constructor for an 'OKLCH' 'Color' with alpha transparency +-- | Smart constructor for an 'OKLCHA' 'Color' with alpha transparency -- -- >>> renderColor (oklcha 40.1 0.123 0.123 0.5) -- "oklcha(40.1% 0.123 0.123 / 0.5)" @@ -361,8 +428,6 @@ -- transparent :: Color transparent = rgba 0 0 0 0 --- --- data:image/svg+xml;base64, ----------------------------------------------------------------------------- -- | Smart constructor for the 'aliceblue' 'Color'. -- @@ -1557,7 +1622,7 @@ -- | Smart constructor for the 'red' 'Color'. -- -- >>> renderColor red --- "rgba (255,0,0,1.0)" +-- "rgba(255,0,0,1.0)" -- -- <> -- @@ -1727,7 +1792,7 @@ -- | Smart constructor for the 'tan' 'Color'. -- -- >>> renderColor tan --- "rgba(210,180,140,1.<> -- diff --git a/src/Miso/CSS/Types.hs b/src/Miso/CSS/Types.hs --- a/src/Miso/CSS/Types.hs +++ b/src/Miso/CSS/Types.hs @@ -1,20 +1,58 @@ ----------------------------------------------------------------------------- -- | -- Module : Miso.CSS.Types --- Copyright : (C) 2016-2026 David M. Johnson (@dmjio) +-- Copyright : (C) 2016-2026 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable -- --- Types for CSS, including inline styles and [StyleSheets](https://developer.mozilla.org/en-US/docs/Web/API/StyleSheet). +-- = Overview -- ----------------------------------------------------------------------------- +-- "Miso.CSS.Types" defines the core data types that back the CSS DSL in +-- "Miso.CSS". There are three layers: +-- +-- * 'Style' β€” a single CSS property\/value pair (@(\"color\", \"red\")@). +-- * 'Styles' β€” one rule block: either a selector rule, a +-- +-- animation, or a +-- +-- query. +-- * 'StyleSheet' β€” an ordered list of 'Styles' rule blocks that together form +-- a complete +-- . +-- +-- In normal usage you never construct these types directly β€” the smart +-- constructors in "Miso.CSS" (@sheet_@, @selector_@, @keyframes_@, @media_@) +-- build them for you. This module is exported for downstream code that +-- inspects or extends the CSS representation. +-- +-- = Type hierarchy +-- +-- @ +-- 'StyleSheet' -- rendered to a \ tag +-- └─ ['Styles'] -- one rule block each +-- β”œβ”€ 'Styles' (selector β†’ ['Style']) +-- β”œβ”€ 'KeyFrame' (animation-name β†’ [(stop, ['Style'])]) +-- └─ 'Media' (media-query β†’ [(selector, ['Style'])]) +-- +-- 'Style' = ('MisoString', 'MisoString') -- property, value +-- @ +-- +-- = See also +-- +-- * "Miso.CSS" β€” smart constructors and property combinators built on these types +-- * "Miso.CSS.Color" β€” 'Miso.CSS.Color.Color' type used as property values +----------------------------------------------------------------------------- module Miso.CSS.Types ( -- *** Types Style , Styles (..) , StyleSheet (..) + , TransformFn (..) + , KeyframeStop (..) + , MediaRule (..) + , MediaQuery (..) ) where ----------------------------------------------------------------------------- import Miso.String (MisoString) @@ -34,42 +72,59 @@ -- , alignContent "center" -- ] -- , keyframes_ "slide-in" --- [ "from" =: --- [ transform "translateX(0%)" --- ] --- , "to" =: --- [ transform "translateX(100%)" --- , backgroundColor red +-- [ from_ [ transforms [ translateX (pct 0) ] ] +-- , at (pct 50) +-- [ backgroundColor red -- , backgroundSize "10px" --- , backgroundRepeat "true" -- ] --- , pct 10 =: --- [ "foo" =: "bar" --- ] +-- , to_ [ transforms [ translateX (pct 100) ] ] -- ] --- , media_ "screen and (min-width: 480px)" --- [ "header" =: --- [ height "auto" --- ] --- , "ul" =: --- [ display "block" --- ] +-- , media_ (screen_ `and_` minWidth_ (px 480)) +-- [ rule_ "header" [ height "auto" ] +-- , rule_ "ul" [ display "block" ] -- ] -- ] -- @ -- -newtype StyleSheet = StyleSheet { getStyleSheet :: [Styles] } - deriving (Eq, Show) +newtype StyleSheet = StyleSheet + { getStyleSheet :: [Styles] + -- ^ Ordered list of CSS rule blocks that make up the stylesheet + } deriving (Eq, Show) ----------------------------------------------------------------------------- -- | Type for a CSS 'Style' -- type Style = (MisoString, MisoString) ----------------------------------------------------------------------------- --- | Type for a @Map@ of CSS 'Style'. Used with @StyleSheet@. --- It maps CSS properties to their values. +-- | An individual CSS . +-- Construct values with 'translate', 'rotate', 'scale', etc., then combine with 'transforms'. +-- +-- @ +-- transforms [ translate (px 10) (pct 50), rotate (deg 45), scaleX 1.5 ] +-- @ +-- +newtype TransformFn = TransformFn + { renderTransformFn :: MisoString + -- ^ The serialised CSS transform function string (e.g. @\"rotate(45deg)\"@) + } deriving (Eq, Show) +----------------------------------------------------------------------------- +-- | A CSS rule block. One of: a selector rule, a @\@keyframes@ animation, or a @\@media@ query. data Styles = Styles (MisoString, [Style]) | KeyFrame MisoString [(MisoString, [Style])] | Media MisoString [(MisoString, [Style])] + deriving (Eq, Show) +----------------------------------------------------------------------------- +-- | A single stop in a '@keyframes' rule. Construct with 'from_', 'to_', or 'at'. +newtype KeyframeStop = KeyframeStop { getKeyframeStop :: (MisoString, [Style]) } + deriving (Eq, Show) +----------------------------------------------------------------------------- +-- | A selector rule inside a '@media' block. Construct with 'rule_'. +newtype MediaRule = MediaRule { getMediaRule :: (MisoString, [Style]) } + deriving (Eq, Show) +----------------------------------------------------------------------------- +-- | A CSS [media query](https://developer.mozilla.org/en-US/docs/Web/CSS/CSS_media_queries). +-- Construct with 'screen_', 'print_', 'all_', 'minWidth_', etc., +-- and compose with 'and_', 'or_', 'not_'. +newtype MediaQuery = MediaQuery { renderMediaQuery :: MisoString } deriving (Eq, Show) ----------------------------------------------------------------------------- diff --git a/src/Miso/Canvas.hs b/src/Miso/Canvas.hs --- a/src/Miso/Canvas.hs +++ b/src/Miso/Canvas.hs @@ -16,7 +16,89 @@ -- Stability : experimental -- Portability : non-portable -- ----------------------------------------------------------------------------- +-- = Overview +-- +-- "Miso.Canvas" is a typed Haskell wrapper around the browser's +-- . +-- It lets you draw graphics imperatively inside a miso 'Miso.Types.View' +-- without leaving Haskell. +-- +-- The central abstraction is the 'Canvas' monad: +-- +-- @ +-- type 'Canvas' a = 'Control.Monad.Reader.ReaderT' 'CanvasContext2D' IO a +-- @ +-- +-- Every drawing operation ('fillRect', 'arc', 'fillText', …) is a 'Canvas' +-- action that reads the implicit +-- +-- and calls the corresponding JavaScript method. +-- +-- = Quick start +-- +-- Wire a canvas element into your view using 'canvas'. The runtime calls +-- @init@ once when the DOM node is created and @draw@ after every VDOM +-- update, passing the state returned by @init@: +-- +-- @ +-- import "Miso" +-- import "Miso.Canvas" +-- import qualified "Miso.CSS" as CSS +-- import qualified "Miso.CSS.Color" as Color +-- import qualified "Miso.Html.Property" as HP +-- +-- view :: Model -> 'Miso.Types.View' Model Action +-- view m = +-- 'canvas' +-- [ HP.'Miso.Html.Property.width_' \"800\", HP.'Miso.Html.Property.height_' \"480\" ] +-- (\\_ -> pure ()) -- init: no canvas-level state needed +-- (\\() -> drawScene m) -- draw: closure over current model +-- +-- drawScene :: Model -> 'Canvas' () +-- drawScene m = do +-- 'clearRect' (0, 0, 800, 480) +-- 'fillStyle' ('color' Color.'Miso.CSS.Color.cornflowerblue') +-- 'fillRect' (0, 0, 800, 480) +-- 'fillStyle' ('color' Color.'Miso.CSS.Color.white') +-- 'font' \"24px sans-serif\" +-- 'fillText' (\"Hello, miso!\", 32, 48) +-- @ +-- +-- = canvas vs canvas_ +-- +-- Two element constructors are provided: +-- +-- * 'canvas' β€” the standard variant. Acquires a @\"2d\"@ +-- 'CanvasContext2D' automatically and runs @init@ \/ @draw@ inside +-- the 'Canvas' monad. +-- +-- * 'canvas_' β€” the escape hatch. @init@ and @draw@ receive raw 'IO' +-- callbacks and a 'Miso.DSL.DOMRef', letting you hand the element off to +-- a third-party JavaScript library (e.g. Three.js, WebGL) that manages +-- its own context. +-- +-- = Styling +-- +-- 'fillStyle' and 'strokeStyle' accept a 'StyleArg', which can be a plain +-- 'Miso.CSS.Color.Color' (via 'color'), a 'Gradient' (via 'gradient'), or a +-- 'Pattern' (via 'pattern_'): +-- +-- @ +-- 'fillStyle' ('color' Color.'Miso.CSS.Color.red') +-- 'fillStyle' ('gradient' myGradient) +-- 'fillStyle' ('pattern_' myPattern) +-- @ +-- +-- Note: @'Miso.Canvas.color'@ and @'Miso.CSS.color'@ have the same name but +-- different types. Import "Miso.CSS" qualified to avoid ambiguity when using +-- both in the same file. +-- +-- = See also +-- +-- * "Miso.CSS.Color" β€” 'Miso.CSS.Color.Color' type and named colors +-- * "Miso.CSS" β€” CSS property DSL for non-canvas styling +-- * "Miso.FFI" β€” lower-level JS interop used internally +----------------------------------------------------------------------------- module Miso.Canvas ( -- * Types Canvas @@ -503,7 +585,12 @@ textBaseline = set "textBaseline" ----------------------------------------------------------------------------- -- | [gradient.addColorStop(stop,color)](https://www.w3schools.com/tags/canvas_addcolorstop.asp) -addColorStop :: (Double, Color) -> Gradient -> Canvas () +addColorStop + :: (Double, Color) + -- ^ @(stop, color)@ β€” position along the gradient (0.0–1.0) and the colour at that stop + -> Gradient + -- ^ The gradient object to add the colour stop to + -> Canvas () addColorStop args (Gradient g) = do _ <- liftIO $ g # ("addColorStop" :: MisoString) $ args pure () diff --git a/src/Miso/Concurrent.hs b/src/Miso/Concurrent.hs --- a/src/Miso/Concurrent.hs +++ b/src/Miso/Concurrent.hs @@ -8,7 +8,32 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable ----------------------------------------------------------------------------- +-- +-- = Overview +-- +-- "Miso.Concurrent" provides 'Waiter', a lightweight synchronization +-- primitive built on 'Control.Concurrent.MVar.MVar' that the miso runtime +-- uses to coordinate its event loop with subscription threads. +-- +-- Two constructors are available with different wakeup semantics: +-- +-- * 'waiter' β€” __many-to-one__. Multiple threads may call 'notify' +-- concurrently; only one pending notification is retained at a time +-- ('Control.Concurrent.MVar.tryPutMVar' is used, so rapid notifications +-- coalesce). The single consumer calls 'wait' to block until at least one +-- notification arrives. +-- +-- * 'oneshot' β€” __one-to-many__. One thread calls 'notify' to permanently +-- unblock /all/ threads currently (or subsequently) calling 'wait'. +-- Implemented with 'Control.Concurrent.MVar.readMVar', so the stored value +-- is never consumed. +-- +-- = See also +-- +-- * "Miso.Effect" β€” 'Miso.Effect.Sub' subscriptions that use 'notify' to +-- wake the event loop +-- * "Miso.Runtime" β€” the event loop that calls 'wait' +----------------------------------------------------------------------------- module Miso.Concurrent ( -- ** Synchronization primitives Waiter (..) diff --git a/src/Miso/DSL.hs b/src/Miso/DSL.hs --- a/src/Miso/DSL.hs +++ b/src/Miso/DSL.hs @@ -6,9 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE DataKinds #-} @@ -19,13 +17,97 @@ ----------------------------------------------------------------------------- -- | -- Module : Miso.DSL --- Copyright : (C) 2016-2026 David M. Johnson (@dmjio) +-- Copyright : (C) 2016-2026 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable -- --- A JavaScript DSL for interacting with the browser or JS runtime environments. +-- = Overview +-- +-- "Miso.DSL" is the low-level JavaScript interop layer for miso. It provides +-- the marshaling typeclasses, JS value types, and combinators needed to call +-- browser APIs and exchange data with JavaScript from Haskell. +-- +-- Most miso users never import this module directly β€” higher-level modules +-- ("Miso.FFI", "Miso.Canvas", "Miso.Fetch", etc.) build on top of it. +-- Import it directly when writing custom FFI bindings or inline JS. +-- +-- = Marshaling +-- +-- Two typeclasses handle the Haskell ↔ JavaScript boundary: +-- +-- * 'ToJSVal' β€” converts a Haskell value into a 'JSVal'. Instances exist +-- for all primitive types, lists, tuples (up to 6), 'Maybe', and +-- 'Data.Map.Strict.Map' 'Miso.String.MisoString'. Product record types can +-- derive 'ToJSVal' via @GHC.Generics@ (sum types are not supported). +-- +-- * 'FromJSVal' β€” parses a 'JSVal' back into Haskell, returning +-- @'Maybe' a@ ('Nothing' on type mismatch or missing field). +-- Use 'fromJSValUnchecked' when the shape is guaranteed by the caller. +-- Product record types can derive 'FromJSVal' via @GHC.Generics@. +-- +-- Two auxiliary classes support the calling convention: +-- +-- * 'ToArgs' β€” marshals a Haskell value to a @['JSVal']@ argument list. +-- Tuples up to arity 6 automatically produce the correct positional list. +-- +-- * 'ToObject' β€” promotes a value to a JS 'Object' for use as the @this@ +-- receiver in method calls. +-- +-- = Accessing the global scope +-- +-- @ +-- -- Read a global variable +-- x <- 'jsg' \"innerWidth\" -- globalThis.innerWidth +-- +-- -- Call a global function +-- 'jsg0' \"requestAnimationFrame\" -- no args +-- 'jsg1' \"parseInt\" (\"42\" :: 'Miso.String.MisoString') -- one arg +-- 'jsgf' \"encodeURIComponent\" args -- arbitrary ToArgs +-- @ +-- +-- = Property access and method calls +-- +-- @ +-- obj '!' \"name\" -- get obj.name :: IO JSVal +-- obj '!!' 3 -- get obj[3] :: IO JSVal +-- obj '#' \"push\" [val] -- call obj.push(val) :: IO JSVal +-- 'setField' obj \"x\" 10 -- obj.x = 10 +-- 'getProp' \"x\" obj -- obj.x +-- 'setProp' \"x\" 10 obj -- obj.x = 10 +-- @ +-- +-- = Object creation +-- +-- @ +-- o <- 'create' -- new empty object {} +-- o <- 'createWith' [(\"x\", 1), (\"y\", 2)] -- { x: 1, y: 2 } +-- v <- 'new' constructor args -- new Constructor(...args) +-- @ +-- +-- = Callbacks +-- +-- Wrap a Haskell @IO@ action as a JS function. Variants ending in @\'@ +-- return the 'JSVal' of the callback's return value. +-- +-- @ +-- cb <- 'syncCallback' action -- () -> () +-- cb1 <- 'syncCallback1' (\\x -> …) -- (x) -> () +-- cb2 <- 'syncCallback2' (\\x y -> …) -- (x, y) -> () +-- @ +-- +-- Always free callbacks when they are no longer needed to avoid leaks: +-- +-- @ +-- 'freeFunction' cb +-- @ +-- +-- = See also +-- +-- * "Miso.FFI" β€” higher-level browser API wrappers built on this module +-- * "Miso.FFI.QQ" β€” the @[js| … |]@ quasi-quoter for inline JavaScript +-- * "Miso.Canvas" β€” canvas 2D API using 'ToArgs' and 'ToJSVal' ----------------------------------------------------------------------------- module Miso.DSL ( -- * Classes @@ -374,7 +456,13 @@ {-# INLINABLE jsg #-} ----------------------------------------------------------------------------- -- | Invokes a function with a specified argument list -jsgf :: ToArgs args => MisoString -> args -> IO JSVal +jsgf + :: ToArgs args + => MisoString + -- ^ Global function name on @globalThis@ + -> args + -- ^ Arguments to pass to the function + -> IO JSVal jsgf name = global # name {-# INLINABLE jsgf #-} ----------------------------------------------------------------------------- @@ -389,7 +477,13 @@ {-# INLINABLE jsg1 #-} ----------------------------------------------------------------------------- -- | Invokes a function with 2 arguments -jsg2 :: (ToJSVal arg1, ToJSVal arg2) => MisoString -> arg1 -> arg2 -> IO JSVal +jsg2 + :: (ToJSVal arg1, ToJSVal arg2) + => MisoString + -- ^ Global function name on @globalThis@ + -> arg1 -- ^ First argument + -> arg2 -- ^ Second argument + -> IO JSVal jsg2 name arg1 arg2 = do arg1_ <- toJSVal arg1 arg2_ <- toJSVal arg2 @@ -397,12 +491,14 @@ {-# INLINABLE jsg2 #-} ----------------------------------------------------------------------------- -- | Invokes a function with 3 arguments -jsg3 :: (ToJSVal arg1, ToJSVal arg2, ToJSVal arg3) - => MisoString - -> arg1 - -> arg2 - -> arg3 - -> IO JSVal +jsg3 + :: (ToJSVal arg1, ToJSVal arg2, ToJSVal arg3) + => MisoString + -- ^ Global function name on @globalThis@ + -> arg1 -- ^ First argument + -> arg2 -- ^ Second argument + -> arg3 -- ^ Third argument + -> IO JSVal jsg3 name arg1 arg2 arg3 = do arg1_ <- toJSVal arg1 arg2_ <- toJSVal arg2 @@ -445,7 +541,15 @@ {-# INLINABLE jsg5 #-} ----------------------------------------------------------------------------- -- | Sets a field on an Object at a specified field -setField :: (ToObject o, ToJSVal v) => o -> MisoString -> v -> IO () +setField + :: (ToObject o, ToJSVal v) + => o + -- ^ JavaScript object to mutate + -> MisoString + -- ^ Field name to set + -> v + -- ^ Value to assign + -> IO () setField o k v = do o' <- toJSVal =<< toObject o v' <- toJSVal v @@ -474,7 +578,15 @@ {-# INLINABLE listProps #-} ----------------------------------------------------------------------------- -- | Calls a JS function on an t'Object' at a field with specified arguments. -call :: (ToObject obj, ToObject this, ToArgs args) => obj -> this -> args -> IO JSVal +call + :: (ToObject obj, ToObject this, ToArgs args) + => obj + -- ^ The function object to call + -> this + -- ^ The @this@ context to bind for the call + -> args + -- ^ Arguments to pass to the function + -> IO JSVal call o this args = do o' <- toJSVal =<< toObject o this' <- toJSVal =<< toObject this @@ -492,7 +604,13 @@ invokeFunction func o' args' {-# INLINABLE (#) #-} ----------------------------------------------------------------------------- -apply :: (FromJSVal a, ToArgs args) => Function -> args -> IO a +apply + :: (FromJSVal a, ToArgs args) + => Function + -- ^ JavaScript function to invoke + -> args + -- ^ Arguments to pass to the function + -> IO a apply (Function func) args = do o <- toJSVal global fromJSValUnchecked =<< do @@ -501,7 +619,13 @@ {-# INLINABLE apply #-} ----------------------------------------------------------------------------- -- | Instantiates a new JS t'Object'. -new :: (ToObject constructor, ToArgs args) => constructor -> args -> IO JSVal +new + :: (ToObject constructor, ToArgs args) + => constructor + -- ^ JavaScript constructor function (e.g. @jsg \"Array\"@) + -> args + -- ^ Constructor arguments + -> IO JSVal new constr args = do obj <- toJSVal =<< toObject constr argv <- toJSVal =<< toArgs args @@ -533,12 +657,26 @@ {-# INLINABLE createWith #-} ----------------------------------------------------------------------------- -- | Sets a property on a JS t'Object' -setProp :: ToJSVal val => MisoString -> val -> Object -> IO () +setProp + :: ToJSVal val + => MisoString + -- ^ Property name to set + -> val + -- ^ Value to assign + -> Object + -- ^ Target JavaScript object + -> IO () setProp k v (Object o) = flip (setProp_ffi k) o =<< toJSVal v {-# INLINABLE setProp #-} ----------------------------------------------------------------------------- -- | Retrieves a property from a JS t'Object' -getProp :: ToObject o => MisoString -> o -> IO JSVal +getProp + :: ToObject o + => MisoString + -- ^ Property name to read + -> o + -- ^ JavaScript object to read from + -> IO JSVal getProp k v = getProp_ffi k =<< toJSVal (toObject v) {-# INLINABLE getProp #-} ----------------------------------------------------------------------------- diff --git a/src/Miso/Data/Array.hs b/src/Miso/Data/Array.hs --- a/src/Miso/Data/Array.hs +++ b/src/Miso/Data/Array.hs @@ -5,20 +5,56 @@ ----------------------------------------------------------------------------- -- | -- Module : Miso.Data.Array --- Copyright : (C) 2016-2026 David M. Johnson (@dmjio) +-- Copyright : (C) 2016-2026 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable -- --- Mutable 'Array' data structure in 'IO'. +-- = Overview -- --- A JavaScript [Array](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Array). This is a convenience for manipulating JavaScript data structures from Haskell. +-- "Miso.Data.Array" is a Haskell wrapper around the JavaScript +-- +-- object. Values of type @'Array' a@ live in JavaScript memory; all +-- operations run in 'IO' and mutate the underlying JS array in place. -- --- We recommend using this module qualified. +-- Use this module when you need to pass a JS-native array to a browser API +-- or a third-party JavaScript library. For pure Haskell data processing, +-- prefer ordinary lists or 'Data.Map.Strict.Map'. -- --- > import qualified Miso.Data.Array as M +-- Import qualified to avoid clashing with 'Prelude': -- +-- @ +-- import qualified "Miso.Data.Array" as A +-- @ +-- +-- = Quick start +-- +-- @ +-- import qualified "Miso.Data.Array" as A +-- +-- example :: IO () +-- example = do +-- arr <- A.'fromList' [10, 20, 30 :: Int] +-- A.'push' 40 arr +-- v <- A.'lookup' 2 arr -- Just 30 +-- n <- A.'size' arr -- 4 +-- xs <- A.'toList' arr -- [10, 20, 30, 40] +-- pure () +-- @ +-- +-- = Operations +-- +-- * __Construction__: 'new', 'fromList', 'singleton' +-- * __Deconstruction__: 'toList' +-- * __Access__: 'lookup', '(!?)', 'member', 'size', 'null' +-- * __Mutation__: 'insert', 'push', 'pop', 'shift', 'unshift', 'splice', 'reverse' +-- +-- = See also +-- +-- * "Miso.Data.Map" β€” mutable JS 'Miso.Data.Map.Map' +-- * "Miso.Data.Set" β€” mutable JS 'Miso.Data.Set.Set' +-- * "Miso.DSL" β€” 'Miso.DSL.ToJSVal' \/ 'Miso.DSL.FromJSVal' used by element types ----------------------------------------------------------------------------- module Miso.Data.Array ( -- * Type @@ -60,23 +96,49 @@ new = Array <$> DSL.new (jsg "Array") ([] :: [JSVal]) ----------------------------------------------------------------------------- -- | Inserts a value into the t'Array' by value. -insert :: ToJSVal value => Int -> value -> Array value -> IO () +insert + :: ToJSVal value + => Int + -- ^ Index at which to insert the value (0-based) + -> value + -- ^ Value to store at that index + -> Array value + -- ^ Array to mutate + -> IO () insert key value (Array m) = do - _ <- (DSL.Object m) DSL.<## key $ value + _ <- DSL.Object m DSL.<## key $ value pure () ----------------------------------------------------------------------------- --- | Inserts a value into the t'Array' by value. -push :: ToJSVal value => value -> Array value -> IO () +-- | Appends a value to the end of the t'Array'. +push + :: ToJSVal value + => value + -- ^ Value to append + -> Array value + -- ^ Array to mutate + -> IO () push value (Array m) = do _ <- callFunction m "push" [value] pure () ----------------------------------------------------------------------------- -- | Look up a value in the array by key. -lookup :: FromJSVal value => Int -> Array value -> IO (Maybe value) +lookup + :: FromJSVal value + => Int + -- ^ 0-based index to look up + -> Array value + -- ^ Array to query + -> IO (Maybe value) lookup key m = DSL.fromJSValUnchecked =<< m DSL.!! key ----------------------------------------------------------------------------- --- | Look up a value in the array by key. -(!?) :: FromJSVal value => Int -> Array value -> IO value +-- | Look up a value in the array by index, throwing if out of bounds. +(!?) + :: FromJSVal value + => Int + -- ^ 0-based index to look up + -> Array value + -- ^ Array to query + -> IO value (!?) key m = lookup key m >>= \case Nothing -> @@ -93,19 +155,39 @@ null m = (== 0) <$> size m ----------------------------------------------------------------------------- -- | Checks existence of 'value' in t'Array', returns t'Bool. -member :: ToJSVal value => value -> Array value -> IO Bool +member + :: ToJSVal value + => value + -- ^ Value to search for (uses JavaScript @SameValueZero@ equality) + -> Array value + -- ^ Array to search + -> IO Bool member value (Array m) = DSL.fromJSValUnchecked =<< callFunction m "includes" =<< DSL.toJSVal value ----------------------------------------------------------------------------- -- | Splices an array. See [splice](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Array/splice). -splice :: ToJSVal value => Int -> Int -> [value] -> Array value -> IO (Array value) +splice + :: ToJSVal value + => Int + -- ^ Start index (0-based) at which to begin the splice + -> Int + -- ^ Number of elements to remove starting at @start@ + -> [value] + -- ^ Elements to insert at @start@ after the removal + -> Array value + -- ^ Array to mutate in place + -> IO (Array value) splice start deleteCount xs (Array m) = do s <- DSL.toJSVal start d <- DSL.toJSVal deleteCount args <- mapM DSL.toJSVal xs Array <$> do callFunction m "splice" $ [s,d] ++ args ----------------------------------------------------------------------------- --- | Construct a t'Array' from a list of value value pairs. -fromList :: ToJSVal value => [value] -> IO (Array value) +-- | Construct a t'Array' from a list of values. +fromList + :: ToJSVal value + => [value] + -- ^ Elements to populate the new array with (in order) + -> IO (Array value) fromList xs = do m <- new forM_ (zip [0..] xs) $ \(k,v) -> @@ -120,7 +202,11 @@ ----------------------------------------------------------------------------- -- | Creates a new Array with a single element. -- -singleton :: ToJSVal a => a -> IO (Array a) +singleton + :: ToJSVal a + => a + -- ^ The single element for the new array + -> IO (Array a) singleton x = fromList [x] ----------------------------------------------------------------------------- -- | Removes the last element from an array and returns it. @@ -137,7 +223,13 @@ ----------------------------------------------------------------------------- -- | Adds one or more elements to the beginning of an array. -- -unshift :: ToJSVal a => a -> Array a -> IO Int +unshift + :: ToJSVal a + => a + -- ^ Element to prepend at index 0 + -> Array a + -- ^ Array to mutate + -> IO Int unshift x (Array arr) = DSL.fromJSValUnchecked =<< callFunction arr "unshift" [x] ----------------------------------------------------------------------------- -- | Reverses an array in-place. diff --git a/src/Miso/Data/Map.hs b/src/Miso/Data/Map.hs --- a/src/Miso/Data/Map.hs +++ b/src/Miso/Data/Map.hs @@ -4,20 +4,59 @@ ----------------------------------------------------------------------------- -- | -- Module : Miso.Data.Map --- Copyright : (C) 2016-2026 David M. Johnson (@dmjio) +-- Copyright : (C) 2016-2026 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable -- --- Mutable 'Map' data structure in 'IO'. +-- = Overview -- --- A JavaScript [Map](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Map). This is a convenience for manipulating JavaScript data structures from Haskell. +-- "Miso.Data.Map" is a Haskell wrapper around the JavaScript +-- +-- object. Values of type @'Map' k v@ live in JavaScript memory; all +-- operations run in 'IO' and mutate the underlying JS map in place. -- --- We recommend using this module qualified. +-- Unlike 'Data.Map.Strict.Map', keys do not require an 'Ord' instance β€” +-- any type with a 'Miso.DSL.ToJSVal' instance can serve as a key, including +-- JS objects and numeric values that compare by identity. -- --- > import qualified Miso.Data.Map as M +-- Use this module when you need to share a key-value structure with a browser +-- API or a third-party JavaScript library. For pure Haskell processing, +-- prefer 'Data.Map.Strict.Map'. -- +-- Import qualified to avoid clashing with 'Prelude': +-- +-- @ +-- import qualified "Miso.Data.Map" as M +-- @ +-- +-- = Quick start +-- +-- @ +-- import qualified "Miso.Data.Map" as M +-- +-- example :: IO () +-- example = do +-- m <- M.'fromList' [(\"a\", 1), (\"b\", 2 :: Int)] +-- M.'insert' \"c\" 3 m +-- v <- M.'lookup' \"b\" m -- Just 2 +-- n <- M.'size' m -- 3 +-- M.'delete' \"a\" m +-- pure () +-- @ +-- +-- = Operations +-- +-- * __Construction__: 'new', 'fromList' +-- * __Access__: 'lookup', 'has', 'size' +-- * __Mutation__: 'insert', 'delete', 'clear' +-- +-- = See also +-- +-- * "Miso.Data.Array" β€” mutable JS 'Miso.Data.Array.Array' +-- * "Miso.Data.Set" β€” mutable JS 'Miso.Data.Set.Set' +-- * "Miso.DSL" β€” 'Miso.DSL.ToJSVal' \/ 'Miso.DSL.FromJSVal' used by key and value types ----------------------------------------------------------------------------- module Miso.Data.Map ( -- * Type @@ -49,13 +88,27 @@ new = Map <$> DSL.new (jsg "Map") ([] :: [JSVal]) ----------------------------------------------------------------------------- -- | Inserts a value into the t'Map' by key. -insert :: (ToJSVal key, ToJSVal value) => key -> value -> Map key value -> IO () +insert + :: (ToJSVal key, ToJSVal value) + => key + -- ^ Key to associate the value with + -> value + -- ^ Value to store + -> Map key value + -- ^ Map to mutate + -> IO () insert key value (Map m) = do _ <- callFunction m "set" (key, value) pure () ----------------------------------------------------------------------------- -- | Finds a value in the t'Map' by key. -lookup :: (ToJSVal key, FromJSVal value) => key -> Map key value -> IO (Maybe value) +lookup + :: (ToJSVal key, FromJSVal value) + => key + -- ^ Key to look up + -> Map key value + -- ^ Map to query + -> IO (Maybe value) lookup key (Map m) = DSL.fromJSValUnchecked =<< callFunction m "get" =<< DSL.toJSVal key ----------------------------------------------------------------------------- -- | Empties the t'Map'. @@ -67,15 +120,31 @@ size (Map m) = DSL.fromJSValUnchecked =<< m ! "size" ----------------------------------------------------------------------------- -- | Checks existence of a value by 'key', returns t'Bool. -has :: ToJSVal key => key -> Map key value -> IO Bool +has + :: ToJSVal key + => key + -- ^ Key to test for membership + -> Map key value + -- ^ Map to query + -> IO Bool has key (Map m) = DSL.fromJSValUnchecked =<< callFunction m "has" =<< DSL.toJSVal key ----------------------------------------------------------------------------- --- | Removes an entry from a list, returns if the value was removed as t'Bool'. -delete :: ToJSVal key => key -> Map key value -> IO Bool +-- | Removes an entry from the t'Map', returns 'True' if the key existed. +delete + :: ToJSVal key + => key + -- ^ Key to remove + -> Map key value + -- ^ Map to mutate + -> IO Bool delete key (Map m) = DSL.fromJSValUnchecked =<< callFunction m "delete" =<< DSL.toJSVal key ----------------------------------------------------------------------------- -- | Construct a t'Map' from a list of key value pairs. -fromList :: (ToJSVal key, ToJSVal value) => [(key, value)] -> IO (Map key value) +fromList + :: (ToJSVal key, ToJSVal value) + => [(key, value)] + -- ^ Key-value pairs to populate the new map with + -> IO (Map key value) fromList xs = do m <- new forM_ xs $ \(k,v) -> diff --git a/src/Miso/Data/Set.hs b/src/Miso/Data/Set.hs --- a/src/Miso/Data/Set.hs +++ b/src/Miso/Data/Set.hs @@ -4,20 +4,62 @@ ----------------------------------------------------------------------------- -- | -- Module : Miso.Data.Set --- Copyright : (C) 2016-2026 David M. Johnson (@dmjio) +-- Copyright : (C) 2016-2026 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable -- --- Mutable 'Set' data structure in 'IO'. +-- = Overview -- --- A JavaScript [Set](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Set). This is a convenience for manipulating JavaScript data structures from Haskell. +-- "Miso.Data.Set" is a Haskell wrapper around the JavaScript +-- +-- object. Values of type @'Set' a@ live in JavaScript memory; all +-- operations run in 'IO' and mutate the underlying JS set in place. -- --- We recommend using this module qualified. +-- Unlike 'Data.Set.Set', elements do not require an 'Ord' instance β€” +-- any type with a 'Miso.DSL.ToJSVal' instance can be stored, and equality +-- is determined by JavaScript's +-- +-- algorithm. -- --- > import qualified Miso.Data.Set as M +-- Use this module when you need to share a set with a browser API or a +-- third-party JavaScript library. For pure Haskell processing, prefer +-- 'Data.Set.Set'. -- +-- Import qualified to avoid clashing with 'Prelude': +-- +-- @ +-- import qualified "Miso.Data.Set" as S +-- @ +-- +-- = Quick start +-- +-- @ +-- import qualified "Miso.Data.Set" as S +-- +-- example :: IO () +-- example = do +-- s <- S.'fromList' [1, 2, 3 :: Int] +-- S.'insert' 4 s +-- b <- S.'member' 2 s -- True +-- n <- S.'size' s -- 4 +-- S.'delete' 1 s +-- pure () +-- @ +-- +-- = Operations +-- +-- * __Construction__: 'new', 'fromList' +-- * __Access__: 'member', 'size' +-- * __Mutation__: 'insert', 'delete', 'clear' +-- * __Set algebra__: 'union', 'intersection', 'difference', 'isSubset', 'isSuperset', 'isDisjoint' +-- +-- = See also +-- +-- * "Miso.Data.Array" β€” mutable JS 'Miso.Data.Array.Array' +-- * "Miso.Data.Map" β€” mutable JS 'Miso.Data.Map.Map' +-- * "Miso.DSL" β€” 'Miso.DSL.ToJSVal' \/ 'Miso.DSL.FromJSVal' used by element types ----------------------------------------------------------------------------- module Miso.Data.Set ( -- * Type @@ -53,8 +95,14 @@ new :: IO (Set key) new = Set <$> DSL.new (jsg "Set") ([] :: [JSVal]) ----------------------------------------------------------------------------- --- | Inserts a value into the t'Set' by key. -insert :: ToJSVal key => key -> Set key -> IO () +-- | Inserts a value into the t'Set'. +insert + :: ToJSVal key + => key + -- ^ Element to add + -> Set key + -- ^ Set to mutate + -> IO () insert key (Set m) = do _ <- callFunction m "add" [key] pure () @@ -68,15 +116,31 @@ size (Set m) = DSL.fromJSValUnchecked =<< m ! "size" ----------------------------------------------------------------------------- -- | Checks existence of 'key' in t'Set', returns t'Bool. -member :: ToJSVal key => key -> Set key -> IO Bool +member + :: ToJSVal key + => key + -- ^ Element to test for membership + -> Set key + -- ^ Set to query + -> IO Bool member key (Set m) = DSL.fromJSValUnchecked =<< callFunction m "has" =<< DSL.toJSVal key ----------------------------------------------------------------------------- --- | Removes an entry from a list, returns if the value was removed as t'Bool'. -delete :: ToJSVal key => key -> Set key -> IO Bool +-- | Removes an element from the t'Set', returns 'True' if it existed. +delete + :: ToJSVal key + => key + -- ^ Element to remove + -> Set key + -- ^ Set to mutate + -> IO Bool delete key (Set m) = DSL.fromJSValUnchecked =<< callFunction m "delete" =<< DSL.toJSVal key ----------------------------------------------------------------------------- --- | Construct a t'Set' from a list of key value pairs. -fromList :: ToJSVal key => [key] -> IO (Set key) +-- | Construct a t'Set' from a list of elements. +fromList + :: ToJSVal key + => [key] + -- ^ Elements to populate the new set with + -> IO (Set key) fromList xs = do m <- new forM_ xs $ \k -> @@ -84,29 +148,53 @@ pure m ----------------------------------------------------------------------------- -- | The union of two t'Set' -union :: ToJSVal key => Set key -> Set key -> IO (Set key) +union + :: ToJSVal key + => Set key -- ^ First set + -> Set key -- ^ Second set + -> IO (Set key) union (Set x) (Set y) = Set <$> callFunction x "union" [y] ----------------------------------------------------------------------------- -- | The intersection of two t'Set' -intersection :: ToJSVal key => Set key -> Set key -> IO (Set key) +intersection + :: ToJSVal key + => Set key -- ^ First set + -> Set key -- ^ Second set + -> IO (Set key) intersection (Set x) (Set y) = Set <$> callFunction x "intersection" [y] ----------------------------------------------------------------------------- -- | The symmetric difference of two t'Set' -difference :: ToJSVal key => Set key -> Set key -> IO (Set key) +difference + :: ToJSVal key + => Set key -- ^ First set + -> Set key -- ^ Second set + -> IO (Set key) difference (Set x) (Set y) = Set <$> callFunction x "symmetricDifference" [y] ----------------------------------------------------------------------------- -- | Checks if one t'Set' is a subset of another t'Set' -isSubset :: ToJSVal key => Set key -> Set key -> IO Bool +isSubset + :: ToJSVal key + => Set key -- ^ Candidate subset + -> Set key -- ^ Potential superset + -> IO Bool isSubset (Set x) (Set y) = DSL.fromJSValUnchecked =<< callFunction x "isSubsetOf" [y] ----------------------------------------------------------------------------- -- | Checks if one t'Set' is a superset of another t'Set' -isSuperset :: ToJSVal key => Set key -> Set key -> IO Bool +isSuperset + :: ToJSVal key + => Set key -- ^ Candidate superset + -> Set key -- ^ Potential subset + -> IO Bool isSuperset (Set x) (Set y) = DSL.fromJSValUnchecked =<< callFunction x "isSupersetOf" [y] ----------------------------------------------------------------------------- -- | Checks if one t'Set' is disjoint from another t'Set' -isDisjoint :: ToJSVal key => Set key -> Set key -> IO Bool +isDisjoint + :: ToJSVal key + => Set key -- ^ First set + -> Set key -- ^ Second set (disjoint means they share no elements) + -> IO Bool isDisjoint (Set x) (Set y) = DSL.fromJSValUnchecked =<< callFunction x "isDisjointFrom" [y] ----------------------------------------------------------------------------- diff --git a/src/Miso/Date.hs b/src/Miso/Date.hs --- a/src/Miso/Date.hs +++ b/src/Miso/Date.hs @@ -4,20 +4,66 @@ ----------------------------------------------------------------------------- -- | -- Module : Miso.Date --- Copyright : (C) 2016-2026 David M. Johnson (@dmjio) +-- Copyright : (C) 2016-2026 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable -- --- Mutable 'Date' data structure in 'IO'. +-- = Overview -- --- A JavaScript [Date](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date). This is a convenience for manipulating JavaScript data structures from Haskell. +-- "Miso.Date" is a Haskell wrapper around the JavaScript +-- +-- object. A 'Date' value lives in JavaScript memory and represents a single +-- point in time. All operations run in 'IO' and call through to the +-- underlying JS object. -- --- We recommend using this module qualified. +-- Import qualified to avoid clashing with 'Prelude': -- --- > import qualified Miso.Date as D +-- @ +-- import qualified "Miso.Date" as D +-- @ -- +-- = Quick start +-- +-- @ +-- import qualified "Miso.Date" as D +-- +-- example :: IO () +-- example = do +-- now <- D.'new' +-- iso <- D.'toISOString' now -- e.g. \"2026-06-23T12:00:00.000Z\" +-- year <- D.'getFullYear' now -- e.g. 2026 +-- ms <- D.'valueOf' now -- milliseconds since Unix epoch +-- pure () +-- @ +-- +-- = API groups +-- +-- * __Construction__: 'new' +-- * __Conversion__ (strings): 'toDateString', 'toISOString', 'toJSON', +-- 'toLocaleDateString', 'toLocaleString', 'toLocaleTimeString', +-- 'toString', 'toTimeString', 'toUTCString' +-- * __Conversion__ (numeric): 'valueOf' (ms since epoch) +-- * __Local getters__: 'getDate', 'getDay', 'getFullYear', 'getHours', +-- 'getMilliseconds', 'getMinutes', 'getMonth', 'getSeconds', +-- 'getTime', 'getTimezoneOffset' +-- * __UTC getters__: 'getUTCDate', 'getUTCDay', 'getUTCFullYear', +-- 'getUTCHours', 'getUTCMilliseconds', 'getUTCMinutes', +-- 'getUTCMonth', 'getUTCSeconds' +-- * __Local setters__: 'setDate', 'setFullYear', 'setHours', +-- 'setMilliseconds', 'setMinutes', 'setMonth', 'setSeconds', 'setTime' +-- * __UTC setters__: 'setUTCDate', 'setUTCFullYear', 'setUTCHours', +-- 'setUTCMilliseconds', 'setUTCMinutes', 'setUTCMonth', 'setUTCSeconds' +-- +-- __Note__: JavaScript months are __0-indexed__ (January = 0, December = 11). +-- All getter and setter functions in this module follow that convention. +-- Setter functions return the new timestamp as milliseconds since the Unix +-- epoch (a 'Double'), mirroring the JavaScript return value. +-- +-- = See also +-- +-- * "Miso.DSL" β€” 'Miso.DSL.JSVal' and marshaling used internally ----------------------------------------------------------------------------- module Miso.Date ( -- * Type @@ -254,12 +300,26 @@ ----------------------------------------------------------------------------- -- | Sets the day of the month. -- -setDate :: Int -> Date -> IO Double +setDate + :: Int + -- ^ Day of the month (1–31) + -> Date + -- ^ Date object to modify + -> IO Double setDate day (Date d) = DSL.fromJSValUnchecked =<< callFunction d "setDate" [day] ----------------------------------------------------------------------------- -- | Sets the full year, with optional month and day. -- -setFullYear :: Int -> Maybe Int -> Maybe Int -> Date -> IO Double +setFullYear + :: Int + -- ^ Full year (e.g. 2026) + -> Maybe Int + -- ^ Optional month (0-indexed: 0 = January) + -> Maybe Int + -- ^ Optional day of the month (1–31) + -> Date + -- ^ Date object to modify + -> IO Double setFullYear year month day (Date d) = do y <- DSL.toJSVal year m <- traverse DSL.toJSVal month @@ -268,7 +328,18 @@ ----------------------------------------------------------------------------- -- | Sets the hour, with optional minutes, seconds, and milliseconds. -- -setHours :: Int -> Maybe Int -> Maybe Int -> Maybe Int -> Date -> IO Double +setHours + :: Int + -- ^ Hour (0–23) + -> Maybe Int + -- ^ Optional minutes (0–59) + -> Maybe Int + -- ^ Optional seconds (0–59) + -> Maybe Int + -- ^ Optional milliseconds (0–999) + -> Date + -- ^ Date object to modify + -> IO Double setHours hours minutes seconds millis (Date d) = do h <- DSL.toJSVal hours m <- traverse DSL.toJSVal minutes @@ -278,12 +349,26 @@ ----------------------------------------------------------------------------- -- | Sets the milliseconds. -- -setMilliseconds :: Int -> Date -> IO Double +setMilliseconds + :: Int + -- ^ Milliseconds (0–999) + -> Date + -- ^ Date object to modify + -> IO Double setMilliseconds ms (Date d) = DSL.fromJSValUnchecked =<< callFunction d "setMilliseconds" [ms] ----------------------------------------------------------------------------- -- | Sets the minutes, with optional seconds and milliseconds. -- -setMinutes :: Int -> Maybe Int -> Maybe Int -> Date -> IO Double +setMinutes + :: Int + -- ^ Minutes (0–59) + -> Maybe Int + -- ^ Optional seconds (0–59) + -> Maybe Int + -- ^ Optional milliseconds (0–999) + -> Date + -- ^ Date object to modify + -> IO Double setMinutes minutes seconds millis (Date d) = do m <- DSL.toJSVal minutes s <- traverse DSL.toJSVal seconds @@ -292,7 +377,14 @@ ----------------------------------------------------------------------------- -- | Sets the month, with optional day of the month. -- -setMonth :: Int -> Maybe Int -> Date -> IO Double +setMonth + :: Int + -- ^ Month (0-indexed: 0 = January, 11 = December) + -> Maybe Int + -- ^ Optional day of the month (1–31) + -> Date + -- ^ Date object to modify + -> IO Double setMonth month day (Date d) = do m <- DSL.toJSVal month d' <- traverse DSL.toJSVal day @@ -300,7 +392,14 @@ ----------------------------------------------------------------------------- -- | Sets the seconds, with optional milliseconds. -- -setSeconds :: Int -> Maybe Int -> Date -> IO Double +setSeconds + :: Int + -- ^ Seconds (0–59) + -> Maybe Int + -- ^ Optional milliseconds (0–999) + -> Date + -- ^ Date object to modify + -> IO Double setSeconds seconds millis (Date d) = do s <- DSL.toJSVal seconds ms <- traverse DSL.toJSVal millis @@ -308,17 +407,36 @@ ----------------------------------------------------------------------------- -- | Sets the time in milliseconds since epoch. -- -setTime :: Double -> Date -> IO Double +setTime + :: Double + -- ^ Milliseconds since the Unix epoch (1 January 1970 00:00:00 UTC) + -> Date + -- ^ Date object to modify + -> IO Double setTime time (Date d) = DSL.fromJSValUnchecked =<< callFunction d "setTime" [time] ----------------------------------------------------------------------------- -- | Sets the UTC day of the month. -- -setUTCDate :: Int -> Date -> IO Double +setUTCDate + :: Int + -- ^ Day of the month in UTC (1–31) + -> Date + -- ^ Date object to modify + -> IO Double setUTCDate day (Date d) = DSL.fromJSValUnchecked =<< callFunction d "setUTCDate" [day] ----------------------------------------------------------------------------- -- | Sets the UTC full year, with optional month and day. -- -setUTCFullYear :: Int -> Maybe Int -> Maybe Int -> Date -> IO Double +setUTCFullYear + :: Int + -- ^ Full year in UTC (e.g. 2026) + -> Maybe Int + -- ^ Optional month in UTC (0-indexed) + -> Maybe Int + -- ^ Optional day in UTC (1–31) + -> Date + -- ^ Date object to modify + -> IO Double setUTCFullYear year month day (Date d) = do y <- DSL.toJSVal year m <- traverse DSL.toJSVal month @@ -327,7 +445,18 @@ ----------------------------------------------------------------------------- -- | Sets the UTC hour, with optional minutes, seconds, and milliseconds. -- -setUTCHours :: Int -> Maybe Int -> Maybe Int -> Maybe Int -> Date -> IO Double +setUTCHours + :: Int + -- ^ Hour in UTC (0–23) + -> Maybe Int + -- ^ Optional minutes (0–59) + -> Maybe Int + -- ^ Optional seconds (0–59) + -> Maybe Int + -- ^ Optional milliseconds (0–999) + -> Date + -- ^ Date object to modify + -> IO Double setUTCHours hours minutes seconds millis (Date d) = do h <- DSL.toJSVal hours m <- traverse DSL.toJSVal minutes @@ -337,12 +466,26 @@ ----------------------------------------------------------------------------- -- | Sets the UTC milliseconds. -- -setUTCMilliseconds :: Int -> Date -> IO Double +setUTCMilliseconds + :: Int + -- ^ Milliseconds in UTC (0–999) + -> Date + -- ^ Date object to modify + -> IO Double setUTCMilliseconds ms (Date d) = DSL.fromJSValUnchecked =<< callFunction d "setUTCMilliseconds" [ms] ----------------------------------------------------------------------------- -- | Sets the UTC minutes, with optional seconds and milliseconds. -- -setUTCMinutes :: Int -> Maybe Int -> Maybe Int -> Date -> IO Double +setUTCMinutes + :: Int + -- ^ Minutes in UTC (0–59) + -> Maybe Int + -- ^ Optional seconds (0–59) + -> Maybe Int + -- ^ Optional milliseconds (0–999) + -> Date + -- ^ Date object to modify + -> IO Double setUTCMinutes minutes seconds millis (Date d) = do m <- DSL.toJSVal minutes s <- traverse DSL.toJSVal seconds @@ -351,7 +494,14 @@ ----------------------------------------------------------------------------- -- | Sets the UTC month, with optional day of the month. -- -setUTCMonth :: Int -> Maybe Int -> Date -> IO Double +setUTCMonth + :: Int + -- ^ Month in UTC (0-indexed: 0 = January) + -> Maybe Int + -- ^ Optional day in UTC (1–31) + -> Date + -- ^ Date object to modify + -> IO Double setUTCMonth month day (Date d) = do m <- DSL.toJSVal month d' <- traverse DSL.toJSVal day @@ -359,7 +509,14 @@ ----------------------------------------------------------------------------- -- | Sets the UTC seconds, with optional milliseconds. -- -setUTCSeconds :: Int -> Maybe Int -> Date -> IO Double +setUTCSeconds + :: Int + -- ^ Seconds in UTC (0–59) + -> Maybe Int + -- ^ Optional milliseconds (0–999) + -> Date + -- ^ Date object to modify + -> IO Double setUTCSeconds seconds millis (Date d) = do s <- DSL.toJSVal seconds ms <- traverse DSL.toJSVal millis diff --git a/src/Miso/Delegate.hs b/src/Miso/Delegate.hs --- a/src/Miso/Delegate.hs +++ b/src/Miso/Delegate.hs @@ -17,7 +17,6 @@ ( delegator ) where ----------------------------------------------------------------------------- -import Control.Monad.IO.Class (liftIO) import Data.IORef (IORef, readIORef) import qualified Data.Map.Strict as M ----------------------------------------------------------------------------- @@ -53,6 +52,6 @@ delegator mountPointElement vtreeRef es debug = do evts <- toJSVal (uncurry Event <$> M.toList es) FFI.delegator mountPointElement evts debug $ do - VTree (Object vtree) <- liftIO (readIORef vtreeRef) + VTree (Object vtree) <- readIORef vtreeRef pure vtree ----------------------------------------------------------------------------- diff --git a/src/Miso/Effect.hs b/src/Miso/Effect.hs --- a/src/Miso/Effect.hs +++ b/src/Miso/Effect.hs @@ -13,10 +13,88 @@ -- Stability : experimental -- Portability : non-portable -- --- This module defines t'Effect', t'Sub' and t'Sink' types, which are used with the --- 'Miso.Types.update' function and 'Miso.Types.subs' field of the t'Miso.Types.Component'. +-- = Overview -- ----------------------------------------------------------------------------- +-- "Miso.Effect" defines the three core abstractions used in the +-- Model-View-Update loop: +-- +-- * 'Effect' β€” the monad returned by every 'Miso.Types.update' handler. +-- Combines a state update on @model@ with a list of 'IO' actions to +-- schedule. +-- +-- * 'Sub' β€” a long-running subscription (@'Sink' action -> IO ()@) that +-- feeds actions into the event queue from threads, timers, WebSockets, etc. +-- +-- * 'Sink' β€” a function (@action -> IO ()@) that enqueues a single action +-- for processing by 'Miso.Types.update'. +-- +-- = The Effect monad +-- +-- @ +-- type 'Effect' parent props model action +-- = RWS ('ComponentInfo' parent props) ['Schedule' action] model () +-- @ +-- +-- The @RWS@ decomposition: +-- +-- * __Reader__ β€” 'ComponentInfo': component metadata ('componentInfoId', +-- 'componentInfoDOMRef', 'componentInfoProps') accessible via 'Control.Monad.Reader.ask' +-- or the convenience lenses. +-- * __Writer__ β€” accumulated list of 'Schedule'd 'IO' actions to run after +-- the model update. +-- * __State__ β€” the @model@, updated via 'Control.Monad.State.put', +-- 'Control.Monad.State.modify', or the lens operators from "Miso.Lens". +-- +-- = Scheduling IO +-- +-- By default all 'IO' runs asynchronously in a separate thread after the +-- VDOM has been patched. Use 'sync' \/ 'sync_' to block the render thread: +-- +-- @ +-- update = \\case +-- Fetch -> 'io' (fetchData >>= pure . GotData) -- async +-- LogIt -> 'io_' (consoleLog \"hi\") -- async, no action +-- Urgent -> 'sync' (pure SomeSyncAction) -- blocks render +-- Many -> 'batch' [a1, a2, a3] -- multiple async +-- Opt -> 'for' (fetchMaybe >>= pure) -- Maybe\/Foldable +-- @ +-- +-- = Subscriptions +-- +-- A 'Sub' is a function that receives a 'Sink' and runs forever (typically +-- on a forked thread). Register subscriptions in 'Miso.Types.subs': +-- +-- @ +-- tickSub :: 'Sub' Action +-- tickSub sink = forever $ do +-- threadDelay 16667 +-- sink Tick +-- +-- myComponent = ('Miso.component' model update view) { 'Miso.Types.subs' = [tickSub] } +-- @ +-- +-- Use 'mapSub' to adapt a @Sub a@ into a @Sub b@ with a mapping function. +-- +-- = Component metadata +-- +-- Within 'update', access the current component's runtime info through +-- 'Control.Monad.Reader.ask' or the provided lenses: +-- +-- @ +-- update = \\case +-- Init -> do +-- domRef <- 'Miso.Lens.view' 'componentInfoDOMRef' +-- compId <- 'Miso.Lens.view' 'componentInfoId' +-- myProps <- 'getProps' +-- io_ (initThirdParty domRef) +-- @ +-- +-- = See also +-- +-- * "Miso.Types" β€” 'Miso.Types.Component', 'Miso.Types.update', 'Miso.Types.subs' +-- * "Miso.Lens" β€” lens operators (@'.='@, @'+='@, @'%='@) for model updates +-- * "Miso.Subscription" β€” pre-built subscriptions (mouse, keyboard, history, …) +----------------------------------------------------------------------------- module Miso.Effect ( -- ** Effect -- *** Types @@ -60,7 +138,7 @@ ) where ----------------------------------------------------------------------------- import Control.Monad (void) -import Data.Foldable (for_) +import Data.Foldable (traverse_) import Control.Monad.RWS (RWS, put, tell, execRWS, censor, MonadReader) ----------------------------------------------------------------------------- import Miso.DSL.FFI @@ -85,9 +163,13 @@ data ComponentInfo parent props = ComponentInfo { _componentInfoId :: ComponentId + -- ^ Unique identifier for this component instance , _componentInfoParentId :: ComponentId + -- ^ Unique identifier of the parent component (same as '_componentInfoId' for root components) , _componentInfoDOMRef :: DOMRef + -- ^ The DOM node this component is mounted on , _componentInfoProps :: props + -- ^ The current @props@ value passed into this component } ----------------------------------------------------------------------------- -- | Lens for accessing the t'ComponentId' from t'ComponentInfo'. @@ -276,7 +358,12 @@ ----------------------------------------------------------------------------- -- | Turn a 'Sub' that consumes actions of type @a@ into a 'Sub' that consumes -- actions of type @b@ using the supplied function of type @a -> b@. -mapSub :: (a -> b) -> Sub a -> Sub b +mapSub + :: (a -> b) + -- ^ Function to map actions produced by the subscription + -> Sub a + -- ^ Source subscription delivering @a@ actions + -> Sub b mapSub f sub = \g -> sub (g . f) ----------------------------------------------------------------------------- -- | Schedule a single 'IO' action, executed synchronously. For asynchronous @@ -337,7 +424,7 @@ => IO (f action) -- ^ @actions@ executed in batch. -> Effect parent props model action -for actions = withSink $ \sink -> actions >>= flip for_ sink +for actions = withSink $ \sink -> actions >>= traverse_ sink ----------------------------------------------------------------------------- -- | Performs the given 'IO' action before all IO actions collected by the given -- effect. @@ -348,7 +435,12 @@ -- @ -- -- @since 1.9.0.0 -beforeAll :: IO () -> Effect parent props model action -> Effect parent props model action +beforeAll + :: IO () + -- ^ 'IO' action to prepend before all scheduled effects + -> Effect parent props model action + -- ^ Effect whose IO actions are modified + -> Effect parent props model action beforeAll = modifyAllIO . (*>) ----------------------------------------------------------------------------- -- | Performs the given 'IO' action after all IO actions collected by the given @@ -358,7 +450,12 @@ -- -- > -- log that running the a websocket Effect completed -- > afterAll (consoleLog "Done running websocket effect") $ websocketConnectJSON OnConnect OnClose OnOpen OnError -afterAll :: IO () -> Effect parent props model action -> Effect parent props model action +afterAll + :: IO () + -- ^ 'IO' action to append after all scheduled effects + -> Effect parent props model action + -- ^ Effect whose IO actions are modified + -> Effect parent props model action afterAll = modifyAllIO . (<*) ----------------------------------------------------------------------------- -- | Modifies all 'IO' collected by the given Effect. @@ -370,7 +467,9 @@ -- expressions in an 'Effect'. For examples see 'beforeAll' and 'afterAll'. modifyAllIO :: (IO () -> IO ()) + -- ^ Transform to apply to every scheduled 'IO' action in the effect -> Effect parent props model action + -- ^ Effect whose IO actions are modified -> Effect parent props model action modifyAllIO f = censor $ \actions -> [ Schedule x (f <$> action) diff --git a/src/Miso/Event.hs b/src/Miso/Event.hs --- a/src/Miso/Event.hs +++ b/src/Miso/Event.hs @@ -10,8 +10,21 @@ -- Stability : experimental -- Portability : non-portable -- --- Functions for specifying component lifecycle events and event handlers in 'Miso.Types.View'. +-- DOM event handlers and component lifecycle hooks for 'Miso.Types.View'. -- +-- There are two axes of event handling: +-- +-- * __DOM events__ β€” 'on', 'onCapture', 'onWithOptions': attach JavaScript +-- event listeners to VDOM nodes. Decoded event payloads are dispatched as +-- @action@ values through the MVU loop. +-- +-- * __Lifecycle hooks__ β€” 'onCreated', 'onDestroyed', etc.: fire Haskell +-- callbacks at specific points in a DOM element's mount\/unmount lifecycle. +-- +-- See "Miso.Event.Decoder" for building custom 'Decoder' values and +-- "Miso.Event.Types" for structured payload types ('KeyboardEvent', +-- 'PointerEvent', etc.). +-- ---------------------------------------------------------------------------- module Miso.Event ( -- *** Smart constructors @@ -42,51 +55,73 @@ import Miso.Types (Attribute (On), LogLevel(..), DOMRef, VTree(..)) import Miso.String (MisoString, ms) ----------------------------------------------------------------------------- --- | Convenience wrapper for @onWithOptions defaultOptions@. +-- | Attach a bubble-phase event handler to a VDOM node. +-- Convenience wrapper for @'onWithOptions' 'BUBBLE' 'defaultOptions'@. -- --- > let clickHandler = on "click" emptyDecoder $ \() -> Action --- > in button_ [ clickHandler, class_ "add" ] [ text_ "+" ] +-- The decoded event payload is converted to an @action@ by @toAction@ and +-- dispatched into the component's @update@ function. -- --- This is used to define events that are triggered during the browser --- bubble phase. +-- @ +-- let clickHandler = on \"click\" emptyDecoder $ \\() _ -> MyAction +-- in button_ [ clickHandler, class_ \"add\" ] [ text_ \"+\" ] +-- @ -- on :: MisoString + -- ^ DOM event name (e.g. @\"click\"@, @\"input\"@) -> Decoder r + -- ^ How to extract a Haskell value from the browser event object -> (r -> DOMRef -> action) + -- ^ Converts the decoded payload and the element's DOM reference to an @action@ -> Attribute action on = onWithOptions BUBBLE defaultOptions ----------------------------------------------------------------------------- --- | Convenience wrapper for @onWithOptions (True :: Capture)@. +-- | Attach a capture-phase event handler to a VDOM node. +-- Convenience wrapper for @'onWithOptions' 'CAPTURE' 'defaultOptions'@. -- --- > let clickHandler = onCapture "click" emptyDecoder $ \() -> Action --- > in button_ [ clickHandler, class_ "add" ] [ text_ "+" ] +-- Events in the capture phase propagate from the document root down to the +-- target element, before any bubble-phase handlers run. -- --- This is used to define events that are triggered during the browser --- capture phase. +-- @ +-- let captureClick = onCapture \"click\" emptyDecoder $ \\() _ -> MyAction +-- in button_ [ captureClick ] [ text_ \"capture me\" ] +-- @ -- -onCapture +onCapture :: MisoString + -- ^ DOM event name (e.g. @\"click\"@) -> Decoder r + -- ^ How to extract a Haskell value from the browser event object -> (r -> DOMRef -> action) + -- ^ Converts the decoded payload and the element's DOM reference to an @action@ -> Attribute action onCapture = onWithOptions CAPTURE defaultOptions ----------------------------------------------------------------------------- --- | @onWithOptions opts eventName decoder toAction@ is an attribute --- that will set the event handler of the associated DOM node to a function that --- decodes its argument using @decoder@, converts it to an action --- using @toAction@ and then feeds that action back to the @update@ function. +-- | Attach an event handler with explicit phase and propagation options. -- --- @opts@ can be used to disable further event propagation. +-- * @phase@ β€” 'BUBBLE' (default) or 'CAPTURE': which DOM propagation phase +-- the listener is registered on. +-- * @options@ β€” 'defaultOptions' or a custom 'Options' value: controls +-- @preventDefault@ and @stopPropagation@ behaviour. +-- * @eventName@ β€” the DOM event name, e.g. @\"click\"@, @\"keydown\"@. +-- * @decoder@ β€” a 'Decoder' that extracts relevant fields from the JS event object. +-- * @toAction@ β€” maps the decoded payload and the element's 'DOMRef' to an @action@. -- --- > let clickHandler = onWithOptions defaultOptions "click" emptyDecoder $ \() -> Action --- > in button_ [ clickHandler, class_ "add" ] [ text_ "+" ] +-- @ +-- let clickHandler = onWithOptions BUBBLE defaultOptions \"click\" emptyDecoder $ \\() _ -> Action +-- in button_ [ clickHandler, class_ \"add\" ] [ text_ \"+\" ] +-- @ -- onWithOptions :: Phase + -- ^ Event propagation phase: 'BUBBLE' (default) or 'CAPTURE' -> Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) -> MisoString + -- ^ DOM event name (e.g. @\"click\"@, @\"keydown\"@) -> Decoder r + -- ^ How to extract a Haskell value from the browser event object -> (r -> DOMRef -> action) + -- ^ Converts the decoded payload and the element's DOM reference to an @action@ -> Attribute action onWithOptions phase options eventName Decoder{..} toAction = On $ \sink (VTree n) logLevel events -> do @@ -118,65 +153,92 @@ FFI.set "options" jsOptions eventHandlerObject FFI.set eventName eo (Object eventObj) ----------------------------------------------------------------------------- --- | @onCreated action@ is an event that gets called after the actual DOM --- element is created. +-- | Fire an action immediately after the DOM element is inserted into the document. -- +-- Use this to trigger imperative setup (focus, measurements, third-party widget +-- initialisation) that requires the element to be live in the page. +-- -- @since 1.9.0.0 -- -onCreated :: action -> Attribute action +onCreated + :: action + -- ^ Action to dispatch after the element is inserted into the DOM + -> Attribute action onCreated action = On $ \sink (VTree object) _ _ -> do callback <- FFI.syncCallback (sink action) FFI.set "onCreated" callback object ----------------------------------------------------------------------------- --- | Like @onCreated action@ but passes along the `DOMRef` +-- | Like 'onCreated' but also receives the element's 'DOMRef'. -- +-- Useful when you need to store or forward the raw DOM node to a JS library. +-- -- @since 1.9.0.0 -- -onCreatedWith :: (DOMRef -> action) -> Attribute action +onCreatedWith + :: (DOMRef -> action) + -- ^ Callback receiving the element's 'DOMRef' after it is inserted into the DOM + -> Attribute action onCreatedWith action = On $ \sink (VTree object) _ _ -> do callback <- FFI.syncCallback1 (sink . action) FFI.set "onCreated" callback object ----------------------------------------------------------------------------- --- | @onDestroyed action@ is an event that gets called after the DOM element --- is removed from the DOM. +-- | Fire an action immediately after the DOM element is removed from the document. -- +-- The element has already been detached from the DOM when this fires. +-- -- @since 1.9.0.0 -- -onDestroyed :: action -> Attribute action +onDestroyed + :: action + -- ^ Action to dispatch after the element is removed from the DOM + -> Attribute action onDestroyed action = On $ \sink (VTree object) _ _ -> do callback <- FFI.syncCallback (sink action) FFI.set "onDestroyed" callback object ----------------------------------------------------------------------------- --- | @onBeforeDestroyed action@ is an event that gets called before the DOM element --- is removed from the DOM. +-- | Fire an action just before the DOM element is removed from the document. -- +-- The element is still present in the DOM when this fires, making it suitable +-- for teardown logic (cancel animations, disconnect observers, etc.). +-- -- @since 1.9.0.0 -- -onBeforeDestroyed :: action -> Attribute action +onBeforeDestroyed + :: action + -- ^ Action to dispatch just before the element is removed from the DOM + -> Attribute action onBeforeDestroyed action = On $ \sink (VTree object) _ _ -> do callback <- FFI.syncCallback (sink action) FFI.set "onBeforeDestroyed" callback object ----------------------------------------------------------------------------- --- | Like @onBeforeDestroyed@ but passes along the `DOMRef` +-- | Like 'onBeforeDestroyed' but also receives the element's 'DOMRef'. -- -- @since 1.9.0.0 -- -onBeforeDestroyedWith :: (DOMRef -> action) -> Attribute action +onBeforeDestroyedWith + :: (DOMRef -> action) + -- ^ Callback receiving the element's 'DOMRef' just before it is removed from the DOM + -> Attribute action onBeforeDestroyedWith action = On $ \sink (VTree object) _ _ -> do callback <- FFI.syncCallback1 (sink . action) FFI.set "onBeforeDestroyed" callback object ----------------------------------------------------------------------------- --- | @onBeforeCreated action@ is an event that gets called before the DOM element --- is created on the DOM. +-- | Fire an action just before the DOM element is inserted into the document. -- +-- The element has been constructed but is not yet attached to the live DOM when +-- this fires. +-- -- @since 1.9.0.0 -- -onBeforeCreated :: action -> Attribute action +onBeforeCreated + :: action + -- ^ Action to dispatch just before the element is inserted into the DOM + -> Attribute action onBeforeCreated action = On $ \sink (VTree object) _ _ -> do callback <- FFI.syncCallback (sink action) diff --git a/src/Miso/Event/Decoder.hs b/src/Miso/Event/Decoder.hs --- a/src/Miso/Event/Decoder.hs +++ b/src/Miso/Event/Decoder.hs @@ -11,7 +11,63 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable ----------------------------------------------------------------------------- +-- +-- = Overview +-- +-- "Miso.Event.Decoder" provides 'Decoder', the type that tells miso how to +-- extract a Haskell value from a browser +-- object. +-- It pairs a target path ('DecodeTarget') into the event with a +-- JSON-style parser ('Miso.JSON.Value' @->@ 'Miso.JSON.Parser' @a@). +-- +-- Decoders are consumed by 'Miso.Html.Event.on' from "Miso.Html.Event": +-- +-- @ +-- on :: 'Miso.String.MisoString' -- event name (e.g. \"click\") +-- -> 'Decoder' a -- how to extract @a@ from the event object +-- -> (a -> action) -- turn the extracted value into an action +-- -> 'Miso.Types.Attribute' action +-- @ +-- +-- = DecodeTarget +-- +-- A 'DecodeTarget' selects the sub-object of the event to decode: +-- +-- * @'DecodeTarget' []@ β€” the event object itself (e.g. for keyboard events). +-- * @'DecodeTarget' [\"target\"]@ β€” @event.target@ (e.g. for input values). +-- * @'DecodeTargets' [[\"a\"], [\"b\"]]@ β€” tries @event.a@ first, then +-- @event.b@; the first successful decode wins. +-- +-- = Built-in decoders +-- +-- ['emptyDecoder'] @()@ β€” @click@, @submit@, stateless events +-- ['keycodeDecoder'] 'Miso.Event.Types.KeyCode' β€” @keydown@ \/ @keyup@ key code +-- ['keyInfoDecoder'] 'Miso.Event.Types.KeyInfo' β€” key code + modifier keys +-- ['valueDecoder'] 'Miso.String.MisoString' β€” @input@ \/ @change@ (@event.target.value@) +-- ['checkedDecoder'] 'Miso.Event.Types.Checked' β€” checkbox @change@ (@event.target.checked@) +-- ['pointerDecoder'] 'Miso.Event.Types.PointerEvent' β€” pointer\/mouse position and metadata +-- +-- = Custom decoders +-- +-- Build a custom decoder with 'at' or by constructing 'Decoder' directly: +-- +-- @ +-- -- Extract (offsetX, offsetY) from a click event +-- clickXY :: 'Decoder' (Int, Int) +-- clickXY = 'Decoder' +-- { 'decodeAt' = 'DecodeTarget' [] +-- , 'decoder' = 'Miso.JSON.withObject' \"click\" $ \\o -> +-- (,) \<$\> o 'Miso.JSON..:' \"offsetX\" +-- \<*\> o 'Miso.JSON..:' \"offsetY\" +-- } +-- @ +-- +-- = See also +-- +-- * "Miso.Html.Event" β€” @on@ and the pre-wired event handlers (@onClick@, @onInput@, …) +-- * "Miso.Event.Types" β€” payload types ('Miso.Event.Types.KeyCode', 'Miso.Event.Types.PointerEvent', …) +-- * "Miso.JSON" β€” 'Miso.JSON.Value', 'Miso.JSON.Parser', 'Miso.JSON.withObject', @('Miso.JSON..:')@ +----------------------------------------------------------------------------- module Miso.Event.Decoder ( -- ** Types Decoder (..) @@ -58,7 +114,12 @@ } ----------------------------------------------------------------------------- -- | Smart constructor for building a t'Decoder'. -at :: [MisoString] -> (Value -> Parser a) -> Decoder a +at + :: [MisoString] + -- ^ Path into the event object (e.g. @[\"target\"]@ for @event.target@, @[]@ for the event itself) + -> (Value -> Parser a) + -- ^ JSON-style decoder applied at the given path + -> Decoder a at decodeAt decoder = Decoder {decodeAt = DecodeTarget decodeAt, ..} ----------------------------------------------------------------------------- -- | Empty t'Decoder' for use with events like "click" that do not diff --git a/src/Miso/Event/Types.hs b/src/Miso/Event/Types.hs --- a/src/Miso/Event/Types.hs +++ b/src/Miso/Event/Types.hs @@ -11,7 +11,56 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable ----------------------------------------------------------------------------- +-- +-- = Overview +-- +-- "Miso.Event.Types" defines the payload types for browser DOM events and +-- the 'Events' map that controls which events are delegated to the miso +-- runtime and at which 'Phase' of the event lifecycle. +-- +-- = Event delegation +-- +-- Miso uses +-- : +-- a single listener is attached at the root of the component's DOM subtree +-- and catches all matching events as they bubble or capture past it. +-- The 'Events' map (@'Data.Map.Strict.Map' 'Miso.String.MisoString' 'Phase'@) +-- declares which event names participate and their phase. +-- +-- The default set ('defaultEvents') covers the most common interactions. +-- Additional event groups can be merged in when constructing a component: +-- +-- @ +-- myComponent = ('Miso.component' model update view) +-- { 'Miso.Types.events' = 'defaultEvents' +-- \<\> 'keyboardEvents' +-- \<\> 'pointerEvents' +-- } +-- @ +-- +-- = Event groups +-- +-- ['defaultEvents'] blur, change, click, contextmenu, dblclick, focus, input, select, submit +-- ['keyboardEvents'] keydown, keypress, keyup +-- ['mouseEvents'] mouseup, mousedown, mouseenter, mouseleave, mouseover, mouseout, contextmenu +-- ['dragEvents'] drag, dragstart, dragend, dragenter, dragleave, dragover, drop +-- ['pointerEvents'] pointerup, pointerdown, pointerenter, pointerleave, pointerover, pointerout, pointercancel, contextmenu +-- ['mediaEvents'] play, pause, ended, timeupdate, volumechange, … +-- ['clipboardEvents'] cut, copy, paste +-- ['touchEvents'] touchstart, touchend, touchmove, touchcancel +-- +-- = Payload types +-- +-- * 'KeyCode' \/ 'KeyInfo' β€” keyboard event key code and modifier state. +-- * 'Checked' β€” checkbox @checked@ boolean. +-- * 'PointerEvent' \/ 'PointerType' β€” pointer position, pressure, tilt, and device type. +-- * 'Options' β€” per-handler flags: 'preventDefault', 'stopPropagation'. +-- +-- = See also +-- +-- * "Miso.Event.Decoder" β€” 'Miso.Event.Decoder.Decoder' and pre-built decoders for these types +-- * "Miso.Html.Event" β€” @onClick@, @onInput@, @onKeyDown@, … combinators +----------------------------------------------------------------------------- module Miso.Event.Types ( -- ** Types Events @@ -50,7 +99,15 @@ data KeyInfo = KeyInfo { keyCode :: !KeyCode - , shiftKey, metaKey, ctrlKey, altKey :: !Bool + -- ^ Numeric key code of the pressed key (see 'KeyCode') + , shiftKey :: !Bool + -- ^ 'True' if the Shift key was held when the event fired + , metaKey :: !Bool + -- ^ 'True' if the Meta (Command on macOS, Windows key on PC) key was held + , ctrlKey :: !Bool + -- ^ 'True' if the Control key was held + , altKey :: !Bool + -- ^ 'True' if the Alt (Option on macOS) key was held } deriving (Show, Eq) ----------------------------------------------------------------------------- -- | Type used for Keyboard events. @@ -68,21 +125,26 @@ data PointerEvent = PointerEvent { pointerType :: PointerType + -- ^ Device kind: 'MousePointerType', 'PenPointerType', 'TouchPointerType', or 'UnknownPointerType' , pointerId :: Int + -- ^ Unique identifier for this pointer, stable across move\/up\/cancel events , isPrimary :: Bool + -- ^ 'True' for the primary pointer in a multi-touch sequence , client :: (Double, Double) - -- ^ clientX, clientY + -- ^ @(clientX, clientY)@ β€” position relative to the viewport , screen :: (Double, Double) - -- ^ screenX, screenY + -- ^ @(screenX, screenY)@ β€” position relative to the screen , offset :: (Double, Double) - -- ^ offsetX, offsetY + -- ^ @(offsetX, offsetY)@ β€” position relative to the target element , page :: (Double,Double) - -- ^ pageX, pageY + -- ^ @(pageX, pageY)@ β€” position relative to the full document , tilt :: (Double,Double) - -- ^ tiltX, tiltY + -- ^ @(tiltX, tiltY)@ β€” pen tilt angle in degrees from the surface plane , pressure :: Double + -- ^ Normalised pressure in @[0, 1]@; @0.5@ for mouse buttons that lack pressure sensitivity , button :: Int - -- ^ https://w3c.github.io/pointerevents/#the-button-property + -- ^ Which button changed state; @-1@ during move with no button change. + -- See } deriving (Show, Eq) ----------------------------------------------------------------------------- -- | Pointer type @@ -105,7 +167,9 @@ data Options = Options { _preventDefault :: Bool + -- ^ If 'True', calls @event.preventDefault()@ to suppress the browser's default behaviour , _stopPropagation :: Bool + -- ^ If 'True', calls @event.stopPropagation()@ to halt event bubbling\/capturing } deriving (Show, Eq) ----------------------------------------------------------------------------- instance Monoid Options where diff --git a/src/Miso/EventSource.hs b/src/Miso/EventSource.hs --- a/src/Miso/EventSource.hs +++ b/src/Miso/EventSource.hs @@ -9,8 +9,24 @@ -- Stability : experimental -- Portability : non-portable -- --- Functions and types for working with [Server Sent Events](https://developer.mozilla.org/en-US/docs/Web/API/Server-sent_events/Using_server-sent_events) +-- Interface to the browser's +-- [Server-Sent Events](https://developer.mozilla.org/en-US/docs/Web/API/Server-sent_events/Using_server-sent_events) +-- API, which provides a persistent, unidirectional stream of text or JSON +-- messages pushed from a server to the browser client. -- +-- Typical usage inside an @update@ function: +-- +-- @ +-- update FetchStream = +-- connectText "\/events" StreamOpened GotMessage StreamError +-- update (GotMessage msg) = +-- modify (\\m -> m { messages = msg : messages m }) +-- @ +-- +-- 'close' shuts down an open 'EventSource' connection. 'socketState' reads +-- the current ready-state, and 'emptyEventSource' provides a zero-value for +-- use in the model before a connection is established. +-- ---------------------------------------------------------------------------- module Miso.EventSource ( -- *** EventSource @@ -33,34 +49,58 @@ import Miso.Runtime import Miso.String ----------------------------------------------------------------------------- --- | +-- | Open a Server-Sent Events connection that delivers raw 'MisoString' messages. +-- +-- The three callbacks map browser events to @action@ values dispatched into +-- the MVU loop: +-- +-- * @onOpen@ β€” receives the live 'EventSource' handle (store it in the model +-- to 'close' it later) +-- * @onMessage@ β€” called with each message payload as a plain string +-- * @onError@ β€” called with a description of the connection error +-- +-- See connectText :: URL + -- ^ URL endpoint for the Server-Sent Events stream -> (EventSource -> action) - -- ^ onOpen + -- ^ @onOpen@ callback; receives the live 'EventSource' handle -> (MisoString -> action) - -- ^ onMessage + -- ^ @onMessage@ callback; receives each raw text message -> (MisoString -> action) - -- ^ onError + -- ^ @onError@ callback; receives an error description -> Effect parent props model action connectText = eventSourceConnectText ----------------------------------------------------------------------------- --- | +-- | Open a Server-Sent Events connection that decodes each message as JSON. +-- +-- Identical to 'connectText' but the @onMessage@ callback receives a parsed +-- Haskell value of type @value@ (via 'FromJSON') rather than a raw string. +-- JSON decode failures are silently dropped; use 'connectText' and decode +-- manually if you need error recovery. +-- +-- See connectJSON :: FromJSON value => URL + -- ^ URL endpoint for the Server-Sent Events stream -> (EventSource -> action) - -- ^ onOpen + -- ^ @onOpen@ callback; receives the live 'EventSource' handle -> (value -> action) - -- ^ onMessage + -- ^ @onMessage@ callback; receives each JSON-decoded message -> (MisoString -> action) - -- ^ onError + -- ^ @onError@ callback; receives an error description -> Effect parent props model action connectJSON = eventSourceConnectJSON ----------------------------------------------------------------------------- --- | +-- | Close an open 'EventSource' connection. +-- +-- After calling 'close', no further @onMessage@ or @onError@ callbacks will +-- fire. Corresponds to +-- . close :: EventSource + -- ^ The 'EventSource' handle to close -> Effect parent props model action close = eventSourceClose ----------------------------------------------------------------------------- diff --git a/src/Miso/FFI.hs b/src/Miso/FFI.hs --- a/src/Miso/FFI.hs +++ b/src/Miso/FFI.hs @@ -7,8 +7,24 @@ -- Stability : experimental -- Portability : non-portable -- --- Foreign Function Interface (FFI) utilities for interacting with JavaScript. +-- Public re-export surface for Miso's JavaScript FFI layer. -- +-- This module re-exports the stable public API from "Miso.FFI.Internal". +-- Prefer importing this module over @Internal@ in application code and +-- library extensions. +-- +-- Exports are grouped by concern: +-- +-- * __DOM manipulation__: 'getElementById', 'focus', 'blur', 'removeChild', … +-- * __Logging__: 'consoleLog', 'consoleError', 'consoleWarn' +-- * __Callbacks__: 'syncCallback', 'asyncCallback', 'asyncCallback2', … +-- * __Canvas\/Drawing__: 'flush', 'setDrawingContext' +-- * __Browser APIs__: 'fetch', 'addEventListener', 'dispatchEvent', … +-- * __JS types__: 'ArrayBuffer', 'Blob', 'FormData', 'Uint8Array', 'File', … +-- * __Component lifecycle__: 'mountComponent', 'unmountComponent', 'modelHydration' +-- +-- For inline JavaScript via quasi-quotation, see "Miso.FFI.QQ". +-- ---------------------------------------------------------------------------- module Miso.FFI ( -- ** Object @@ -101,6 +117,8 @@ , inline -- ** Scroll , scrollIntoView + -- ** Fullscreen + , requestFullscreen -- ** SplitMix32 , splitmix32 -- ** Math.random() diff --git a/src/Miso/FFI/Internal.hs b/src/Miso/FFI/Internal.hs --- a/src/Miso/FFI/Internal.hs +++ b/src/Miso/FFI/Internal.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- @@ -17,9 +16,80 @@ -- Stability : experimental -- Portability : non-portable -- --- Internal FFI functions for browser / device interaction. +-- = Overview -- ----------------------------------------------------------------------------- +-- "Miso.FFI.Internal" contains the low-level browser bindings that back the +-- miso runtime. It is exposed for advanced use-cases and custom renderer +-- authors; most application code should import "Miso.FFI" instead, which +-- re-exports a curated subset of this module. +-- +-- = Drawing context abstraction +-- +-- Miso routes all DOM mutations through a /drawing context/ object stored at +-- @globalThis.miso.drawingContext@. This indirection lets the same Haskell +-- runtime target different rendering backends (browser DOM, native mobile via +-- , etc.) without +-- changing application code. Use 'setDrawingContext' to switch renderers at +-- startup: +-- +-- @ +-- setDrawingContext \"lynx\" -- switch to the Lynx native renderer +-- @ +-- +-- = Inline JavaScript +-- +-- 'inline' provides a safe, scoped alternative to 'Miso.DSL.eval'. It +-- wraps a JS snippet in a function, passes the supplied 'Miso.DSL.Object' +-- fields as named parameters, and returns the result: +-- +-- @ +-- {-\# LANGUAGE DeriveGeneric, DeriveAnyClass \#-} +-- +-- data Person = Person { name :: MisoString, age :: Int } +-- deriving (Generic, ToJSVal, ToObject) +-- +-- logNameGetAge :: Person -> IO Int +-- logNameGetAge person = inline +-- \"console.log(name); return age;\" +-- person +-- @ +-- +-- Prefer 'inline' (or the @[js| … |]@ quasi-quoter from "Miso.FFI.QQ") +-- over 'Miso.DSL.eval' β€” 'inline' is isolated and not subject to the +-- security concerns or optimisation barriers of @eval@. +-- +-- = API groups +-- +-- * __Callbacks__: 'syncCallback', 'asyncCallback' (and 1\/2-arg variants) +-- * __Events__: 'addEventListener', 'removeEventListener', +-- 'eventPreventDefault', 'eventStopPropagation', +-- 'delegator', 'dispatchEvent', 'newEvent', 'newCustomEvent' +-- * __Window__: 'windowAddEventListener', 'windowRemoveEventListener', +-- 'windowInnerHeight', 'windowInnerWidth' +-- * __DOM__: 'getBody', 'getDocument', 'getElementById', 'getHead', +-- 'removeChild', 'nextSibling', 'previousSibling', 'diff', 'hydrate' +-- * __Console__: 'consoleLog', 'consoleWarn', 'consoleError', 'consoleLog'' +-- * __Performance__: 'now' +-- * __Element actions__: 'focus', 'blur', 'select', 'setSelectionRange', +-- 'scrollIntoView', 'requestFullscreen', 'click', 'files', 'setValue' +-- * __CSS \/ JS injection__: 'addStyle', 'addStyleSheet', 'addScript', +-- 'addSrc', 'addScriptImportMap' +-- * __Network__: 'fetch' \/ 'Response' \/ 'CONTENT_TYPE', +-- 'websocketConnect', 'websocketSend', 'websocketClose', +-- 'eventSourceConnect', 'eventSourceClose' +-- * __Navigator__: 'getUserMedia', 'copyClipboard', 'geolocation', 'isOnLine' +-- * __Types__: 'Image', 'Date', 'Blob', 'File', 'FormData', +-- 'ArrayBuffer', 'Uint8Array', 'FileReader', 'URLSearchParams', 'Event' +-- * __Randomness__: 'splitmix32', 'mathRandom', 'getRandomValue' +-- * __Component lifecycle__ (runtime use only): 'mountComponent', +-- 'unmountComponent', 'modelHydration' +-- +-- = See also +-- +-- * "Miso.FFI" β€” public re-export surface for application code +-- * "Miso.FFI.QQ" β€” @[js| … |]@ quasi-quoter for inline JavaScript +-- * "Miso.DSL" β€” 'Miso.DSL.JSVal', 'Miso.DSL.ToJSVal', 'Miso.DSL.FromJSVal' +----------------------------------------------------------------------------- module Miso.FFI.Internal ( -- * Callbacks syncCallback @@ -79,6 +149,7 @@ , select , setSelectionRange , scrollIntoView + , requestFullscreen , alert , locationReload -- * CSS @@ -155,7 +226,7 @@ , modelHydration ) where ----------------------------------------------------------------------------- -import Control.Monad (void, forM_, (<=<), when) +import Control.Monad (void, forM_, (<=<), when, unless) import Data.Map.Strict (Map) import Data.Maybe import Prelude hiding ((!!)) @@ -164,7 +235,15 @@ import Miso.String ----------------------------------------------------------------------------- -- | Set property on object -set :: ToJSVal v => MisoString -> v -> Object -> IO () +set + :: ToJSVal v + => MisoString + -- ^ Property name to set + -> v + -- ^ Value to assign + -> Object + -- ^ JavaScript object to mutate + -> IO () {-# INLINABLE set #-} set k v o = do v' <- toJSVal v @@ -175,7 +254,12 @@ -- Example usage: -- -- > Just (value :: String) <- fromJSVal =<< getProperty domRef "value" -getProperty :: JSVal -> MisoString -> IO JSVal +getProperty + :: JSVal + -- ^ JavaScript object to read from + -> MisoString + -- ^ Property name to retrieve + -> IO JSVal {-# INLINABLE getProperty #-} getProperty = (!) ----------------------------------------------------------------------------- @@ -551,7 +635,14 @@ -- | Fails silently if the element is not found. -- -- Analogous to @document.querySelector('#' + id).setSelectionRange(start, end, \'none\')@. -setSelectionRange :: MisoString -> Int -> Int -> IO () +setSelectionRange + :: MisoString + -- ^ DOM element @id@ (without the @#@ prefix) to call @setSelectionRange@ on + -> Int + -- ^ Selection start index (inclusive) + -> Int + -- ^ Selection end index (exclusive) + -> IO () {-# INLINABLE setSelectionRange #-} setSelectionRange x start end = void $ jsg "miso" # "callSetSelectionRange" $ (x, start, end, 50 :: Int) ----------------------------------------------------------------------------- @@ -563,6 +654,22 @@ _ <- el # "scrollIntoView" $ () pure () ----------------------------------------------------------------------------- +-- | Calls @document.documentElement.requestFullscreen()@, falling back to +-- @webkitRequestFullscreen@ for Safari. +requestFullscreen :: IO () +{-# INLINABLE requestFullscreen #-} +requestFullscreen = do + doc <- jsg "document" + docEl <- doc ! "documentElement" + rfs <- docEl ! "requestFullscreen" + undef <- isUndefined rfs + if undef + then do + wrfs <- docEl ! "webkitRequestFullscreen" + wundef <- isUndefined wrfs + unless wundef $ void $ docEl # "webkitRequestFullscreen" $ () + else void $ docEl # "requestFullscreen" $ () +----------------------------------------------------------------------------- -- | Calls the @alert()@ function. alert :: MisoString -> IO () {-# INLINABLE alert #-} @@ -660,13 +767,18 @@ head_ <- getHead link <- context # "createElement" $ ["link" :: MisoString] _ <- link # "setAttribute" $ ["rel","stylesheet" :: MisoString] - url_ <- appendTimestamp url cacheBust + url_ <- appendTimestamp url cacheBust _ <- link # "setAttribute" $ ["href", url_ ] void $ context # "appendChild" $ (head_, link) pure link ----------------------------------------------------------------------------- -- | Helper for cache busting -appendTimestamp :: MisoString -> Bool -> IO MisoString +appendTimestamp + :: MisoString + -- ^ Base URL to optionally append a timestamp query parameter to + -> Bool + -- ^ When 'True', appends @?v=\@ to force cache invalidation + -> IO MisoString {-# INLINABLE appendTimestamp #-} appendTimestamp url = \case True -> do diff --git a/src/Miso/FFI/QQ.hs b/src/Miso/FFI/QQ.hs --- a/src/Miso/FFI/QQ.hs +++ b/src/Miso/FFI/QQ.hs @@ -15,32 +15,79 @@ ----------------------------------------------------------------------------- -- | -- Module : Miso.FFI.QQ --- Copyright : (C) 2016-2026 David M. Johnson (@dmjio) +-- Copyright : (C) 2016-2026 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable -- --- A QuasiQuoter for `inline-js` functionality. +-- = Overview -- --- @ +-- "Miso.FFI.QQ" provides the @'js'@ quasi-quoter, which lets you embed +-- JavaScript snippets directly in Haskell source. In-scope Haskell +-- variables are spliced into the JS body with @${varName}@ interpolation +-- syntax, and their types are checked at compile time via +-- 'Miso.DSL.ToJSVal'. -- --- {-# LANGUAGE QuasiQuotes #-} +-- Enable the extension and import the quoter: -- --- import Miso.FFI.QQ (js) +-- @ +-- {-\# LANGUAGE QuasiQuotes \#-} +-- import "Miso.FFI.QQ" ('js') +-- @ -- +-- = Quick start +-- +-- @ +-- -- Compute a factorial entirely in JavaScript -- fac :: Int -> IO Int --- fac n = [js| +-- fac n = ['js'| -- let x = 1; --- for (i = 1; i <= ${n}; i++) { +-- for (let i = 1; i \<= ${n}; i++) { -- x *= i; -- } -- return x; -- |] -- +-- -- Call a third-party JS library with a DOM reference and a string +-- highlight :: 'Miso.DSL.JSVal' -> 'Miso.String.MisoString' -> IO () +-- highlight domRef lang = ['js'| +-- hljs.highlightElement(${domRef}, { language: ${lang} }); +-- |] -- @ -- ----------------------------------------------------------------------------- +-- = How it works +-- +-- At compile time the quasi-quoter: +-- +-- 1. Lexes the JS body to find all @${varName}@ interpolations. +-- 2. Looks up each @varName@ in the Haskell scope (compile error if not found). +-- 3. Builds a 'Miso.DSL.Object' mapping short generated keys to the +-- marshalled values (via 'Miso.FFI.Internal.inline' \/ 'Miso.DSL.createWith'). +-- 4. Rewrites the JS body, replacing each @${varName}@ with its generated +-- key, and wraps the whole thing in a JS function so the keys are visible +-- as named parameters. +-- +-- The result is semantically equivalent to: +-- +-- @ +-- do o <- 'Miso.DSL.createWith' [(\"a0\", toJSVal n)] +-- 'Miso.FFI.Internal.inline' \"… body with a0 instead of n …\" o +-- @ +-- +-- = Differences from eval +-- +-- Unlike 'Miso.DSL.eval', the generated code runs in a fresh function scope β€” +-- it cannot read or write surrounding local variables other than those +-- explicitly interpolated. This makes it both safer and faster (JS engines +-- can optimise closed-over functions that don't reference @eval@). +-- +-- = See also +-- +-- * 'Miso.FFI.Internal.inline' β€” the runtime primitive this expands to +-- * "Miso.DSL" β€” 'Miso.DSL.ToJSVal', 'Miso.DSL.createWith' +-- * "Miso.FFI" β€” higher-level browser API wrappers +----------------------------------------------------------------------------- module Miso.FFI.QQ ( js ) where diff --git a/src/Miso/Fetch.hs b/src/Miso/Fetch.hs --- a/src/Miso/Fetch.hs +++ b/src/Miso/Fetch.hs @@ -12,12 +12,30 @@ -- Stability : experimental -- Portability : non-portable -- --- Interface to the [Fetch API](https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API) --- for making HTTP requests. +-- Interface to the browser's +-- +-- for making HTTP requests inside Miso's 'Effect' monad. -- --- Refer to the miso README if you want to automatically interact with a Servant --- API. +-- Each function accepts a URL, optional request headers, a success callback, +-- and an error callback of the form @'Response' x -> action@. The resulting +-- 'Effect' dispatches the appropriate action into the MVU loop when the +-- response arrives. -- +-- Functions are grouped by HTTP method and body\/response type: +-- +-- * __JSON__ β€” 'getJSON', 'postJSON', 'postJSON'', 'putJSON' +-- * __Text__ β€” 'getText', 'postText', 'putText' +-- * __Blob__ β€” 'getBlob', 'postBlob', 'putBlob' +-- * __FormData__ β€” 'getFormData', 'postFormData', 'putFormData' +-- * __Uint8Array__ β€” 'getUint8Array', 'postUint8Array', 'putUint8Array' +-- * __ArrayBuffer__ β€” 'getArrayBuffer', 'postArrayBuffer', 'putArrayBuffer' +-- * __Image__ β€” 'postImage', 'putImage' +-- +-- Use 'getJSON' or 'postJSON' for typical REST calls; use 'postJSON'' when +-- the server also returns a JSON response body. +-- +-- For Servant-style typed client generation, see the miso README. +-- ---------------------------------------------------------------------------- module Miso.Fetch ( -- ** JSON @@ -72,9 +90,7 @@ import Miso.Util ((=:)) import Miso.FFI.Internal (Response(..), Blob, FormData, ArrayBuffer, Uint8Array, Image, fetch, CONTENT_TYPE(..)) ---------------------------------------------------------------------------- --- | Retrieves JSON using the Fetch API. --- --- See +-- | Retrieve a JSON resource via GET. -- -- @ -- data Action @@ -128,7 +144,10 @@ , .. } ---------------------------------------------------------------------------- --- | Sends a POST request with JSON encoded data. +-- | Send a POST request with a JSON-encoded body; ignores the response body. +-- +-- Sets @Content-Type: application\/json@ automatically. Use 'postJSON'' when +-- you also need to parse a JSON response body. postJSON :: (FromJSVal error, ToJSON body) => MisoString @@ -152,7 +171,10 @@ where jsonHeaders_ = biasHeaders headers_ [contentType =: applicationJSON] ---------------------------------------------------------------------------- --- | Sends a POST request with JSON encoded data and expects JSON response. +-- | Send a POST request with a JSON-encoded body and parse a JSON response. +-- +-- Sets both @Content-Type: application\/json@ and @Accept: application\/json@ +-- automatically. Use 'postJSON' when the response body is not needed. postJSON' :: (FromJSVal error, ToJSON body, FromJSON return) => MisoString @@ -194,7 +216,9 @@ , .. } ---------------------------------------------------------------------------- --- | Sends a PUT request with JSON encoded data. +-- | Send a PUT request with a JSON-encoded body; ignores the response body. +-- +-- Sets @Content-Type: application\/json@ automatically. putJSON :: (FromJSVal error, ToJSON body) => MisoString @@ -218,7 +242,10 @@ where jsonHeaders_ = biasHeaders headers_ [contentType =: applicationJSON] ---------------------------------------------------------------------------- --- | Retrieves text using the Fetch API. +-- | Retrieve a plain-text resource via GET. +-- +-- Sets @Accept: text\/plain@ automatically. The response body is delivered as +-- a 'MisoString'. getText :: FromJSVal error => MisoString @@ -239,7 +266,9 @@ where textHeaders_ = biasHeaders headers_ [accept =: textPlain] ---------------------------------------------------------------------------- --- | Sends a POST request with text data. +-- | Send a POST request with a plain-text body; ignores the response body. +-- +-- Sets @Content-Type: text\/plain@ automatically. postText :: FromJSVal error => MisoString @@ -263,7 +292,9 @@ where textHeaders_ = biasHeaders headers_ [contentType =: textPlain] ---------------------------------------------------------------------------- --- | Sends a PUT request with text data. +-- | Send a PUT request with a plain-text body; ignores the response body. +-- +-- Sets @Content-Type: text\/plain@ automatically. putText :: FromJSVal error => MisoString @@ -287,7 +318,9 @@ where textHeaders_ = biasHeaders headers_ [contentType =: textPlain] ---------------------------------------------------------------------------- --- | Retrieves a Blob using the Fetch API. +-- | Retrieve a binary resource as a 'Blob' via GET. +-- +-- Sets @Accept: application\/octet-stream@ automatically. getBlob :: FromJSVal error => MisoString @@ -308,7 +341,9 @@ where blobHeaders_ = biasHeaders headers_ [accept =: octetStream] ---------------------------------------------------------------------------- --- | Sends a POST request with a Blob. +-- | Send a POST request with a 'Blob' body; ignores the response body. +-- +-- Sets @Content-Type: application\/octet-stream@ automatically. postBlob :: FromJSVal error => MisoString @@ -332,7 +367,9 @@ where blobHeaders_ = biasHeaders headers_ [contentType =: octetStream] ---------------------------------------------------------------------------- --- | Sends a PUT request with a Blob. +-- | Send a PUT request with a 'Blob' body; ignores the response body. +-- +-- Sets @Content-Type: application\/octet-stream@ automatically. putBlob :: FromJSVal error => MisoString @@ -356,7 +393,9 @@ where blobHeaders_ = biasHeaders headers_ [contentType =: octetStream] ---------------------------------------------------------------------------- --- | Retrieves FormData using the Fetch API. +-- | Retrieve a multipart resource as 'FormData' via GET. +-- +-- Sets @Accept: multipart\/form-data@ automatically. getFormData :: FromJSVal error => MisoString @@ -377,7 +416,9 @@ where formDataHeaders_ = biasHeaders headers_ [accept =: formData] ---------------------------------------------------------------------------- --- | Sends a POST request with FormData. +-- | Send a POST request with a 'FormData' body; ignores the response body. +-- +-- Sets @Content-Type: multipart\/form-data@ automatically. postFormData :: FromJSVal error => MisoString @@ -401,7 +442,9 @@ where formDataHeaders_ = biasHeaders headers_ [contentType =: formData] ---------------------------------------------------------------------------- --- | Sends a PUT request with FormData. +-- | Send a PUT request with a 'FormData' body; ignores the response body. +-- +-- Sets @Content-Type: multipart\/form-data@ automatically. putFormData :: FromJSVal error => MisoString @@ -425,7 +468,9 @@ where formDataHeaders_ = biasHeaders headers_ [contentType =: formData] ---------------------------------------------------------------------------- --- | Retrieves an ArrayBuffer using the Fetch API. +-- | Retrieve a binary resource as an 'ArrayBuffer' via GET. +-- +-- Sets @Accept: application\/octet-stream@ automatically. getArrayBuffer :: FromJSVal error => MisoString @@ -446,7 +491,9 @@ where arrayBufferHeaders_ = biasHeaders headers_ [accept =: octetStream] ---------------------------------------------------------------------------- --- | Sends a POST request with an ArrayBuffer. +-- | Send a POST request with an 'ArrayBuffer' body; ignores the response body. +-- +-- Sets @Content-Type: application\/octet-stream@ automatically. postArrayBuffer :: FromJSVal error => MisoString @@ -470,7 +517,9 @@ where arrayBufferHeaders_ = biasHeaders headers_ [contentType =: octetStream] ---------------------------------------------------------------------------- --- | Sends a PUT request with an ArrayBuffer. +-- | Send a PUT request with an 'ArrayBuffer' body; ignores the response body. +-- +-- Sets @Content-Type: application\/octet-stream@ automatically. putArrayBuffer :: FromJSVal error => MisoString @@ -494,7 +543,9 @@ where arrayBufferHeaders_ = biasHeaders headers_ [contentType =: octetStream] ---------------------------------------------------------------------------- --- | Retrieves a Uint8Array using the Fetch API. +-- | Retrieve a binary resource as a 'Uint8Array' via GET. +-- +-- Sets @Accept: application\/octet-stream@ automatically. getUint8Array :: FromJSVal error => MisoString @@ -515,7 +566,9 @@ where uint8ArrayHeaders_ = biasHeaders headers_ [accept =: octetStream] ---------------------------------------------------------------------------- --- | Sends a POST request with a Uint8Array. +-- | Send a POST request with a 'Uint8Array' body; ignores the response body. +-- +-- Sets @Content-Type: application\/octet-stream@ automatically. postUint8Array :: FromJSVal error => MisoString @@ -539,7 +592,9 @@ where uint8ArrayHeaders_ = biasHeaders headers_ [contentType =: octetStream] ---------------------------------------------------------------------------- --- | Sends a PUT request with a Uint8Array. +-- | Send a PUT request with a 'Uint8Array' body; ignores the response body. +-- +-- Sets @Content-Type: application\/octet-stream@ automatically. putUint8Array :: FromJSVal error => MisoString @@ -563,7 +618,7 @@ where uint8ArrayHeaders_ = biasHeaders headers_ [contentType =: octetStream] ---------------------------------------------------------------------------- --- | Sends a POST request with an 'Image'. +-- | Send a POST request with an 'Image' body; ignores the response body. postImage :: FromJSVal error => MisoString @@ -585,7 +640,7 @@ (sink . errorful) NONE ---------------------------------------------------------------------------- --- | Sends a PUT request with an 'Image'. +-- | Send a PUT request with an 'Image' body; ignores the response body. putImage :: FromJSVal error => MisoString @@ -607,34 +662,40 @@ (sink . errorful) NONE ---------------------------------------------------------------------------- --- | Type synonym for request body. +-- | Type synonym for a raw JavaScript request body. type Body = JSVal ---------------------------------------------------------------------------- --- | Value for specifying "Accept" in an HTTP header +-- | HTTP header name @\"Accept\"@. +-- Use with '=:' to build request headers, e.g. @accept =: applicationJSON@. accept :: MisoString accept = "Accept" ---------------------------------------------------------------------------- --- | Value for specifying "Content-Type" in an HTTP header +-- | HTTP header name @\"Content-Type\"@. +-- Use with '=:' to build request headers, e.g. @contentType =: textPlain@. contentType :: MisoString contentType = "Content-Type" ---------------------------------------------------------------------------- --- | Value for specifying "application/json" in an HTTP header +-- | MIME type @\"application\/json\"@. applicationJSON :: MisoString applicationJSON = "application/json" ---------------------------------------------------------------------------- --- | Value for specifying "text/plain" in an HTTP header +-- | MIME type @\"text\/plain\"@. textPlain :: MisoString textPlain = "text/plain" ---------------------------------------------------------------------------- --- | Value for specifying "application/octet-stream" in an HTTP header +-- | MIME type @\"application\/octet-stream\"@. Used for binary payloads. octetStream :: MisoString octetStream = "application/octet-stream" ---------------------------------------------------------------------------- --- | Value for specifying "multipart/form-data" in an HTTP header +-- | MIME type @\"multipart\/form-data\"@. formData :: MisoString formData = "multipart/form-data" ---------------------------------------------------------------------------- --- | Helper function for the union of two header Map +-- | Merge two header lists, giving precedence to the first (user-supplied) list. +-- +-- Duplicate keys in @contentSpecific@ are dropped when the same key already +-- appears in @userDefined@, allowing callers to override the library's default +-- @Content-Type@ and @Accept@ headers. biasHeaders :: Ord k => [(k, a)] -> [(k, a)] -> [(k, a)] biasHeaders userDefined contentSpecific = M.toList diff --git a/src/Miso/Html.hs b/src/Miso/Html.hs --- a/src/Miso/Html.hs +++ b/src/Miso/Html.hs @@ -7,34 +7,79 @@ -- Stability : experimental -- Portability : non-portable -- --- Example usage: +-- = Overview -- +-- "Miso.Html" is the HTML DSL re-export hub. It collects element smart +-- constructors, pre-wired event handlers, and the server-side rendering +-- typeclass into a single convenient import. +-- +-- The top-level "Miso" module already re-exports everything from +-- "Miso.Html", so applications that @import Miso@ have the entire HTML +-- layer in scope without an additional import. Import "Miso.Html" +-- directly only when you want the HTML DSL in isolation β€” for example, +-- in a view-only library that should not depend on the miso runtime. +-- +-- __Note:__ "Miso.Html.Property" (@'Miso.Html.Property.id_'@, +-- @'Miso.Html.Property.class_'@, @'Miso.Html.Property.href_'@, …) is +-- /not/ re-exported here. Import it separately, or use the top-level +-- "Miso" import which includes everything. +-- +-- = Quick start +-- -- @ --- import Miso --- import Miso.String +-- import "Miso" +-- import "Miso.Html.Property" ('Miso.Html.Property.class_') -- --- data Action = Add | Subtract +-- data Action = Increment | Decrement | Reset -- --- view_ :: Int -> View Int Action --- view_ n = div_ --- [ class_ "main" ] --- [ button_ [ onClick Add ] [ text_ "+" ] --- , text_ (ms n) --- , button_ [ onClick Subtract ] [ text_ "-" ] --- ] +-- view :: Int -> 'Miso.Types.View' Int Action +-- view n = +-- 'div_' [ 'Miso.Html.Property.class_' \"counter\" ] +-- [ 'h1_' [] [ 'Miso.text' \"Counter\" ] +-- , 'p_' [] [ 'Miso.text' ('Miso.String.ms' n) ] +-- , 'button_' [ 'onClick' Increment ] [ 'Miso.text' \"+\" ] +-- , 'button_' [ 'onClick' Decrement ] [ 'Miso.text' \"-\" ] +-- , 'button_' [ 'onClick' Reset ] [ 'Miso.text' \"Reset\" ] +-- ] -- @ -- --- More information on how to use @miso@ is available on GitHub. +-- = Re-exported modules -- --- +-- ["Miso.Html.Element"] +-- Smart constructors for every standard HTML element (@'div_'@, +-- @'button_'@, @'input_'@, @'table_'@, …). All names are suffixed +-- with @_@ to avoid clashing with 'Prelude' identifiers. -- +-- ["Miso.Html.Event"] +-- Pre-wired event-handler attributes (@'onClick'@, @'onInput'@, +-- @'onKeyDown'@, @'onDrop'@, …). Covers mouse, keyboard, form, focus, +-- pointer, drag, touch, media, and lifecycle events. +-- +-- ["Miso.Html.Render"] +-- The 'Miso.Html.Render.ToHtml' typeclass for serialising a +-- 'Miso.Types.View' tree to a lazy @ByteString@ of UTF-8 HTML +-- (server-side rendering \/ SSR). +-- +-- = See also +-- +-- * "Miso.Html.Element" β€” full element reference with groupings +-- * "Miso.Html.Event" β€” full event-handler reference with naming conventions +-- * "Miso.Html.Property" β€” DOM properties and attributes (@'Miso.Html.Property.id_'@, +-- @'Miso.Html.Property.class_'@, @'Miso.Html.Property.src_'@, …) +-- * "Miso.Html.Render" β€” SSR rendering rules and @-fssr@ flag details +-- * "Miso.Svg" β€” SVG element, event, and property combinators +-- * "Miso.CSS" β€” structured CSS property DSL +-- * "Miso" β€” complete miso API including runtime, routing, and FFI +-- +-- More information and examples are available at . +-- ---------------------------------------------------------------------------- module Miso.Html - ( -- ** Elements + ( -- * Elements module Miso.Html.Element - -- ** Events + -- * Events , module Miso.Html.Event - -- ** Render + -- * Rendering , module Miso.Html.Render ) where ----------------------------------------------------------------------------- diff --git a/src/Miso/Html/Element.hs b/src/Miso/Html/Element.hs --- a/src/Miso/Html/Element.hs +++ b/src/Miso/Html/Element.hs @@ -11,9 +11,68 @@ -- Stability : experimental -- Portability : non-portable -- --- Predefined list of HTML elements +-- = Overview -- ----------------------------------------------------------------------------- +-- "Miso.Html.Element" provides smart constructors for every +-- . +-- Each constructor has the signature: +-- +-- @ +-- tagName_ :: ['Miso.Types.Attribute' action] -> ['Miso.Types.View' model action] -> 'Miso.Types.View' model action +-- @ +-- +-- All names are suffixed with @_@ to avoid clashing with Haskell +-- 'Prelude' names (e.g. 'div_', 'head_', 'map_'). +-- This module is re-exported in its entirety by "Miso.Html" and "Miso". +-- +-- = Quick start +-- +-- @ +-- import "Miso" +-- +-- view :: Model -> 'Miso.Types.View' Model Action +-- view m = +-- 'div_' [] +-- [ 'h1_' [] [ 'Miso.text' \"Hello, miso!\" ] +-- , 'p_' [ 'Miso.Html.Property.class_' \"intro\" ] +-- [ 'Miso.text' \"Counter: \", 'Miso.text' ('Miso.String.ms' m) ] +-- , 'button_' [ 'Miso.Html.Event.onClick' Increment ] [ 'Miso.text' \"+\" ] +-- ] +-- @ +-- +-- = Element groups +-- +-- * __Document metadata__: 'html_', 'head_', 'base_', 'link_', 'meta_', +-- 'style_', 'title_', 'doctype_' +-- * __Sectioning__: 'body_', 'address_', 'article_', 'aside_', 'footer_', +-- 'header_', 'h1_'–'h6_', 'hgroup_', 'main_', 'nav_', 'section_', 'search_' +-- * __Text content__: 'blockquote_', 'dd_', 'div_', 'dl_', 'dt_', +-- 'figcaption_', 'figure_', 'hr_', 'li_', 'menu_', 'ol_', 'p_', 'pre_', +-- 'ul_' +-- * __Inline semantics__: 'a_', 'abbr_', 'b_', 'bdi_', 'bdo_', 'br_', +-- 'cite_', 'code_', 'data_', 'dfn_', 'em_', 'i_', 'kbd_', 'mark_', +-- 'q_', 'rp_', 'rt_', 'ruby_', 's_', 'samp_', 'small_', 'span_', +-- 'strong_', 'sub_', 'sup_', 'time_', 'u_', 'var_', 'wbr_' +-- * __Embedded content__: 'audio_', 'canvas_', 'embed_', 'iframe_', +-- 'img_', 'map_', 'object_', 'picture_', 'portal_', 'source_', +-- 'track_', 'video_' +-- * __Scripting__: 'noscript_', 'script_' +-- * __Edits__: 'del_', 'ins_' +-- * __Table__: 'caption_', 'col_', 'colgroup_', 'table_', 'tbody_', +-- 'td_', 'tfoot_', 'th_', 'thead_', 'tr_' +-- * __Forms__: 'button_', 'datalist_', 'fieldset_', 'form_', 'input_', +-- 'label_', 'legend_', 'meter_', 'optgroup_', 'option_', 'output_', +-- 'progress_', 'select_', 'textarea_' +-- * __Interactive__: 'details_', 'dialog_', 'summary_' +-- * __Custom__: 'nodeHtml' for any tag name not listed above +-- +-- = See also +-- +-- * "Miso.Html.Property" β€” 'Miso.Html.Property.id_', 'Miso.Html.Property.class_', 'Miso.Html.Property.src_', … +-- * "Miso.Html.Event" β€” 'Miso.Html.Event.onClick', 'Miso.Html.Event.onInput', … +-- * "Miso.Html.Render" β€” server-side HTML rendering via 'Miso.Html.Render.ToHtml' +-- * "Miso.Svg.Element" β€” SVG element constructors +----------------------------------------------------------------------------- module Miso.Html.Element ( -- ** Smart constructors nodeHtml diff --git a/src/Miso/Html/Event.hs b/src/Miso/Html/Event.hs --- a/src/Miso/Html/Event.hs +++ b/src/Miso/Html/Event.hs @@ -9,7 +9,76 @@ -- Stability : experimental -- Portability : non-portable -- ----------------------------------------------------------------------------- +-- = Overview +-- +-- "Miso.Html.Event" provides pre-wired event-handler 'Miso.Types.Attribute' +-- values for the most common browser events. Each handler is built on the +-- lower-level 'Miso.Event.on' \/ 'Miso.Event.onWithOptions' primitives from +-- "Miso.Event". +-- +-- This module is re-exported in its entirety by "Miso.Html" and "Miso". +-- +-- = Naming conventions +-- +-- Handlers follow a consistent naming pattern: +-- +-- [@onXxx action@] fires @action@; no event data extracted +-- [@onXxxWith (a -> action)@] passes extracted event data or 'Miso.Effect.DOMRef' +-- [@onXxxWithOptions opts act@] adds 'Miso.Event.Types.Options' (@preventDefault@ \/ @stopPropagation@) before firing +-- [@onXxxCapture action@] registers in the capture phase instead of bubble +-- +-- = Quick start +-- +-- @ +-- import "Miso" +-- +-- view :: Model -> 'Miso.Types.View' Model Action +-- view m = +-- 'Miso.Html.Element.div_' [] +-- [ 'Miso.Html.Element.button_' [ 'onClick' Increment ] [ 'Miso.text' \"+\" ] +-- , 'Miso.Html.Element.input_' [ 'onInput' SetText +-- , 'Miso.Html.Property.value_' m.text ] [] +-- , 'Miso.Html.Element.form_' [ 'onSubmit' Submit ] [] -- preventDefault by default +-- ] +-- @ +-- +-- = Event groups +-- +-- * __Mouse__: 'onClick', 'onClickCapture', 'onClickWith', 'onClickWithOptions', +-- 'onClickPrevent', 'onDoubleClick', 'onDoubleClickWith', +-- 'onMouseDown', 'onMouseUp', 'onMouseEnter', 'onMouseLeave', +-- 'onMouseOver', 'onMouseOut', 'onContextMenuWithOptions' +-- * __Keyboard__: 'onKeyDown', 'onKeyDownWithInfo', 'onKeyPress', 'onKeyUp', 'onEnter' +-- * __Form__: 'onInput', 'onInputWith', 'onChange', 'onChangeWith', +-- 'onChecked', 'onSubmit', 'onSelect' +-- * __Focus__: 'onFocus', 'onBlur' +-- * __Drag__: 'onDrag', 'onDragStart', 'onDragEnd', 'onDragEnter', +-- 'onDragLeave', 'onDragOver', 'onDrop' (and @WithOptions@ variants) +-- * __Pointer__: 'onPointerDown', 'onPointerUp', 'onPointerEnter', +-- 'onPointerLeave', 'onPointerOver', 'onPointerOut', +-- 'onPointerCancel', 'onPointerMove' +-- * __Media__: 'onPlay', 'onPause', 'onEnded', 'onTimeUpdate', +-- 'onVolumeChange', 'onLoadedData', 'onLoadedMetadata', … (and @With@ variants) +-- * __Touch__: 'onTouchStart', 'onTouchEnd', 'onTouchMove', +-- 'onTouchCancel' (and @WithOptions@ variants) +-- * __Lifecycle__: 'onLoad', 'onUnload', 'onError' +-- +-- = Notes +-- +-- * 'onSubmit' enables @preventDefault@ by default to suppress the native +-- form submission. +-- * 'onEnter' is a convenience wrapper around 'onKeyDown' that fires +-- different actions depending on whether @keyCode == 13@. +-- * The @WithOptions@ variants require 'Miso.Event.Types.defaultEvents' (or a +-- superset) to include the relevant event name in the component's @events@ map. +-- +-- = See also +-- +-- * "Miso.Event" β€” 'Miso.Event.on', 'Miso.Event.onCapture', 'Miso.Event.onWithOptions' +-- * "Miso.Event.Decoder" β€” 'Miso.Event.Decoder.Decoder' for custom event extraction +-- * "Miso.Event.Types" β€” 'Miso.Event.Types.Options', 'Miso.Event.Types.KeyCode', +-- 'Miso.Event.Types.PointerEvent' +----------------------------------------------------------------------------- module Miso.Html.Event ( -- *** Mouse onClick @@ -155,7 +224,12 @@ -- @ -- -- @since 1.9.0.0 -onContextMenuWithOptions :: Options -> action -> Attribute action +onContextMenuWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch when the context menu event fires + -> Attribute action onContextMenuWithOptions opts action = onWithOptions BUBBLE opts "contextmenu" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- @@ -173,7 +247,12 @@ onClickWith action = on "click" emptyDecoder $ \() domRef -> action domRef ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/click -onClickWithOptions :: Options -> action -> Attribute action +onClickWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch on click + -> Attribute action onClickWithOptions options action = onWithOptions BUBBLE options "click" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/click @@ -193,36 +272,62 @@ onDoubleClickWith f = on "dblclick" emptyDecoder $ \() domRef -> f domRef ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/dblclick -onDoubleClickWithOptions :: Options -> action -> Attribute action +onDoubleClickWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch on double-click + -> Attribute action onDoubleClickWithOptions options action = onWithOptions BUBBLE options "dblclick" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/input -onInput :: (MisoString -> action) -> Attribute action +onInput + :: (MisoString -> action) + -- ^ Callback receiving @event.target.value@ + -> Attribute action onInput f = on "input" valueDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/input -onInputWith :: (MisoString -> DOMRef -> action) -> Attribute action +onInputWith + :: (MisoString -> DOMRef -> action) + -- ^ Callback receiving @event.target.value@ and the element's 'DOMRef' + -> Attribute action onInputWith = on "input" valueDecoder ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/change -onChange :: (MisoString -> action) -> Attribute action +onChange + :: (MisoString -> action) + -- ^ Callback receiving @event.target.value@ + -> Attribute action onChange f = on "change" valueDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/change -onChangeWith :: (MisoString -> DOMRef -> action) -> Attribute action +onChangeWith + :: (MisoString -> DOMRef -> action) + -- ^ Callback receiving @event.target.value@ and the element's 'DOMRef' + -> Attribute action onChangeWith = on "change" valueDecoder ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/select -onSelect :: (MisoString -> action) -> Attribute action +onSelect + :: (MisoString -> action) + -- ^ Callback receiving @event.target.value@ of the selected text + -> Attribute action onSelect f = on "select" valueDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/keydown -onKeyDownWithInfo :: (KeyInfo -> action) -> Attribute action +onKeyDownWithInfo + :: (KeyInfo -> action) + -- ^ Callback receiving the key code and modifier key state + -> Attribute action onKeyDownWithInfo f = on "keydown" keyInfoDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/keydown -onKeyDown :: (KeyCode -> action) -> Attribute action +onKeyDown + :: (KeyCode -> action) + -- ^ Callback receiving the numeric key code of the pressed key + -> Attribute action onKeyDown f = on "keydown" keycodeDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | 'onEnter' @@ -249,11 +354,17 @@ onEnter nothing action = onKeyDown $ bool nothing action . (==13) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/keypress -onKeyPress :: (KeyCode -> action) -> Attribute action +onKeyPress + :: (KeyCode -> action) + -- ^ Callback receiving the numeric key code of the pressed key + -> Attribute action onKeyPress f = on "keypress" keycodeDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/keyup -onKeyUp :: (KeyCode -> action) -> Attribute action +onKeyUp + :: (KeyCode -> action) + -- ^ Callback receiving the numeric key code of the released key + -> Attribute action onKeyUp f = on "keyup" keycodeDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/mouseup @@ -285,7 +396,12 @@ onDragStart action = on "dragstart" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/dragstart -onDragStartWithOptions :: Options -> action -> Attribute action +onDragStartWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch when the drag starts + -> Attribute action onDragStartWithOptions options action = onWithOptions BUBBLE options "dragstart" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- @@ -294,7 +410,12 @@ onDragOver action = on "dragover" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/dragover -onDragOverWithOptions :: Options -> action -> Attribute action +onDragOverWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch while the dragged element is over this target + -> Attribute action onDragOverWithOptions options action = onWithOptions BUBBLE options "dragover" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- @@ -303,7 +424,12 @@ onDragEnd action = on "dragend" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/dragend -onDragEndWithOptions :: Options -> action -> Attribute action +onDragEndWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch when the drag operation ends + -> Attribute action onDragEndWithOptions options action = onWithOptions BUBBLE options "dragend" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- @@ -312,7 +438,12 @@ onDragEnter action = on "dragenter" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/dragenter -onDragEnterWithOptions :: Options -> action -> Attribute action +onDragEnterWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch when a dragged element enters this target + -> Attribute action onDragEnterWithOptions options action = onWithOptions BUBBLE options "dragenter" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- @@ -321,7 +452,12 @@ onDragLeave action = on "dragleave" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/dragleave -onDragLeaveWithOptions :: Options -> action -> Attribute action +onDragLeaveWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch when a dragged element leaves this target + -> Attribute action onDragLeaveWithOptions options action = onWithOptions BUBBLE options "dragleave" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- @@ -330,17 +466,32 @@ onDrag action = on "drag" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/drag -onDragWithOptions :: Options -> action -> Attribute action +onDragWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch while the element is being dragged + -> Attribute action onDragWithOptions options action = onWithOptions BUBBLE options "drag" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/drop -onDrop :: Options -> action -> Attribute action +onDrop + :: Options + -- ^ Propagation options β€” typically include @preventDefault@ to allow the drop + -> action + -- ^ Action to dispatch when a dragged element is dropped on this target + -> Attribute action onDrop options action = onWithOptions BUBBLE options "drop" emptyDecoder (\() _ -> action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/drop -onDropWithOptions :: Options -> action -> Attribute action +onDropWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch on drop + -> Attribute action onDropWithOptions options action = onWithOptions BUBBLE options "drop" emptyDecoder (\() _ -> action) ----------------------------------------------------------------------------- @@ -354,35 +505,59 @@ "submit" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/pointerup -onPointerUp :: (PointerEvent -> action) -> Attribute action +onPointerUp + :: (PointerEvent -> action) + -- ^ Callback receiving the full 'PointerEvent' + -> Attribute action onPointerUp f = on "pointerup" pointerDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/pointerdown -onPointerDown :: (PointerEvent -> action) -> Attribute action +onPointerDown + :: (PointerEvent -> action) + -- ^ Callback receiving the full 'PointerEvent' + -> Attribute action onPointerDown f = on "pointerdown" pointerDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/pointerenter -onPointerEnter :: (PointerEvent -> action) -> Attribute action +onPointerEnter + :: (PointerEvent -> action) + -- ^ Callback receiving the full 'PointerEvent' + -> Attribute action onPointerEnter f = on "pointerenter" pointerDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/pointerleave -onPointerLeave :: (PointerEvent -> action) -> Attribute action +onPointerLeave + :: (PointerEvent -> action) + -- ^ Callback receiving the full 'PointerEvent' + -> Attribute action onPointerLeave f = on "pointerleave" pointerDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/pointerover -onPointerOver :: (PointerEvent -> action) -> Attribute action +onPointerOver + :: (PointerEvent -> action) + -- ^ Callback receiving the full 'PointerEvent' + -> Attribute action onPointerOver f = on "pointerover" pointerDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/pointerout -onPointerOut :: (PointerEvent -> action) -> Attribute action +onPointerOut + :: (PointerEvent -> action) + -- ^ Callback receiving the full 'PointerEvent' + -> Attribute action onPointerOut f = on "pointerout" pointerDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/pointercancel -onPointerCancel :: (PointerEvent -> action) -> Attribute action +onPointerCancel + :: (PointerEvent -> action) + -- ^ Callback receiving the full 'PointerEvent' + -> Attribute action onPointerCancel f = on "pointercancel" pointerDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/pointermove -onPointerMove :: (PointerEvent -> action) -> Attribute action +onPointerMove + :: (PointerEvent -> action) + -- ^ Callback receiving the full 'PointerEvent' + -> Attribute action onPointerMove f = on "pointermove" pointerDecoder (\action _ -> f action) ----------------------------------------------------------------------------- -- | https://www.w3schools.com/tags/av_event_abort.asp @@ -574,7 +749,12 @@ onTouchStart action = on "touchstart" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/touchstart -onTouchStartWithOptions :: Options -> action -> Attribute action +onTouchStartWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch on touch start + -> Attribute action onTouchStartWithOptions options action = onWithOptions BUBBLE options "touchstart" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/touchend @@ -582,7 +762,12 @@ onTouchEnd action = on "touchend" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/touchend -onTouchEndWithOptions :: Options -> action -> Attribute action +onTouchEndWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch on touch end + -> Attribute action onTouchEndWithOptions options action = onWithOptions BUBBLE options "touchend" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/touchmove @@ -590,7 +775,12 @@ onTouchMove action = on "touchmove" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/touchmove -onTouchMoveWithOptions :: Options -> action -> Attribute action +onTouchMoveWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch while a touch point is moving + -> Attribute action onTouchMoveWithOptions options action = onWithOptions BUBBLE options "touchmove" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/touchcancel @@ -598,6 +788,11 @@ onTouchCancel action = on "touchcancel" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/touchcancel -onTouchCancelWithOptions :: Options -> action -> Attribute action +onTouchCancelWithOptions + :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) + -> action + -- ^ Action to dispatch when a touch point is cancelled + -> Attribute action onTouchCancelWithOptions options action = onWithOptions BUBBLE options "touchcancel" emptyDecoder $ \() _ -> action ----------------------------------------------------------------------------- diff --git a/src/Miso/Html/Property.hs b/src/Miso/Html/Property.hs --- a/src/Miso/Html/Property.hs +++ b/src/Miso/Html/Property.hs @@ -9,11 +9,87 @@ -- Stability : experimental -- Portability : non-portable -- --- Construct custom properties on DOM elements +-- = Overview -- --- > div_ [ id_ "miso" ] [ "miso" ] +-- "Miso.Html.Property" provides smart constructors for +-- +-- and +-- . +-- Each produces an 'Miso.Types.Attribute' that the virtual DOM applies to +-- the corresponding DOM node on every render, diffing only changed values. -- ----------------------------------------------------------------------------- +-- All names are suffixed with @_@ to avoid clashing with Haskell +-- 'Prelude' names. This module is re-exported in its entirety by +-- "Miso.Html" and "Miso". +-- +-- = Quick start +-- +-- @ +-- import "Miso" +-- +-- view :: Model -> 'Miso.Types.View' Model Action +-- view m = +-- 'Miso.Html.Element.div_' [ 'id_' \"app\", 'class_' \"container\" ] +-- [ 'Miso.Html.Element.input_' +-- [ 'type_' \"text\" +-- , 'value_' m.text +-- , 'placeholder_' \"Type here…\" +-- , 'disabled_' +-- ] +-- [] +-- , 'Miso.Html.Element.img_' +-- [ 'src_' \"logo.png\", 'alt_' \"Logo\", 'width_' \"64\", 'height_' \"64\" ] +-- [] +-- ] +-- @ +-- +-- = Class management +-- +-- Four combinators handle CSS classes: +-- +-- @ +-- 'class_' \"foo bar\" -- single string, set className +-- 'className' \"foo bar\" -- alias for class_ +-- 'classes_' [\"foo\", \"bar\"] -- list of class names +-- 'classList_' [(\"active\", isActive) -- conditional classes +-- ,(\"error\", hasError)] +-- @ +-- +-- = Property groups +-- +-- * __Global__: 'id_', 'class_', 'className', 'classes_', 'classList_', +-- 'title_', 'lang_', 'hidden_', 'inert_', 'draggable_', 'tabindex_', +-- 'role_', 'data_', 'aria_', 'xmlns_' +-- * __Form__: 'type_', 'value_', 'defaultValue_', 'checked_', 'placeholder_', +-- 'selected_', 'disabled_', 'readonly_', 'required_', 'multiple_', +-- 'autofocus_', 'autocomplete_', 'autocorrect_', 'spellcheck_', +-- 'name_', 'for_', 'form_', 'action_', 'method_', 'enctype_', +-- 'noValidate_', 'accept_', 'acceptCharset_', 'pattern_', +-- 'min_', 'max_', 'step_', 'size_', 'maxlength_', 'minlength_', +-- 'list_', 'cols_', 'rows_', 'wrap_' +-- * __Link \/ anchor__: 'href_', 'target_', 'rel_', 'hreflang_', +-- 'download_', 'downloadAs_', 'ping_', 'media_' +-- * __Image \/ map__: 'src_', 'alt_', 'width_', 'height_', 'loading_', +-- 'ismap_', 'usemap_', 'shape_', 'coords_' +-- * __Media__: 'autoplay_', 'controls_', 'loop_', 'muted_', 'preload_', +-- 'poster_', 'volume_', 'currentTime_', 'defaultMuted_', +-- 'defaultPlaybackRate_', 'playbackRate_', 'seeking_', 'mediaGroup_' +-- * __Table__: 'colspan_', 'rowspan_', 'headers_', 'scope_', 'align_' +-- * __\ \/ \__: 'async_', 'defer_', 'charset_', 'content_', +-- 'httpEquiv_', 'language_', 'scoped_' +-- * __\__: 'sandbox_', 'seamless_', 'srcdoc_', 'frameborder_', +-- 'scrolling_' +-- * __Misc__: 'open_', 'reversed_', 'default_', 'kind_', 'srclang_', +-- 'label_', 'autosave_', 'formation_', 'ref_' +-- +-- = See also +-- +-- * "Miso.Property" β€” lower-level 'Miso.Property.textProp', 'Miso.Property.boolProp', +-- 'Miso.Property.intProp', 'Miso.Property.doubleProp' combinators +-- * "Miso.Html.Element" β€” element constructors that accept these attributes +-- * "Miso.Html.Event" β€” event-handler attributes +-- * "Miso.CSS" β€” style property DSL ('Miso.CSS.style_', 'Miso.CSS.styleInline_') +----------------------------------------------------------------------------- module Miso.Html.Property ( -- *** Combinators class_ diff --git a/src/Miso/Html/Render.hs b/src/Miso/Html/Render.hs --- a/src/Miso/Html/Render.hs +++ b/src/Miso/Html/Render.hs @@ -3,8 +3,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | @@ -15,9 +13,60 @@ -- Stability : experimental -- Portability : non-portable -- --- 'Miso.Types.View' serialization +-- = Overview -- ----------------------------------------------------------------------------- +-- "Miso.Html.Render" provides the 'ToHtml' typeclass for serialising a +-- 'Miso.Types.View' tree to a lazy 'Data.ByteString.Lazy.ByteString' of +-- UTF-8 HTML. This is the foundation of miso's +-- +-- support. +-- +-- Instances are provided for both @'Miso.Types.View' m a@ (a single node) +-- and @['Miso.Types.View' m a]@ (a sequence of nodes). +-- +-- = Quick start +-- +-- @ +-- import "Miso.Html.Render" ('ToHtml', 'toHtml') +-- import qualified Data.ByteString.Lazy as L +-- +-- renderPage :: Model -> L.ByteString +-- renderPage m = 'toHtml' (view m) +-- @ +-- +-- With @servant@, use @'toHtml'@ inside a @'Data.ByteString.Lazy.ByteString'@ +-- or @OctetStream@ response, or wire it into a 'Miso.Html.Render.ToHtml' servant +-- MIME type. +-- +-- = Rendering rules +-- +-- * __'Miso.Types.VNode'__ β€” rendered as @\children\<\/tag\>@. +-- Self-closing elements (@\@, @\@, @\@, …) are +-- rendered without a closing tag. +-- * __'Miso.Types.VText'__ β€” rendered as a raw text string (no escaping +-- beyond what is already in the 'Miso.String.MisoString'). +-- * __'Miso.Types.VComp'__ β€” recursively renders the sub-component's view +-- using its initial (or hydrated) model. +-- * __'Miso.Types.VFrag'__ β€” renders all children inline, no wrapper tag. +-- * __Event handlers__ (@'Miso.Types.On'@) β€” silently dropped; they have +-- no meaning in a static HTML string. +-- * __Boolean properties__ (@disabled@, @checked@, @required@, …) β€” rendered +-- as bare attribute names when @True@, omitted entirely when @False@. +-- * __Adjacent text nodes__ β€” collapsed into a single text node to match +-- browser parsing behaviour during hydration. +-- +-- = SSR flag +-- +-- When compiled with @-fssr@ the renderer calls the component's optional +-- @hydrateModel@ action to derive the initial model (e.g. by fetching from +-- a database), falling back to the static @model@ if the action throws. +-- +-- = See also +-- +-- * "Miso.Hydrate" β€” client-side hydration from server-rendered HTML +-- * "Miso.Html.Element" β€” element smart constructors +-- * "Miso.Html" β€” top-level HTML DSL re-export hub +----------------------------------------------------------------------------- module Miso.Html.Render ( -- *** Classes ToHtml (..) @@ -118,26 +167,26 @@ ] where selfClosing = htmls <> svgs <> mathmls htmls = [ x - | x <- [ "area", "base", "col", "embed", "img", "input", "br", "hr", "meta", "link", "param", "source", "track", "wbr" ] - , ns == HTML + | ns == HTML + , x <- [ "area", "base", "col", "embed", "img", "input", "br", "hr", "meta", "link", "param", "source", "track", "wbr" ] ] svgs = [ x - | x <- [ "circle", "line", "rect", "path", "ellipse", "polygon", "polyline", "use", "image"] - , ns == SVG + | ns == SVG + , x <- [ "circle", "line", "rect", "path", "ellipse", "polygon", "polyline", "use", "image"] ] mathmls = [ x - | x <- ["mglyph", "mprescripts", "none", "maligngroup", "malignmark" ] - , ns == MATHML + | ns == MATHML + , x <- ["mglyph", "mprescripts", "none", "maligngroup", "malignmark" ] ] renderBuilder (VComp _ (SomeComponent props vcomp_)) = foldMap renderBuilder vkids where #ifdef SSR - vkids = [ unsafeCoerce $ (view vcomp_) props (getInitialComponentModel vcomp_) ] + vkids = [ unsafeCoerce $ view vcomp_ props (getInitialComponentModel vcomp_) ] #else - vkids = [ unsafeCoerce $ (view vcomp_) props (model vcomp_) ] + vkids = [ unsafeCoerce $ view vcomp_ props (model vcomp_) ] #endif renderBuilder (VFrag _ kids) = foldMap renderBuilder kids ---------------------------------------------------------------------------- @@ -167,7 +216,7 @@ , stringUtf8 "\"" ] renderAttrs (On _) = mempty -renderAttrs (Styles styles) = +renderAttrs (Styles styles_) = mconcat [ "style" , stringUtf8 "=\"" @@ -178,7 +227,7 @@ , fromMisoString v , charUtf8 ';' ] - | (k,v) <- M.toList styles + | (k,v) <- M.toList styles_ ] , stringUtf8 "\"" ] diff --git a/src/Miso/JSON.hs b/src/Miso/JSON.hs --- a/src/Miso/JSON.hs +++ b/src/Miso/JSON.hs @@ -23,11 +23,114 @@ -- Stability : experimental -- Portability : non-portable -- --- A JSON library specialized to MisoString for performance. Largely based --- on [microaeson](https://hackage-content.haskell.org/package/microaeson). +-- = Overview -- --- Uses JS runtime primitives `JSON.stringify()` and `JSON.parse()`. +-- "Miso.JSON" is a JSON library tailored to 'MisoString', modelled after +-- and inspired by +-- . It provides +-- encoding, decoding, and a Generic-deriving mechanism that mirrors aeson's +-- defaults, making it straightforward to reuse existing aeson-compatible type +-- class instances. -- +-- = Platform behaviour +-- +-- * __Client__ (WASM \/ GHC JS backend) β€” 'encode' calls @JSON.stringify()@ and +-- 'decode' calls @JSON.parse()@ via FFI for maximum performance. +-- * __Server__ (@-fssr@ \/ @VANILLA@ build) β€” a pure Haskell +-- lexer\/parser pipeline ("Miso.JSON.Lexer" + "Miso.JSON.Parser") is used +-- instead, with no JavaScript dependency. +-- +-- The same type class instances work on both platforms; only the underlying +-- serialisation primitive differs. +-- +-- = Quick start +-- +-- @ +-- {-\# LANGUAGE DeriveGeneric \#-} +-- import GHC.Generics (Generic) +-- import "Miso.JSON" +-- import "Miso.String" ('MisoString') +-- +-- data Person = Person +-- { name :: MisoString +-- , age :: Int +-- } deriving (Generic, Show, Eq) +-- +-- instance 'ToJSON' Person +-- instance 'FromJSON' Person +-- +-- -- Encode to a JSON string: +-- encoded :: 'MisoString' +-- encoded = 'encode' (Person \"Alice\" 30) +-- -- Result: @\"{\\\"name\\\":\\\"Alice\\\",\\\"age\\\":30}\"@ +-- +-- -- Decode from a JSON string: +-- decoded :: Maybe Person +-- decoded = 'decode' encoded +-- @ +-- +-- = Constructing JSON values +-- +-- Use 'object' and '.=' to build 'Value' trees without defining a type: +-- +-- @ +-- point :: 'Value' +-- point = 'object' [ \"x\" '.=' (10 :: Int), \"y\" '.=' (20 :: Int) ] +-- @ +-- +-- = Writing instances by hand +-- +-- @ +-- data Color = Red | Green | Blue +-- +-- instance 'ToJSON' Color where +-- 'toJSON' Red = 'Miso.JSON.Types.String' \"red\" +-- 'toJSON' Green = 'Miso.JSON.Types.String' \"green\" +-- 'toJSON' Blue = 'Miso.JSON.Types.String' \"blue\" +-- +-- instance 'FromJSON' Color where +-- 'parseJSON' = 'withText' \"Color\" $ \\case +-- \"red\" -> pure Red +-- \"green\" -> pure Green +-- \"blue\" -> pure Blue +-- t -> 'typeMismatch' \"Color\" ('Miso.JSON.Types.String' t) +-- @ +-- +-- = Generic encoding options +-- +-- Generic instances follow aeson's default strategy. Customise with 'Options': +-- +-- @ +-- myOptions :: 'Options' +-- myOptions = 'defaultOptions' { 'fieldLabelModifier' = 'camelTo2' \'_\' } +-- +-- instance 'ToJSON' Person where +-- 'toJSON' = 'genericToJSON' myOptions +-- +-- -- { \"person_name\": \"Alice\", \"person_age\": 30 } +-- @ +-- +-- = API groups +-- +-- * __Core types__ β€” 'Value', 'Object', 'Pair', 'Result' +-- * __Constructors__ β€” 'object', '.=', 'emptyObject', 'emptyArray' +-- * __Accessors__ β€” '.:' (required), '.:?' (optional), '.:!' (optional\/nullable), '.!=' (default) +-- * __Encoding__ β€” 'encode', 'encodePure', 'encodePretty', 'encodePretty'' +-- * __Decoding__ β€” 'decode', 'eitherDecode', 'Parser.decodePure' +-- * __Type classes__ β€” 'ToJSON', 'FromJSON', 'Parser' +-- * __Prism-style parsers__ β€” 'withObject', 'withText', 'withArray', 'withNumber', 'withBool' +-- * __Conversion__ β€” 'fromJSON', 'parseMaybe', 'parseEither' +-- * __Options \/ Generics__ β€” 'Options', 'defaultOptions', 'genericToJSON', 'genericParseJSON', 'camelTo2' +-- * __FFI__ β€” 'toJSVal_Value', 'fromJSVal_Value', 'jsonStringify', 'jsonParse' +-- +-- = See also +-- +-- * "Miso.JSON.Types" β€” 'Value' and 'Result' type definitions +-- * "Miso.JSON.Lexer" β€” pure Haskell JSON tokeniser (server build) +-- * "Miso.JSON.Parser" β€” pure Haskell JSON parser (server build) +-- * "Miso.Event.Decoder" β€” uses 'Parser' and 'Value' for DOM event decoding +-- * "Miso.String" β€” 'MisoString', 'ms' +-- ---------------------------------------------------------------------------- module Miso.JSON ( -- * JSON @@ -108,13 +211,11 @@ import Data.Char import qualified Data.Map.Strict as M import Data.Map.Strict (Map) +import Data.Maybe (fromMaybe) import Data.Int import GHC.Natural (naturalToInteger, naturalFromInteger) import GHC.TypeLits import Data.Kind -#ifndef VANILLA -import qualified Data.Text as T -#endif import qualified Data.Text.Lazy as LT import Data.Word import GHC.Generics @@ -124,14 +225,20 @@ import qualified Miso.String as MS import Miso.JSON.Types import qualified Miso.JSON.Parser as Parser ----------------------------------------------------------------------------- import Numeric (showHex) +---------------------------------------------------------------------------- #ifndef VANILLA import Control.Monad.Trans.Maybe import System.IO.Unsafe (unsafePerformIO) +import qualified Data.Text as T #endif ---------------------------------------------------------------------------- +-- | Construct a JSON key\/value 'Pair'. Infix alias for @\\k v -> (k, 'toJSON' v)@. +-- +-- @ +-- object [ \"name\" .= (\"Alice\" :: MisoString), \"age\" .= (30 :: Int) ] +-- @ infixr 8 .= (.=) :: ToJSON v => MisoString -> v -> Pair k .= v = (k, toJSON v) @@ -148,30 +255,82 @@ emptyArray :: Value emptyArray = Array mempty ---------------------------------------------------------------------------- +-- | Look up a required key in a JSON 'Object'. +-- Fails with a parse error if the key is absent. (.:) :: FromJSON a => Object -> MisoString -> Parser a m .: k = maybe (pfail ("Key not found: " <> k)) parseJSON (M.lookup k m) ---------------------------------------------------------------------------- +-- | Look up an optional key in a JSON 'Object'. +-- Returns 'Nothing' if the key is absent; delegates to 'parseJSON' if present. (.:?) :: FromJSON a => Object -> MisoString -> Parser (Maybe a) m .:? k = maybe (pure Nothing) parseJSON (M.lookup k m) ---------------------------------------------------------------------------- +-- | Like '.:?' but always wraps a present value in 'Just', so a key with a +-- @null@ JSON value decodes to @Just Null@ rather than 'Nothing'. +-- Useful when you need to distinguish a missing key from an explicit null. (.:!) :: FromJSON a => Object -> MisoString -> Parser (Maybe a) m .:! k = maybe (pure Nothing) (fmap Just . parseJSON) (M.lookup k m) ---------------------------------------------------------------------------- +-- | Provide a default when a 'Parser' produces 'Nothing'. +-- Typically chained after '.:?': +-- +-- @o '.:?' \"count\" '.!=' 0@ (.!=) :: Parser (Maybe a) -> a -> Parser a -mv .!= def = fmap (maybe def id) mv +mv .!= def = fmap (fromMaybe def) mv ---------------------------------------------------------------------------- +-- | A type that can be serialised to a JSON 'Value'. +-- +-- Instances for the most common Haskell types are provided. Derive via +-- 'GHC.Generics' for product\/sum types, or write instances by hand for +-- full control: +-- +-- @ +-- -- Generic derivation (mirrors aeson defaults): +-- data Point = Point { x :: Double, y :: Double } +-- deriving (Generic, Show, Eq) +-- instance 'ToJSON' Point +-- +-- -- Manual instance: +-- instance 'ToJSON' Point where +-- 'toJSON' (Point x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y] +-- @ class ToJSON a where + -- | Convert a value to a JSON 'Value'. toJSON :: a -> Value default toJSON :: (Generic a, GToJSON (Rep a)) => a -> Value toJSON = genericToJSON defaultOptions + + -- | Encode a list of @a@. Defaults to a JSON 'Array'; overridden by the + -- 'Char' instance so that @[Char]@ (i.e. 'String') serializes as a JSON + -- string. This mirrors aeson and avoids overlapping @ToJSON [a]@ instances. + toJSONList :: [a] -> Value + toJSONList = Array . Prelude.map toJSON ---------------------------------------------------------------------------- -genericToJSON :: (Generic a, GToJSON (Rep a)) => Options -> a -> Value +-- | Derive 'toJSON' via 'GHC.Generics' with custom 'Options'. +-- Called by the default 'ToJSON' implementation using 'defaultOptions'. +genericToJSON + :: (Generic a, GToJSON (Rep a)) + => Options + -- ^ Encoding options (field\/constructor name modifiers, etc.) + -> a + -- ^ Value to encode + -> Value genericToJSON opts = gToJSON opts . from ---------------------------------------------------------------------------- +-- | Configuration for generic JSON encoding and decoding via 'genericToJSON' +-- and 'genericParseJSON'. Mirrors the subset of aeson's @Options@ that is +-- relevant to miso's Generic machinery. +-- +-- Construct with 'defaultOptions' and override only the fields you need: +-- +-- @ +-- myOpts :: 'Options' +-- myOpts = 'defaultOptions' { 'fieldLabelModifier' = 'camelTo2' \'_\' } +-- @ data Options = Options { fieldLabelModifier :: String -> String - -- ^ Modify record field names before encoding (default: identity). + -- ^ Applied to each record field name before encoding\/decoding (default: identity). , constructorTagModifier :: String -> String -- ^ Modify constructor names used as tags before encoding (default: identity). , allNullaryToStringTag :: Bool @@ -185,6 +344,9 @@ -- they are encoded as @null@. } ---------------------------------------------------------------------------- +-- | Default encoding\/decoding options, matching aeson's defaults: +-- no field or constructor name transformation, 'allNullaryToStringTag' enabled, +-- 'omitNothingFields' disabled. defaultOptions :: Options defaultOptions = Options { fieldLabelModifier = \x -> x @@ -193,7 +355,19 @@ , omitNothingFields = False } ---------------------------------------------------------------------------- -camelTo2 :: Char -> String -> String +-- | Convert a camelCase identifier to a separated form using the given delimiter. +-- +-- @ +-- camelTo2 '_' \"camelCaseField\" == \"camel_case_field\" +-- @ +-- +-- Commonly used as 'fieldLabelModifier' in a custom 'Options'. +camelTo2 + :: Char + -- ^ Delimiter character to insert between words (e.g. @\'_\'@ or @\'-\'@) + -> String + -- ^ camelCase identifier to transform + -> String camelTo2 c = Prelude.map toLower . go2 . go1 where go1 "" = "" go1 (x:u:l:xs) | isUpper u && isLower l = x : c : u : l : go1 xs @@ -375,15 +549,13 @@ ---------------------------------------------------------------------------- instance ToJSON Char where toJSON c = String (singleton c) + toJSONList = String . MS.pack ---------------------------------------------------------------------------- instance ToJSON Bool where toJSON = Bool ---------------------------------------------------------------------------- -instance {-# OVERLAPPING #-} ToJSON String where - toJSON = toJSON . MS.pack ----------------------------------------------------------------------------- -instance {-# OVERLAPPABLE #-} ToJSON a => ToJSON [a] where - toJSON = Array . Prelude.map toJSON +instance ToJSON a => ToJSON [a] where + toJSON = toJSONList ---------------------------------------------------------------------------- instance ToJSON v => ToJSON (M.Map MisoString v) where toJSON = Object . M.map toJSON @@ -441,8 +613,29 @@ -- | Possibly lossy due to conversion to 'Double' instance ToJSON Natural where toJSON = Number . fromInteger . naturalToInteger ---------------------------------------------------------------------------- -newtype Parser a = Parser { unParser :: Either MisoString a } - deriving (Functor, Applicative, Monad) +-- | A lightweight JSON parse monad. Wraps @Either MisoString a@ so that +-- parse failures carry a human-readable error message. +-- +-- 'Parser' is a 'Functor', 'Applicative', 'Monad', 'MonadFail', and +-- 'Alternative'. The 'Alternative' instance tries the right branch only when +-- the left branch fails β€” useful for decoding sum types with multiple valid +-- shapes. +-- +-- Combine with 'parseJSON' and the accessor operators ('.:' etc.) to build +-- composite decoders: +-- +-- @ +-- data Point = Point Double Double +-- +-- instance 'FromJSON' Point where +-- 'parseJSON' = 'withArray' \"Point\" $ \\xs -> +-- Point \<$\> 'parseJSON' (xs '!!' 0) +-- \<*\> 'parseJSON' (xs '!!' 1) +-- @ +newtype Parser a = Parser + { unParser :: Either MisoString a + -- ^ The underlying result: @'Left' errMsg@ on failure, @'Right' a@ on success + } deriving (Functor, Applicative, Monad) ---------------------------------------------------------------------------- instance MonadFail Parser where fail = pfail . pack @@ -454,19 +647,49 @@ ---------------------------------------------------------------------------- instance MonadPlus Parser ---------------------------------------------------------------------------- -parseMaybe :: (a -> Parser b) -> a -> Maybe b +-- | Run a parser function, returning 'Nothing' on failure instead of an error string. +parseMaybe + :: (a -> Parser b) + -- ^ Parser function to apply + -> a + -- ^ Input value to parse + -> Maybe b parseMaybe m v = case parseEither m v of Left _ -> Nothing - Right r -> Just r + Right r -> Just r ---------------------------------------------------------------------------- -parseEither :: (a -> Parser b) -> a -> Either MisoString b +-- | Run a parser function, returning @'Left' errMsg@ on failure. +parseEither + :: (a -> Parser b) + -- ^ Parser function to apply + -> a + -- ^ Input value to parse + -> Either MisoString b parseEither m v = unParser (m v) ---------------------------------------------------------------------------- pfail :: MisoString -> Parser a pfail message = Parser (Left message) ---------------------------------------------------------------------------- +-- | A type that can be deserialised from a JSON 'Value'. +-- +-- Instances for the most common Haskell types are provided. Derive via +-- 'GHC.Generics' for product\/sum types, or write instances by hand: +-- +-- @ +-- -- Generic derivation: +-- data Point = Point { x :: Double, y :: Double } +-- deriving (Generic, Show, Eq) +-- instance 'FromJSON' Point +-- +-- -- Manual instance: +-- instance 'FromJSON' Point where +-- 'parseJSON' = 'withObject' \"Point\" $ \\o -> +-- Point \<$\> o '.:' \"x\" \<*\> o '.:' \"y\" +-- @ class FromJSON a where + -- | Parse a JSON 'Value' into @a@, failing with a descriptive error message + -- via 'Parser' on a type mismatch. parseJSON :: Value -> Parser a default parseJSON :: (Generic a, GFromJSON (Rep a)) => Value -> Parser a parseJSON = genericParseJSON defaultOptions @@ -477,7 +700,15 @@ class GFromJSON (f :: Type -> Type) where gParseJSON :: Options -> Value -> Parser (f a) ---------------------------------------------------------------------------- -genericParseJSON :: (Generic a, GFromJSON (Rep a)) => Options -> Value -> Parser a +-- | Derive 'parseJSON' via 'GHC.Generics' with custom 'Options'. +-- Called by the default 'FromJSON' implementation using 'defaultOptions'. +genericParseJSON + :: (Generic a, GFromJSON (Rep a)) + => Options + -- ^ Decoding options (field\/constructor name modifiers, etc.) + -> Value + -- ^ JSON 'Value' to decode + -> Parser a genericParseJSON opts value = to <$> gParseJSON opts value ---------------------------------------------------------------------------- instance GFromJSONRep f => GFromJSON (D1 m f) where @@ -655,7 +886,7 @@ instance {-# OVERLAPPING #-} FromJSON String where parseJSON = withText "String" (pure . MS.unpack) ---------------------------------------------------------------------------- -instance {-# OVERLAPPABLE #-} FromJSON a => FromJSON [a] where +instance FromJSON a => FromJSON [a] where parseJSON = withArray "[a]" (mapM parseJSON) ---------------------------------------------------------------------------- instance FromJSON Double where @@ -673,7 +904,7 @@ parseJSON = withNumber "Natural" parseNumber where parseNumber d | d < 0 = pfail ("Cannot parse negative number as Natural: " <> ms d) | isNaN d = pfail ("Cannot parse NaN as Natural: " <> ms d) - | otherwise = pure $ naturalFromInteger $ fromInteger $ round d + | otherwise = pure $ naturalFromInteger $ fromInteger $ round d ---------------------------------------------------------------------------- instance FromJSON Int where parseJSON = withNumber "Int" (pure . fromInteger . round) @@ -750,27 +981,78 @@ instance FromJSON v => FromJSON (Map MisoString v) where parseJSON = withObject "FromJSON v => Map MisoString v" $ mapM parseJSON ---------------------------------------------------------------------------- -withBool :: MisoString -> (Bool -> Parser a) -> Value -> Parser a +-- | Succeed only when the 'Value' is a 'Bool'; fail with 'typeMismatch' otherwise. +withBool + :: MisoString + -- ^ Expected type name used in the error message (e.g. @\"MyType\"@) + -> (Bool -> Parser a) + -- ^ Continuation receiving the unwrapped 'Bool' + -> Value + -- ^ JSON value to inspect + -> Parser a withBool _ f (Bool arr) = f arr withBool expected _ v = typeMismatch expected v ---------------------------------------------------------------------------- -withText :: MisoString -> (MisoString -> Parser a) -> Value -> Parser a +-- | Succeed only when the 'Value' is a JSON string ('MisoString'); +-- fail with 'typeMismatch' otherwise. +withText + :: MisoString + -- ^ Expected type name used in the error message + -> (MisoString -> Parser a) + -- ^ Continuation receiving the unwrapped string + -> Value + -- ^ JSON value to inspect + -> Parser a withText _ f (String txt) = f txt withText expected _ v = typeMismatch expected v ---------------------------------------------------------------------------- -withArray :: MisoString -> ([Value] -> Parser a) -> Value -> Parser a +-- | Succeed only when the 'Value' is a JSON array; fail with 'typeMismatch' otherwise. +-- The inner parser receives the list of elements. +withArray + :: MisoString + -- ^ Expected type name used in the error message + -> ([Value] -> Parser a) + -- ^ Continuation receiving the list of array elements + -> Value + -- ^ JSON value to inspect + -> Parser a withArray _ f (Array lst) = f lst withArray expected _ v = typeMismatch expected v ---------------------------------------------------------------------------- -withObject :: MisoString -> (Object -> Parser a) -> Value -> Parser a +-- | Succeed only when the 'Value' is a JSON object; fail with 'typeMismatch' otherwise. +-- The inner parser receives the 'Object' map for key lookups with '.:' etc. +withObject + :: MisoString + -- ^ Expected type name used in the error message + -> (Object -> Parser a) + -- ^ Continuation receiving the 'Object' key\/value map + -> Value + -- ^ JSON value to inspect + -> Parser a withObject _ f (Object obj) = f obj withObject expected _ v = typeMismatch expected v ---------------------------------------------------------------------------- -withNumber :: MisoString -> (Double -> Parser a) -> Value -> Parser a +-- | Succeed only when the 'Value' is a JSON number; fail with 'typeMismatch' otherwise. +-- The inner parser receives the underlying 'Double'. +withNumber + :: MisoString + -- ^ Expected type name used in the error message + -> (Double -> Parser a) + -- ^ Continuation receiving the numeric value as a 'Double' + -> Value + -- ^ JSON value to inspect + -> Parser a withNumber _ f (Number n) = f n withNumber expected _ v = typeMismatch expected v ---------------------------------------------------------------------------- -typeMismatch :: MisoString -> Value -> Parser a +-- | Produce a parse failure describing a type mismatch. +-- Used by the @with*@ combinators and useful in hand-written 'FromJSON' instances. +typeMismatch + :: MisoString + -- ^ Human-readable name of the expected type (e.g. @\"Int\"@) + -> Value + -- ^ The actual 'Value' that was encountered + -> Parser a typeMismatch expected actual = pfail ( "typeMismatch: Expected " <> expected <> " but encountered " <> case actual of @@ -782,6 +1064,10 @@ Null -> "Null" ) ---------------------------------------------------------------------------- +-- | Encode a value as a JSON 'MisoString'. +-- +-- On the client (WASM \/ GHC JS backend) calls @JSON.stringify()@ via FFI for +-- maximum performance. On the server (@VANILLA@) falls back to 'encodePure'. #ifdef VANILLA encode :: ToJSON a => a -> MisoString encode = encodePure @@ -841,6 +1127,10 @@ MS.intercalate "," [ "\"" <> escapeJSONString k <> "\"" <> ":" <> ms v | (k,v) <- M.toList o ] <> "}" ---------------------------------------------------------------------------- +-- | Decode a JSON 'MisoString' into a Haskell value, returning 'Nothing' on failure. +-- +-- On the client calls @JSON.parse()@ via FFI. On the server uses the pure +-- Haskell parser. For a human-readable error message on failure use 'eitherDecode'. #ifdef VANILLA decode :: FromJSON a => MisoString -> Maybe a decode s @@ -872,10 +1162,14 @@ encodePretty_ffi :: JSVal -> Int -> IO MisoString #endif ----------------------------------------------------------------------------- +-- | Like 'encodePretty' but with a custom 'Config'. +-- Not available in the @VANILLA@ build. #ifdef VANILLA encodePretty' :: ToJSON a => Config -> a -> MisoString encodePretty' = error "encodePretty': not implemented" ----------------------------------------------------------------------------- +-- | Encode a value as indented (pretty-printed) JSON using 'defConfig' +-- (4-space indentation). Not available in the @VANILLA@ build. encodePretty :: ToJSON a => a -> MisoString encodePretty _ = error "encodePretty: not implemented" ----------------------------------------------------------------------------- @@ -888,14 +1182,18 @@ encodePretty = encodePretty' defConfig #endif ----------------------------------------------------------------------------- +-- | Pretty-printing configuration for 'encodePretty' and 'encodePretty''. newtype Config = Config { spaces :: Int + -- ^ Number of spaces per indentation level. } deriving (Show, Eq) ----------------------------------------------------------------------------- +-- | Default pretty-print config: 4-space indentation. defConfig :: Config defConfig = Config 4 ----------------------------------------------------------------------------- +-- | Call @JSON.stringify()@ on a JavaScript value, returning a JSON string. #ifdef GHCJS_OLD foreign import javascript unsafe "$r = JSON.stringify($1)" @@ -919,6 +1217,7 @@ jsonStringify _ = error "jsonStringify: not implemented" #endif ----------------------------------------------------------------------------- +-- | Call @JSON.parse()@ on a JSON string, returning a raw JavaScript value. #ifdef GHCJS_OLD foreign import javascript unsafe "$r = JSON.parse($1)" @@ -942,6 +1241,8 @@ jsonParse _ = error "jsonParse: not implemented" #endif ----------------------------------------------------------------------------- +-- | Decode a JSON 'MisoString', returning @'Left' errMsg@ on failure. +-- Prefer 'decode' when the error message is not needed. #ifdef VANILLA eitherDecode :: FromJSON a => MisoString -> Either MisoString a eitherDecode string = @@ -962,12 +1263,15 @@ Error err -> Left err) #endif ---------------------------------------------------------------------------- +-- | Convert a JSON 'Value' to a Haskell type, returning a 'Result'. +-- Useful when a 'Value' is already in hand; use 'decode' to parse from a string. fromJSON :: FromJSON a => Value -> Result a fromJSON value = case parseEither parseJSON value of Left s -> Error s Right x -> Success x ---------------------------------------------------------------------------- +-- | Convert a Miso JSON 'Value' to a raw JavaScript value via FFI. #ifdef GHCJS_BOTH toJSVal_Value :: Value -> IO JSVal toJSVal_Value = \case @@ -989,6 +1293,8 @@ pure o #endif ----------------------------------------------------------------------------- +-- | Convert a raw JavaScript value to a Miso JSON 'Value' via FFI. +-- Returns 'Nothing' if the JS value cannot be represented as a JSON 'Value'. #ifdef GHCJS_BOTH fromJSVal_Value :: JSVal -> IO (Maybe Value) fromJSVal_Value jsval_ = do diff --git a/src/Miso/JSON/Lexer.hs b/src/Miso/JSON/Lexer.hs --- a/src/Miso/JSON/Lexer.hs +++ b/src/Miso/JSON/Lexer.hs @@ -10,10 +10,39 @@ -- Stability : experimental -- Portability : non-portable -- --- A Lexer for the JSON specification. Meant to be used on the server w/ SSR. +-- = Overview -- --- This was ported from by [@ners](https://github.com/ners) --- +-- "Miso.JSON.Lexer" is the first stage of miso's pure Haskell JSON pipeline, +-- which is used for server-side rendering (SSR). It tokenises a +-- 'Miso.String.MisoString' into a stream of 'Token' values consumed by +-- "Miso.JSON.Parser". +-- +-- This module is __internal__. Application code should use "Miso.JSON" or +-- "Miso.JSON.Parser" ('Miso.JSON.Parser.decodePure') instead. +-- +-- This module was ported from by +-- . +-- +-- = Token types +-- +-- @ +-- data 'Token' +-- = 'TokenPunctuator' Char -- one of @[ ] { } , :@ +-- | 'TokenNumber' Double -- JSON number (integer or floating-point) +-- | 'TokenBool' Bool -- @true@ or @false@ +-- | 'TokenString' 'Miso.String.MisoString' -- quoted string with escape sequences +-- | 'TokenNull' -- @null@ +-- @ +-- +-- String tokens handle all +-- +-- including @\\uXXXX@ and UTF-16 surrogate pairs (@\\uD800\\uDC00@). +-- +-- = See also +-- +-- * "Miso.JSON.Parser" β€” consumes 'Token' streams produced here +-- * "Miso.JSON.Types" β€” 'Miso.JSON.Types.Value' produced by the parser +-- * "Miso.Util.Lexer" β€” the underlying 'Miso.Util.Lexer.Lexer' combinator library ---------------------------------------------------------------------------- module Miso.JSON.Lexer (Token (..), tokens) where ---------------------------------------------------------------------------- diff --git a/src/Miso/JSON/Parser.hs b/src/Miso/JSON/Parser.hs --- a/src/Miso/JSON/Parser.hs +++ b/src/Miso/JSON/Parser.hs @@ -1,6 +1,4 @@ ---------------------------------------------------------------------------- -{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : Miso.JSON.Parser -- Copyright : (C) 2016-2026 David M. Johnson @@ -9,10 +7,33 @@ -- Stability : experimental -- Portability : non-portable -- --- A Parser for the JSON specification. Meant to be used on the server w/ SSR. +-- = Overview -- --- This was ported from by [@ners](https://github.com/ners) --- +-- "Miso.JSON.Parser" is the second stage of miso's pure Haskell JSON +-- pipeline, used for server-side rendering (SSR). It takes the 'Token' +-- stream produced by "Miso.JSON.Lexer" and builds a 'Miso.JSON.Types.Value' +-- tree. +-- +-- The single public entry point is 'decodePure': +-- +-- @ +-- 'decodePure' :: 'Miso.String.MisoString' -> Either String 'Miso.JSON.Types.Value' +-- @ +-- +-- It returns @'Left' err@ on a lexical or parse error and @'Right' v@ on +-- success. Error messages include the position and nature of the failure. +-- +-- This module is __internal__. Use 'decodePure' via "Miso.JSON" in +-- application code. +-- +-- This module was ported from by +-- . +-- +-- = See also +-- +-- * "Miso.JSON.Lexer" β€” tokenizer that feeds this parser +-- * "Miso.JSON.Types" β€” 'Miso.JSON.Types.Value' and 'Miso.JSON.Types.Result' types +-- * "Miso.Util.Parser" β€” the underlying parser combinator library ---------------------------------------------------------------------------- module Miso.JSON.Parser (decodePure) where ---------------------------------------------------------------------------- diff --git a/src/Miso/JSON/Types.hs b/src/Miso/JSON/Types.hs --- a/src/Miso/JSON/Types.hs +++ b/src/Miso/JSON/Types.hs @@ -7,11 +7,44 @@ -- Stability : experimental -- Portability : non-portable -- --- Types for the @Miso.JSON@ module and JSON specification. +-- = Overview -- --- This was ported from by [@ners](https://github.com/ners) +-- "Miso.JSON.Types" defines the two core types used throughout miso's JSON +-- support: -- ----------------------------------------------------------------------------- +-- * 'Value' β€” an +-- -compliant JSON value. Used as the +-- intermediate representation in event decoders +-- ("Miso.Event.Decoder") and in 'Miso.DSL.ToJSVal' \/ 'Miso.DSL.FromJSVal' +-- marshalling. +-- +-- * 'Result' β€” a lightweight error monad (@'Success' a | 'Error' 'Miso.String.MisoString'@) +-- used by JSON parsers to report decode failures. It has full +-- 'Functor', 'Applicative', 'Monad', 'MonadFail', 'Alternative', +-- 'Foldable', and 'Traversable' instances. +-- +-- This module was ported from by +-- . +-- +-- = Value constructors +-- +-- @ +-- data 'Value' +-- = 'Number' Double -- JSON number +-- | 'Bool' Bool -- JSON boolean +-- | 'String' 'Miso.String.MisoString' -- JSON string +-- | 'Array' ['Value'] -- JSON array +-- | 'Object' ('Miso.JSON.Types.Object') -- JSON object (Map MisoString Value) +-- | 'Null' -- JSON null +-- @ +-- +-- = See also +-- +-- * "Miso.JSON" β€” top-level re-export hub; 'Miso.JSON.FromJSON', 'Miso.JSON.ToJSON', @('.:')@, 'Miso.JSON.withObject' +-- * "Miso.JSON.Parser" β€” pure server-side JSON decoder ('Miso.JSON.Parser.decodePure') +-- * "Miso.JSON.Lexer" β€” tokenizer used by the parser +-- * "Miso.Event.Decoder" β€” uses 'Value' and 'Result' via 'Miso.JSON.Parser' +----------------------------------------------------------------------------- {-# LANGUAGE CPP #-} ---------------------------------------------------------------------------- module Miso.JSON.Types diff --git a/src/Miso/Lens.hs b/src/Miso/Lens.hs --- a/src/Miso/Lens.hs +++ b/src/Miso/Lens.hs @@ -1,7 +1,6 @@ ----------------------------------------------------------------------------- {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} @@ -14,80 +13,68 @@ -- Stability : experimental -- Portability : non-portable -- --- This modules exposes a very simple t'Miso.Lens.Lens' formulation that is compatible with other lens libraries. +-- A simple t'Lens' formulation compatible with @lens@ and @microlens@. -- --- For state management of miso applications, this module should meet all of your needs. It also --- ensures a smaller payload size during compilation. +-- The t'Lens' type is defined as: -- -- @ --- data Lens record field --- = Lens --- { _get :: record -> field --- , _set :: record -> field -> record +-- data 'Lens' record field +-- = 'Lens' +-- { '_get' :: record -> field +-- , '_set' :: record -> field -> record -- } -- @ -- --- The goal is to provide users with an out-of-the box lens experience without the large --- dependency footprint and cognitive load. This module also aims to preserve semantics of --- existing lens combinators using a simple formulation (not the van Laarhoven). It must be imported --- separately (@import Miso.Lens@) and can be used with the @Effect@ Monad inside of a miso --- application (as described below). +-- Key features: -- --- This module is at fixity and interface parity with @lens@ and @microlens@ and can therefore --- be used interchangeably with them. Simply replace the @Miso.Lens@ import with @Control.Lens@. --- For convenience we re-export the t'Miso.Lens.Lens'' synonym to ease the transition into [lens](https://hackage.haskell.org/package/lens) or [microlens](https://hackage.haskell.org/package/microlens) +-- * Provides an out-of-the-box lens experience with a minimal dependency footprint. +-- * Uses a simple formulation (not van Laarhoven) for smaller compilation payload. +-- * Import separately: @import Miso.Lens@. +-- * Works with the @Effect@ monad inside miso applications. +-- * Fixity and interface parity with @lens@ and @microlens@; replace +-- @import Miso.Lens@ with @import Control.Lens@ to switch seamlessly. +-- * Re-exports t'Lens'' for easy migration to +-- [lens](https://hackage.haskell.org/package/lens) or +-- [microlens](https://hackage.haskell.org/package/microlens). -- --- For the curious reader, if you'd like more information on 'lens' and the van Laarhoven --- formulation, we recommend the [lens](https://hackage.haskell.org/package/lens) library. +-- For more on the van Laarhoven formulation, see the +-- [lens](https://hackage.haskell.org/package/lens) library. -- +-- === Example: Lenses for a nested record +-- -- @ --- -- Person type -- data Person = Person -- { _name :: String -- , _address :: Address -- , _age :: Int -- } deriving (Show, Eq, Generic) -- --- -- Address type -- newtype Address -- = Address -- { _zipCode :: Zip -- } deriving (Show, Eq) -- --- -- | Zip code type synonym -- type Zip = String -- --- -- | Name Lens -- name :: Lens Person String -- name = 'lens' _name $ \\record x -> record { _name = x } -- --- -- | Address Lens -- address :: Lens Person Address -- address = 'lens' _address $ \\record x -> record { _address = x } -- --- -- | Zip Code Lens -- zipCode :: Lens Address Zip -- zipCode = 'lens' _zipCode $ \\record x -> record { _zipCode = x } -- --- -- | Lens Composition example +-- -- Lenses compose via '.' -- personZip :: Lens Person Zip -- personZip = zipCode . address -- --- -- | Person example --- person :: Person --- person = Person "john" (Address "90210") 33 --- -- main :: IO () --- main = print $ john '&' address '.~' Address "10012" --- --- -- Person --- -- { _name = "john" --- -- , _age = 33 --- -- , _address = Address {_zipCode = "10012"} --- -- } +-- main = print $ person '&' address '.~' Address "10012" +-- -- Person { _name = "john", _age = 33, _address = Address {_zipCode = "10012"} } -- @ -- --- Example usage with miso's @Effect@ @Monad@ +-- === Example: Usage with the @Effect@ monad -- -- @ -- newtype Model = Model { _value :: Int } @@ -98,8 +85,8 @@ -- data Action = AddOne | SubtractOne -- -- updateModel :: Action -> Effect parent Model Action --- updateModel = \\case --- AddOne -> value '+=' 1 +-- updateModel = \\case +-- AddOne -> value '+=' 1 -- SubtractOne -> value '-=' 1 -- @ ---------------------------------------------------------------------------- @@ -213,13 +200,14 @@ -- | van Laarhoven formulation, used for conversion w/ 'Miso.miso' t'Lens'. type Lens' s a = forall (f :: Type -> Type). Functor f => (a -> f a) -> s -> f s ---------------------------------------------------------------------------- --- | Convert from 'Miso.miso' t'Lens' to van Laarhoven t'Lens'' +-- | Convert a t'Lens' to a van Laarhoven t'Lens'' toVL :: Lens record field -> Lens' record field toVL Lens {..} = \f record -> flip _set record <$> f (_get record) ---------------------------------------------------------------------------- --- | Convert from 'Miso.miso' t'Lens' to van Laarhoven t'Lens'' +-- | Convert a van Laarhoven t'Lens'' to a t'Lens' fromVL :: Lens' record field + -- ^ Van Laarhoven lens to convert -> Lens record field fromVL lens_ = Lens {..} where @@ -677,7 +665,7 @@ -- value = lens _value $ \\p x -> p { _value = x } -- -- update :: Action -> Effect parent Model Action --- update (IncrementBy x) = value += x +-- update (IncrementBy x) = value '+=' x -- @ infix 4 += (+=) :: (MonadState record m, Num field) => Lens record field -> field -> m () @@ -744,7 +732,7 @@ -- -- @ -- update AddOne = do --- _1 += 1 +-- _1 'Miso.Lens.+=' 1 -- @ _1 :: Lens (a,b) a _1 = lens fst $ \(_,b) x -> (x,b) @@ -753,7 +741,7 @@ -- -- @ -- update AddOne = do --- _2 += 1 +-- _2 'Miso.Lens.+=' 1 -- @ _2 :: Lens (a,b) b _2 = lens snd $ \(a,_) x -> (a,x) @@ -762,7 +750,7 @@ -- -- @ -- update AddOne = do --- _id += 1 +-- _id 'Miso.Lens.+=' 1 -- @ _id :: Lens a a _id = Control.Category.id @@ -771,54 +759,81 @@ -- -- @ -- update AddOne = do --- this += 1 +-- this 'Miso.Lens.+=' 1 -- @ this :: Lens a a this = _id --------------------------------------------------------------------------------- -- | Smart constructor 'lens' function. Used to easily construct a t'Lens' -- --- > name :: Lens Person String --- > name = lens _name $ \p n -> p { _name = n } +-- > name :: 'Lens' Person String +-- > name = 'lens' _name $ \p n -> p { _name = n } -- lens :: (record -> field) + -- ^ Getter: read the field from a record -> (record -> field -> record) + -- ^ Setter: write a new field value into a record -> Lens record field lens getter setter = Lens getter (flip setter) ---------------------------------------------------------------------------- +-- | A t'Prism' is a first-class reference into a sum type constructor. +-- +-- 'Prism' values can be used with 'preview' to try to extract a value, +-- and with 'review' to embed a value back into the sum type. data Prism s a = Prism { _up :: a -> s + -- ^ Embed a value @a@ back into the sum type @s@ (the @review@ direction). , _down :: s -> Maybe a + -- ^ Try to extract a value @a@ from @s@; 'Nothing' if the wrong constructor. } ---------------------------------------------------------------------------- +-- | Embed a value into a sum type using a t'Prism'. review :: Prism s a -> a -> s review = _up ---------------------------------------------------------------------------- +-- | Try to extract a value from a sum type using a t'Prism' inside 'MonadReader'. preview :: MonadReader r m => Prism r a -> m (Maybe a) preview = asks . preview ---------------------------------------------------------------------------- +-- | Try to extract a value from a sum type using a t'Prism' inside 'MonadState'. preuse :: MonadState s m => Prism s a -> m (Maybe a) preuse = gets . preview ---------------------------------------------------------------------------- +-- | t'Prism' for the 'Left' constructor of 'Either'. _Left :: Prism (Either a b) a _Left = prism Left $ either Just (const Nothing) ---------------------------------------------------------------------------- +-- | t'Prism' for the 'Right' constructor of 'Either'. _Right :: Prism (Either a b) b _Right = prism Right (either (const Nothing) Just) ---------------------------------------------------------------------------- +-- | t'Prism' for the 'Just' constructor of 'Maybe'. _Just :: Prism (Maybe a) a _Just = prism Just Prelude.id ---------------------------------------------------------------------------- +-- | t'Prism' that matches a 'Nothing' value. _Nothing :: Prism (Maybe a) a _Nothing = prism (const Nothing) Prelude.id ---------------------------------------------------------------------------- +-- | Infix alias for 'preview'. Try to extract a value using a t'Prism'. +-- +-- @ +-- Right 42 '^?' '_Right' == Just 42 +-- Left "x" '^?' '_Right' == Nothing +-- @ infixl 8 ^? -(^?) :: s -> Prism s a -> Maybe a +(^?) :: s -> Prism s a -> Maybe a (^?) = flip preview ---------------------------------------------------------------------------- -prism :: (a -> s) -> (s -> Maybe a) -> Prism s a +-- | Smart constructor for t'Prism'. +prism + :: (a -> s) + -- ^ Embed direction: construct @s@ from @a@. + -> (s -> Maybe a) + -- ^ Match direction: try to extract @a@ from @s@. + -> Prism s a prism = Prism ---------------------------------------------------------------------------- -- | Class for getting and setting values across various container types. diff --git a/src/Miso/Lens/Generic.hs b/src/Miso/Lens/Generic.hs --- a/src/Miso/Lens/Generic.hs +++ b/src/Miso/Lens/Generic.hs @@ -20,6 +20,58 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.Lens.Generic" derives 'Miso.Lens.Lens' values for record fields +-- at compile time using @GHC.Generics@ and @GHC.Records@, without +-- Template Haskell. Fields are addressed by name via 'GHC.OverloadedLabels' +-- or the explicit 'field' combinator. +-- +-- Enable the required extensions: +-- +-- @ +-- {-\# LANGUAGE OverloadedLabels, DeriveGeneric \#-} +-- import GHC.Generics (Generic) +-- import "Miso.Lens.Generic" ('HasLens', 'field') +-- import "Miso.Lens" ('Lens', 'view', 'set', ('.='), ('++=')) +-- @ +-- +-- = Quick start +-- +-- @ +-- data Counter = Counter { _count :: Int, _label :: 'Miso.String.MisoString' } +-- deriving ('GHC.Generics.Generic') +-- +-- -- Label syntax (requires OverloadedLabels): +-- countLens :: 'Miso.Lens.Lens' Counter Int +-- countLens = #_count +-- +-- -- Explicit syntax (works without OverloadedLabels): +-- labelLens :: 'Miso.Lens.Lens' Counter 'Miso.String.MisoString' +-- labelLens = 'field' \@\"_label\" +-- +-- update :: Action -> 'Miso.Effect.Effect' p props Counter Action +-- update Increment = #_count '+=' 1 +-- update (SetLabel l) = #_label '.=' l +-- @ +-- +-- = How it works +-- +-- The 'HasLens' instance is resolved via 'GHC.Records.HasField' for the +-- getter and a generic traversal ('GSet') for the setter. A type-level +-- 'TotalityCheck' produces a descriptive compile error if the field name +-- is absent from (or inconsistent across) the constructors. +-- +-- = Comparison with Template Haskell +-- +-- [Overloaded labels] "Miso.Lens.Generic" β€” no TH; derives via @Generic@ +-- [Template Haskell] "Miso.Lens.TH" β€” @makeLenses@ \/ @makeClassy@ +-- +-- = See also +-- +-- * "Miso.Lens" β€” 'Miso.Lens.Lens', 'Miso.Lens.lens', operators +-- * "Miso.Lens.TH" β€” Template Haskell alternative ----------------------------------------------------------------------------- module Miso.Lens.Generic (HasLens(..), field) where diff --git a/src/Miso/Lens/TH.hs b/src/Miso/Lens/TH.hs --- a/src/Miso/Lens/TH.hs +++ b/src/Miso/Lens/TH.hs @@ -1,5 +1,6 @@ ----------------------------------------------------------------------------- -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskellQuotes #-} ----------------------------------------------------------------------------- -- | -- Module : Miso.Lens.TH @@ -8,6 +9,72 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.Lens.TH" generates 'Lens' definitions via Template Haskell, similar +-- to @lens@'s @makeLenses@ and @makeClassy@. Fields must be prefixed with +-- @_@ β€” the generated lens name is the field name with the underscore dropped. +-- +-- Enable the extension and splice at the declaration level: +-- +-- @ +-- {-\# LANGUAGE TemplateHaskell \#-} +-- import "Miso.Lens.TH" ('makeLenses', 'makeClassy') +-- @ +-- +-- = makeLenses +-- +-- Generates a @'Lens' Record Field@ for each @_@-prefixed record field: +-- +-- @ +-- data Model = Model +-- { _count :: Int +-- , _text :: 'Miso.String.MisoString' +-- } deriving (Eq) +-- +-- 'makeLenses' \'\'Model +-- -- Generates: +-- -- count :: 'Lens' Model Int +-- -- text :: 'Lens' Model 'Miso.String.MisoString' +-- +-- update :: Action -> 'Miso.Effect.Effect' p props Model Action +-- update Increment = count '+=' 1 +-- update (SetText t) = text '.=' t +-- @ +-- +-- = makeClassy +-- +-- Generates a @HasFoo@ typeclass with a self-lens @foo :: Lens s Foo@ and +-- one lens per @_@-prefixed field. This enables lens composition across +-- record types that embed @Foo@: +-- +-- @ +-- data Foo = Foo { _fooX :: Int, _fooY :: Int } +-- 'makeClassy' \'\'Foo +-- -- Generates: +-- -- class HasFoo s where +-- -- foo :: 'Lens' s Foo +-- -- fooX :: 'Lens' s Int -- fooX = foo . lens _fooX ... +-- -- fooY :: 'Lens' s Int +-- -- instance HasFoo Foo where foo = 'this' +-- +-- data Bar = Bar { _barFoo :: Foo, _barZ :: Double } +-- 'makeLenses' \'\'Bar +-- instance HasFoo Bar where foo = barFoo +-- -- Now barX :: 'Lens' Bar Int (via foo composition) +-- @ +-- +-- = Comparison with Generic approach +-- +-- [Template Haskell] "Miso.Lens.TH" β€” @_@ prefix required; explicit splice +-- [Overloaded labels] "Miso.Lens.Generic" β€” no TH; derives via @Generic@ +-- +-- = See also +-- +-- * "Miso.Lens" β€” 'Miso.Lens.Lens', 'Miso.Lens.lens', 'Miso.Lens.view', +-- 'Miso.Lens.set', and the update operators ('.=', '+=', '%=', …) +-- * "Miso.Lens.Generic" β€” label-based alternative requiring no TH splice ----------------------------------------------------------------------------- module Miso.Lens.TH ( -- ** TH @@ -29,7 +96,10 @@ ----------------------------------------------------------------------------- -- | Automatically generates Haskell lenses via template-haskell. -- -makeLenses :: Name -> Q [Dec] +makeLenses + :: Name + -- ^ The name of the record type to derive lenses for (e.g. @\'\'MyModel@) + -> Q [Dec] makeLenses name = do reify name >>= \case TyConI (NewtypeD _ _ _ _ con _) -> do @@ -45,14 +115,13 @@ _ -> pure [] where processFieldNames fieldNames = concat - [ mkFields fName (ConT name) fieldType + [ mkFields fieldName (ConT name) fieldType | (fieldName, _, fieldType) <- fieldNames - , let fName = nameBase fieldName - , listToMaybe fName == Just '_' + , listToMaybe (nameBase fieldName) == Just '_' ] mkFields fieldName conType fieldType = let -- dmj: drops '_' prefix - lensName = mkName (drop 1 fieldName) + lensName = mkName (drop 1 (nameBase fieldName)) in [ FunD lensName [ Clause [] (NormalB (mkLens fieldName)) [] @@ -62,17 +131,20 @@ concatMapM f xs = concat <$> mapM f xs mkLensType conType = - AppT (AppT (ConT (mkName "Lens")) conType) - mkLens n = - AppE (AppE (VarE (mkName "lens")) (VarE (mkName n))) - $ LamE [ VarP recName, VarP fieldName ] - $ RecUpdE (VarE recName) [ (mkName n, VarE fieldName) ] + AppT (AppT (ConT ''Lens) conType) + mkLens fieldName = + AppE (AppE (VarE 'lens) (VarE fieldName)) + $ LamE [ VarP recName, VarP fieldVar ] + $ RecUpdE (VarE recName) [ (fieldName, VarE fieldVar) ] where recName = mkName "record" - fieldName = mkName "field" + fieldVar = mkName "field" ----------------------------------------------------------------------------- -- | Automatically generates classy lenses via template-haskell. -makeClassy :: Name -> Q [Dec] +makeClassy + :: Name + -- ^ The name of the record type to derive a @Has@ typeclass and lenses for (e.g. @\'\'MyModel@) + -> Q [Dec] makeClassy name = do reify name >>= \case TyConI (NewtypeD _ _ _ _ con _) -> do @@ -95,29 +167,28 @@ | otherwise = [] processFieldNames fieldNames = [ InstanceD Nothing [] instanceName - [ ValD (VarP (mkName baseNameLower)) (NormalB (VarE (mkName "this"))) [] + [ ValD (VarP (mkName baseNameLower)) (NormalB (VarE 'this)) [] -- instance HasFoo Foo where foo = this ] , ClassD [] (mkName $ "Has" <> nameBase name) [ PlainTV (mkName baseNameLower) BndrReq ] [] $ reverse $ concat - [ mkFields fName (VarT (mkName baseNameLower)) fieldType + [ mkFields fieldName (VarT (mkName baseNameLower)) fieldType | (fieldName, _, fieldType) <- fieldNames - , let fName = nameBase fieldName - , listToMaybe fName == Just '_' + , listToMaybe (nameBase fieldName) == Just '_' ] ++ [ SigD - (mkName baseNameLower) + (mkName baseNameLower) (AppT (AppT - (ConT (mkName "Lens")) + (ConT ''Lens) (VarT (mkName baseNameLower))) (ConT name)) ] ] mkFields fieldName varType fieldType = let -- dmj: drops '_' prefix - lensName = mkName (drop 1 fieldName) + lensName = mkName (drop 1 (nameBase fieldName)) in [ FunD lensName [ Clause [] (NormalB (wrapMkLens fieldName)) [] @@ -129,14 +200,14 @@ concatMapM f xs = concat <$> mapM f xs mkLensType varType x = - AppT (AppT (ConT (mkName "Lens")) varType) x - wrapMkLens n = - AppE (AppE (VarE (mkName "compose")) (mkLens n)) (VarE (mkName baseNameLower)) - mkLens n - = AppE (AppE (VarE (mkName "lens")) (VarE (mkName n))) - $ LamE [ VarP recName, VarP fieldName ] - $ RecUpdE (VarE recName) [ (mkName n, VarE fieldName) ] + AppT (AppT (ConT ''Lens) varType) x + wrapMkLens fieldName = + AppE (AppE (VarE 'compose) (mkLens fieldName)) (VarE (mkName baseNameLower)) + mkLens fieldName + = AppE (AppE (VarE 'lens) (VarE fieldName)) + $ LamE [ VarP recName, VarP fieldVar ] + $ RecUpdE (VarE recName) [ (fieldName, VarE fieldVar) ] where recName = mkName "record" - fieldName = mkName "field" + fieldVar = mkName "field" ------------------------------------------------------------------------------- diff --git a/src/Miso/Mathml.hs b/src/Miso/Mathml.hs --- a/src/Miso/Mathml.hs +++ b/src/Miso/Mathml.hs @@ -7,20 +7,25 @@ -- Stability : experimental -- Portability : non-portable -- --- Example usage: +-- [MathML](https://developer.mozilla.org/en-US/docs/Web/MathML) element +-- combinators for rendering mathematical expressions in Miso views. +-- Re-exports everything from "Miso.Mathml.Element". -- +-- __Example__ β€” render /xΒ²/: +-- -- @ -- xSquared :: View model action --- xSquared = --- math_ [] --- [ msup_ [] --- [ mi_ [] [text "x"] --- , mn_ [] [text "2"] --- ] +-- xSquared = +-- math_ [] +-- [ msup_ [] +-- [ mi_ [] [ text \"x\" ] +-- , mn_ [] [ text \"2\" ] -- ] +-- ] -- @ -- --- More complex example in [mathml](https://github.com/haskell-miso/miso-mathml). +-- For a more complete example see +-- [miso-mathml](https://github.com/haskell-miso/miso-mathml). -- ---------------------------------------------------------------------------- module Miso.Mathml diff --git a/src/Miso/Mathml/Element.hs b/src/Miso/Mathml/Element.hs --- a/src/Miso/Mathml/Element.hs +++ b/src/Miso/Mathml/Element.hs @@ -8,7 +8,61 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable ----------------------------------------------------------------------------- +-- +-- = Overview +-- +-- "Miso.Mathml.Element" provides smart constructors for every element in the +-- +-- vocabulary. Each constructor produces a 'Miso.Types.View' node in the +-- @MATHML@ namespace: +-- +-- @ +-- tagName_ :: ['Miso.Types.Attribute' action] -> ['Miso.Types.View' model action] -> 'Miso.Types.View' model action +-- @ +-- +-- All names are suffixed with @_@. The module is re-exported by "Miso.Mathml". +-- +-- = Quick start +-- +-- Embed a fraction inside a paragraph using 'Miso.Html.Element.p_' and 'math_': +-- +-- @ +-- import "Miso" +-- import "Miso.Mathml.Element" +-- import "Miso.Mathml.Property" ('display_') +-- +-- formula :: 'Miso.Types.View' model action +-- formula = +-- 'Miso.Html.Element.p_' [] +-- [ 'math_' [ 'display_' \"block\" ] +-- [ 'mfrac_' [] +-- [ 'mn_' [] [ 'Miso.text' \"1\" ] +-- , 'msqrt_' [] [ 'mn_' [] [ 'Miso.text' \"2\" ] ] +-- ] +-- ] +-- ] +-- @ +-- +-- = Element groups +-- +-- * __Top-level__: 'math_' +-- * __Token elements__ (leaves): 'mi_' (identifier), 'mn_' (number), +-- 'mo_' (operator), 'ms_' (string literal), 'mtext_', 'mspace_' +-- * __General layout__: 'mrow_', 'mfrac_', 'msqrt_', 'mroot_', +-- 'mpadded_', 'mphantom_', 'merror_', 'mstyle_', 'mfenced_' +-- * __Script \& limit__: 'msub_', 'msup_', 'msubsup_', +-- 'mover_', 'munder_', 'munderover_', 'mmultiscripts_', 'mprescripts_' +-- * __Tabular__: 'mtable_', 'mtr_', 'mtd_' +-- * __Semantics__: 'semantics_', 'annotation_', 'annotationXml_' +-- * __Custom__: 'nodeMathml' for any MathML tag not listed above +-- +-- = See also +-- +-- * "Miso.Mathml.Property" β€” MathML attribute combinators +-- * "Miso.Mathml" β€” re-export hub for the full MathML DSL +-- * "Miso.Html.Element" β€” HTML element constructors +-- * "Miso.Svg.Element" β€” SVG element constructors +----------------------------------------------------------------------------- module Miso.Mathml.Element ( -- ** Combinator nodeMathml diff --git a/src/Miso/Mathml/Property.hs b/src/Miso/Mathml/Property.hs --- a/src/Miso/Mathml/Property.hs +++ b/src/Miso/Mathml/Property.hs @@ -9,12 +9,52 @@ -- Stability : experimental -- Portability : non-portable -- --- MathML attributes. +-- = Overview -- --- We recommend referring to [MDN Attributes reference](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Attribute) --- for details on how each attribute can be used. +-- "Miso.Mathml.Property" provides 'Miso.Types.Attribute' smart constructors +-- for +-- . +-- They are used alongside the element constructors from "Miso.Mathml.Element". +-- The module is re-exported by "Miso.Mathml". -- ----------------------------------------------------------------------------- +-- = Quick start +-- +-- @ +-- import "Miso.Mathml.Element" +-- import "Miso.Mathml.Property" +-- +-- styledFrac :: 'Miso.Types.View' model action +-- styledFrac = +-- 'Miso.Mathml.Element.math_' [ 'display_' \"block\" ] +-- [ 'Miso.Mathml.Element.mfrac_' [ 'linethickness_' \"2px\" ] +-- [ 'Miso.Mathml.Element.mn_' [ 'mathvariant_' \"bold\" ] [ 'Miso.text' \"1\" ] +-- , 'Miso.Mathml.Element.mn_' [] [ 'Miso.text' \"3\" ] +-- ] +-- ] +-- @ +-- +-- = Attribute groups +-- +-- * __Global MathML attributes__: 'dir_', 'displaystyle_', 'scriptlevel_', +-- 'id_', 'href_', 'mathbackground_', 'mathcolor_', 'mathsize_', 'mathvariant_' +-- * __Layout__: 'display_', 'height_', 'width_', 'depth_', 'voffset_', +-- 'lspace_', 'rspace_', 'linethickness_', 'minsize_', 'maxsize_' +-- * __Table__: 'align_', 'rowalign_', 'rowlines_', 'rowspacing_', 'rowspan_', +-- 'columnalign_', 'columnlines_', 'columnspacing_', 'columnspan_' +-- * __Operator flags__ (boolean): 'accent_', 'accentunder_', 'fence_', +-- 'separator_', 'stretchy_', 'symmetric_', 'movablelimits_' +-- * __Frame__: 'frame_', 'framespacing_' +-- * __Grouping__: 'open_', 'close_', 'notation_' +-- +-- For full semantics of each attribute consult the +-- . +-- +-- = See also +-- +-- * "Miso.Mathml.Element" β€” MathML element constructors +-- * "Miso.Mathml" β€” re-export hub for the full MathML DSL +-- * "Miso.Property" β€” low-level 'Miso.Property.textProp', 'Miso.Property.boolProp', 'Miso.Property.intProp' +----------------------------------------------------------------------------- module Miso.Mathml.Property ( -- * Global attributes dir_ diff --git a/src/Miso/Media.hs b/src/Miso/Media.hs --- a/src/Miso/Media.hs +++ b/src/Miso/Media.hs @@ -9,7 +9,78 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable ----------------------------------------------------------------------------- +-- +-- = Overview +-- +-- "Miso.Media" is a Haskell wrapper around the browser's +-- +-- API. It covers both @\@ and @\@ elements through the +-- unified 'Media' type, which wraps the underlying 'Miso.DSL.JSVal'. +-- +-- All property reads and method calls run in 'IO'. Properties that can be +-- set declaratively are cross-linked to their corresponding +-- 'Miso.Html.Property' combinators. +-- +-- = Quick start +-- +-- Obtain a 'Media' handle from the DOM, then read or control it in an +-- 'Miso.Effect.Effect': +-- +-- @ +-- import "Miso" +-- import "Miso.Media" +-- +-- update :: Action -> 'Miso.Effect.Effect' p props Model Action +-- update PlayVideo = 'Miso.Effect.io_' $ do +-- m <- 'Media' \<$\> 'Miso.FFI.getElementById' \"myVideo\" +-- 'play' m +-- update PauseVideo = 'Miso.Effect.io_' $ do +-- m <- 'Media' \<$\> 'Miso.FFI.getElementById' \"myVideo\" +-- 'pause' m +-- update ReadState = 'Miso.Effect.io' $ do +-- m <- 'Media' \<$\> 'Miso.FFI.getElementById' \"myVideo\" +-- t <- 'currentTime' m +-- rs <- 'readyState' m +-- pure (GotState t rs) +-- @ +-- +-- Wire events using 'mediaEvents' and the handlers from "Miso.Html.Event": +-- +-- @ +-- myComponent = ('Miso.component' model update view) +-- { 'Miso.Types.events' = 'Miso.Event.Types.defaultEvents' \<\> 'mediaEvents' } +-- @ +-- +-- = API groups +-- +-- * __Methods__: 'play', 'pause', 'load', 'canPlayType', 'srcObject' +-- * __Playback state__ (read-only): 'currentSrc', 'currentTime', 'duration', +-- 'ended', 'paused', 'seeking', 'networkState', 'readyState' +-- * __Playback control__ (read; set via 'Miso.Html.Property'): 'autoplay', +-- 'controls', 'loop', 'muted', 'defaultMuted', 'volume', 'playbackRate', +-- 'defaultPlaybackRate', 'preload', 'mediaGroup' +-- * __Video-specific__ (read-only): 'videoWidth', 'videoHeight', 'poster' +-- * __Event map__: 'mediaEvents' β€” merge into 'Miso.Types.events' to enable +-- media event delegation +-- +-- = State enumerations +-- +-- 'NetworkState' and 'ReadyState' mirror the integer constants defined by +-- +-- and are derived from 'Enum' so @toEnum@ / @fromEnum@ round-trip correctly: +-- +-- @ +-- -- NetworkState: NETWORK_EMPTY(0) NETWORK_IDLE(1) NETWORK_LOADING(2) NETWORK_NO_SOURCE(3) +-- -- ReadyState: HAVE_NOTHING(0) HAVE_METADATA(1) HAVE_CURRENT_DATA(2) HAVE_FUTURE_DATA(3) HAVE_ENOUGH_DATA(4) +-- @ +-- +-- = See also +-- +-- * "Miso.Html.Element" β€” 'Miso.Html.Element.audio_', 'Miso.Html.Element.video_' +-- * "Miso.Html.Property" β€” 'Miso.Html.Property.autoplay_', 'Miso.Html.Property.controls_', … +-- * "Miso.Html.Event" β€” 'Miso.Html.Event.onPlay', 'Miso.Html.Event.onPause', … +-- * "Miso.Event.Types" β€” 'Miso.Event.Types.mediaEvents' (also re-exported here) +----------------------------------------------------------------------------- module Miso.Media ( -- *** Types Media (..) @@ -256,6 +327,11 @@ type Stream = JSVal ----------------------------------------------------------------------------- -- | Sets the `srcObject` on audio or video elements. -srcObject :: Stream -> Media -> IO () +srcObject + :: Stream + -- ^ A 'Stream' obtained from @navigator.mediaDevices.getUserMedia@ or similar + -> Media + -- ^ The audio\/video element whose @srcObject@ will be set + -> IO () srcObject stream (Media media) = setField media "srcObject" stream ----------------------------------------------------------------------------- diff --git a/src/Miso/Navigator.hs b/src/Miso/Navigator.hs --- a/src/Miso/Navigator.hs +++ b/src/Miso/Navigator.hs @@ -12,7 +12,64 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable ----------------------------------------------------------------------------- +-- +-- = Overview +-- +-- "Miso.Navigator" wraps the browser's +-- +-- API as 'Miso.Effect.Effect' combinators that integrate directly into the +-- Model-View-Update loop. Each function returns an 'Miso.Effect.Effect' and +-- feeds its result back as an action via 'Miso.Effect.withSink' or +-- 'Miso.Effect.io'. +-- +-- = Quick start +-- +-- @ +-- import "Miso" +-- import "Miso.Navigator" +-- +-- data Action +-- = RequestLocation +-- | GotLocation 'Geolocation' +-- | LocationError 'GeolocationError' +-- | RequestCamera +-- | GotStream 'Stream' +-- | MediaError 'Miso.DSL.JSVal' +-- +-- update :: Action -> 'Miso.Effect.Effect' p props Model Action +-- update RequestLocation = +-- 'geolocation' GotLocation LocationError +-- update RequestCamera = +-- 'getUserMedia' ('userMedia' { audio = False }) GotStream MediaError +-- update _ = pure () +-- @ +-- +-- = API groups +-- +-- * __Camera \/ microphone__ ('Navigator.mediaDevices.getUserMedia'): +-- 'getUserMedia', 'userMedia', 'UserMedia', 'Stream' +-- * __Clipboard__ ('Navigator.clipboard.writeText'): +-- 'copyClipboard' +-- * __Online status__ ('Navigator.onLine'): +-- 'isOnLine' +-- * __Geolocation__ ('Navigator.geolocation.getCurrentPosition'): +-- 'geolocation', 'Geolocation', 'GeolocationError', 'GeolocationErrorCode' +-- +-- = Error handling +-- +-- Geolocation errors are decoded from the browser's +-- +-- object into 'GeolocationError', which carries a 'GeolocationErrorCode' +-- (@'PERMISSION_DENIED'@, @'POSITION_UNAVAILABLE'@, @'TIMEOUT'@) and a +-- human-readable message string. +-- +-- = See also +-- +-- * "Miso.FFI.Internal" β€” 'Miso.FFI.Internal.getUserMedia', 'Miso.FFI.Internal.copyClipboard', +-- 'Miso.FFI.Internal.geolocation', 'Miso.FFI.Internal.isOnLine' β€” the raw IO primitives +-- * "Miso.Subscription.OnLine" β€” subscription-based online\/offline monitoring +-- * "Miso.Effect" β€” 'Miso.Effect.withSink', 'Miso.Effect.io' +----------------------------------------------------------------------------- module Miso.Navigator ( -- ** User media getUserMedia @@ -93,7 +150,10 @@ -- data UserMedia = UserMedia - { audio, video :: Bool + { audio :: Bool + -- ^ Request access to the user's microphone + , video :: Bool + -- ^ Request access to the user's camera } deriving (Show, Eq) ----------------------------------------------------------------------------- -- | Default t'UserMedia' @@ -106,7 +166,9 @@ -- geolocation :: (Geolocation -> action) + -- ^ Success callback; receives the device's current position -> (GeolocationError -> action) + -- ^ Error callback; receives a 'GeolocationError' with code and message -> Effect parent props model action geolocation successful errorful = do withSink $ \sink -> @@ -142,7 +204,12 @@ -- | Geolocation holds latitude, longitude and accuracy, among others. data Geolocation = Geolocation - { latitude, longitude, accuracy :: Double + { latitude :: Double + -- ^ Latitude in decimal degrees + , longitude :: Double + -- ^ Longitude in decimal degrees + , accuracy :: Double + -- ^ Accuracy of the position in metres (95% confidence radius) } deriving (Show, Eq) ----------------------------------------------------------------------------- instance FromJSVal Geolocation where diff --git a/src/Miso/Prelude.hs b/src/Miso/Prelude.hs --- a/src/Miso/Prelude.hs +++ b/src/Miso/Prelude.hs @@ -7,34 +7,46 @@ -- Stability : experimental -- Portability : non-portable -- --- A custom Prelude for [miso](https://github.com/dmjio/miso). +-- = Overview -- --- Can consume via @NoImplicitPrelude@ or using Cabal mixins. +-- "Miso.Prelude" is a batteries-included custom prelude for miso +-- applications. It re-exports: -- +-- * The entirety of "Miso" β€” all view, update, and subscription +-- combinators are available without a qualified import. +-- * The standard 'Prelude' β€” familiar Haskell functions remain in scope, +-- with @'(!!)'@ hidden to avoid the clash with miso's index operator. +-- * @'Control.Category.(.)'@ β€” replaces 'Prelude.(.)' so it works for any +-- 'Control.Category.Category', not just @(->)@. +-- +-- = Usage +-- +-- __Option 1 β€” explicit import__ (simplest): +-- -- @ --- import Miso.Prelude +-- import "Miso.Prelude" -- @ -- --- Almost identical to the existing @Prelude@, except we re-export the --- @Miso@ module, along with @Control.Category@. +-- __Option 2 β€” Cabal mixin__ (replaces @Prelude@ project-wide, zero +-- per-file boilerplate): -- -- @ -- executable app --- import: --- options --- main-is: --- Main.hs --- build-depends: --- base, miso +-- main-is: Main.hs +-- build-depends: base, miso -- mixins: -- miso, -- miso (Miso.Prelude as Prelude), -- base hiding (Prelude) --- default-language: --- Haskell2010 +-- default-language: Haskell2010 -- @ -- ----------------------------------------------------------------------------- +-- = See also +-- +-- * "Miso" β€” the main miso re-export hub +-- * "Miso.Effect" β€” 'Miso.Effect.Effect', 'Miso.Effect.Sub', 'Miso.Effect.io_' +-- * "Miso.Html" β€” HTML element and event combinators +----------------------------------------------------------------------------- module Miso.Prelude ( module Miso , module Prelude diff --git a/src/Miso/Property.hs b/src/Miso/Property.hs --- a/src/Miso/Property.hs +++ b/src/Miso/Property.hs @@ -9,11 +9,64 @@ -- Stability : experimental -- Portability : non-portable -- --- Construct custom properties on DOM elements. +-- = Overview -- --- > div_ [ prop "id" "foo" ] [ ] +-- "Miso.Property" provides the low-level primitives for constructing +-- 'Miso.Types.Attribute' values that set DOM properties on virtual nodes. +-- All higher-level property combinators in "Miso.Html.Property", +-- "Miso.Svg.Property", and "Miso.Mathml.Property" are built on top of +-- these. -- ----------------------------------------------------------------------------- +-- The central combinator is 'prop': +-- +-- @ +-- 'prop' :: 'Miso.JSON.ToJSON' a => 'Miso.String.MisoString' -> a -> 'Miso.Types.Attribute' action +-- @ +-- +-- It wraps any JSON-serialisable value as a 'Miso.Types.Property' node, +-- which the virtual DOM diffs and writes to the DOM node only when the +-- value changes. +-- +-- = Typed convenience wrappers +-- +-- ['textProp'] 'Miso.String.MisoString' β€” @'textProp' \"placeholder\" \"…\"@ +-- ['stringProp'] 'String' β€” @'stringProp' \"lang\" \"en\"@ +-- ['boolProp'] 'Bool' β€” @'boolProp' \"checked\" True@ +-- ['intProp'] 'Int' β€” @'intProp' \"tabIndex\" 3@ +-- ['integerProp'] 'Integer' β€” @'integerProp' \"size\" 10@ +-- ['doubleProp'] 'Double' β€” @'doubleProp' \"volume\" 0.8@ +-- ['objectProp'] 'Miso.JSON.Types.Object' β€” @'objectProp' \"dataset\" obj@ +-- +-- = Class list +-- +-- 'classList' stores CSS class names as a deduplicated list rather than a +-- single concatenated string. The virtual DOM diffing engine handles the +-- list directly so individual class additions and removals are efficient: +-- +-- @ +-- 'classList' [\"btn\", \"btn-primary\"] +-- @ +-- +-- = Virtual DOM keys +-- +-- 'key_' (alias 'keyProp') attaches a reconciliation key to a node, telling +-- the differ which old and new nodes correspond to each other in a dynamic +-- list: +-- +-- @ +-- 'Miso.Html.Element.ul_' [] +-- [ 'Miso.Html.Element.li_' [ 'key_' item.id ] [ 'Miso.text' item.label ] +-- | item <- items +-- ] +-- @ +-- +-- = See also +-- +-- * "Miso.Html.Property" β€” named HTML property combinators built on this module +-- * "Miso.Svg.Property" β€” SVG property combinators +-- * "Miso.Mathml.Property" β€” MathML property combinators +-- * "Miso.Types" β€” 'Miso.Types.Attribute', 'Miso.Types.Key', 'Miso.Types.ToKey' +----------------------------------------------------------------------------- module Miso.Property ( -- *** Smart constructors prop @@ -35,35 +88,76 @@ ----------------------------------------------------------------------------- -- | @prop k v@ is an attribute that will set the attribute @k@ of the DOM -- node associated with the vnode to @v@. -prop :: ToJSON a => MisoString -> a -> Attribute action +prop + :: ToJSON a + => MisoString + -- ^ DOM property name (e.g. @\"value\"@, @\"className\"@) + -> a + -- ^ Property value; serialised to JSON before diffing + -> Attribute action prop k v = Property k (toJSON v) ----------------------------------------------------------------------------- -- | Set field to 'Bool' value -boolProp :: MisoString -> Bool -> Attribute action +boolProp + :: MisoString + -- ^ DOM property name + -> Bool + -- ^ Property value + -> Attribute action boolProp = prop ----------------------------------------------------------------------------- -- | Set field to 'String' value -stringProp :: MisoString -> String -> Attribute action +stringProp + :: MisoString + -- ^ DOM property name + -> String + -- ^ Property value + -> Attribute action stringProp = prop ----------------------------------------------------------------------------- -- | Set field to 'MisoString' value -textProp :: MisoString -> MisoString -> Attribute action +textProp + :: MisoString + -- ^ DOM property name + -> MisoString + -- ^ Property value + -> Attribute action textProp = prop ----------------------------------------------------------------------------- -- | Set field to t'Object' value -objectProp :: MisoString -> Object -> Attribute action +objectProp + :: MisoString + -- ^ DOM property name + -> Object + -- ^ JSON object value + -> Attribute action objectProp = prop ----------------------------------------------------------------------------- -- | Set field to 'Int' value -intProp :: MisoString -> Int -> Attribute action +intProp + :: MisoString + -- ^ DOM property name + -> Int + -- ^ Property value + -> Attribute action intProp = prop ----------------------------------------------------------------------------- -- | Set field to 'Integer' value -integerProp :: MisoString -> Integer -> Attribute action +integerProp + :: MisoString + -- ^ DOM property name + -> Integer + -- ^ Property value + -> Attribute action integerProp = prop ----------------------------------------------------------------------------- -- | Set field to 'Double' value -doubleProp :: MisoString -> Double -> Attribute action +doubleProp + :: MisoString + -- ^ DOM property name + -> Double + -- ^ Property value + -> Attribute action doubleProp = prop ----------------------------------------------------------------------------- -- | Set 'Miso.Types.Key' on 'VNode'. diff --git a/src/Miso/PubSub.hs b/src/Miso/PubSub.hs --- a/src/Miso/PubSub.hs +++ b/src/Miso/PubSub.hs @@ -7,15 +7,58 @@ -- Stability : experimental -- Portability : non-portable -- --- Publish / Subscribe primitives for communication between components. +-- = Overview +-- +-- "Miso.PubSub" provides a lightweight publish\/subscribe channel for +-- passing messages between independent 'Miso.Types.Component' trees that +-- do not share a parent-child relationship. +-- +-- A 'Topic' is an untyped broadcast channel. Any component can +-- 'publish' a message to it; every component that has called 'subscribe' +-- on that topic will receive the message as an action. +-- +-- = Quick start +-- +-- @ +-- import "Miso" +-- import "Miso.PubSub" +-- +-- -- 1. Create a shared topic (typically at the top level or in a shared module) +-- chatTopic :: IO 'Topic' +-- chatTopic = 'topic' +-- +-- -- 2. Subscribe in a component's subs list +-- myChatSub :: 'Topic' -> 'Miso.Effect.Sub' Action +-- myChatSub t = 'subscribe' t GotMessage +-- +-- -- 3. Publish from any component's update function +-- update :: Action -> 'Miso.Effect.Effect' p props Model Action +-- update (SendMessage msg) = +-- 'Miso.Effect.io_' ('publish' chatTopic msg) +-- update (GotMessage msg) = do +-- ... +-- @ +-- +-- = API +-- +-- * 'topic' β€” create a new broadcast channel +-- * 'subscribe' β€” register a component subscription that receives published values +-- * 'unsubscribe' β€” deregister a subscription +-- * 'publish' β€” broadcast a value to all current subscribers +-- +-- = See also +-- +-- * "Miso.Binding" β€” lens-based parent↔child model synchronisation +-- * "Miso.Effect" β€” 'Miso.Effect.Sub', 'Miso.Effect.withSink' +-- * "Miso.Runtime" β€” where 'Topic', 'subscribe', 'publish' are defined ---------------------------------------------------------------------------- module Miso.PubSub - ( -- ** Publishers / Subscribers - subscribe + ( -- * Pub\/Sub + Topic + , topic + , subscribe , unsubscribe , publish - , Topic - , topic ) where ---------------------------------------------------------------------------- import Miso.Runtime diff --git a/src/Miso/Random.hs b/src/Miso/Random.hs --- a/src/Miso/Random.hs +++ b/src/Miso/Random.hs @@ -1,6 +1,5 @@ ----------------------------------------------------------------------------- {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module : Miso.Random @@ -10,10 +9,53 @@ -- Stability : experimental -- Portability : non-portable -- --- A PRNG for use in Component and the Component test infrastructure. +-- = Overview -- --- Uses the splitmix32 algorithm under the hood. +-- "Miso.Random" provides a pseudo-random number generator for miso +-- components and their test infrastructure. It is built on the +-- algorithm, implemented as a +-- stateful JavaScript function stored in a 'Miso.DSL.Function'. -- +-- Two usage styles are available: +-- +-- * __Explicit generator__ β€” pass a 'StdGen' through your code using +-- 'next' (analogous to @System.Random@). +-- * __Global generator__ β€” use 'replicateRM' or access 'globalStdGen' +-- directly for fire-and-forget random values. +-- +-- = Quick start +-- +-- @ +-- import "Miso.Random" +-- +-- -- Explicit generator +-- example :: IO () +-- example = do +-- gen <- 'newStdGen' +-- let (v, g') = 'next' gen -- v :: Double in [0, 1) +-- print v +-- +-- -- Global generator (convenience) +-- tenValues :: IO [Double] +-- tenValues = 'replicateRM' 10 +-- +-- -- Reproducible seed for tests +-- deterministicGen :: 'StdGen' +-- deterministicGen = 'mkStdGen' 42 +-- @ +-- +-- = Seeding +-- +-- * 'newStdGen' seeds from @crypto.getRandomValues()@ β€” cryptographically +-- random, non-reproducible. +-- * 'mkStdGen' takes an explicit 'Seed' (@Int@) β€” reproducible, useful for +-- property tests or simulations. +-- * 'globalStdGen' is seeded once at module load time from @Math.random()@. +-- +-- = See also +-- +-- * 'Miso.FFI.Internal.splitmix32' β€” the raw JS PRNG primitive +-- * 'Miso.FFI.Internal.getRandomValue' β€” @crypto.getRandomValues()@ used for seeding ---------------------------------------------------------------------------- module Miso.Random ( -- ** Types @@ -46,7 +88,10 @@ type Seed = Int ----------------------------------------------------------------------------- -- | Like 'Miso.Random.newStdGen' but takes a t'Seed' as an argument and is pure. -mkStdGen :: Seed -> StdGen +mkStdGen + :: Seed + -- ^ Initial seed value; identical seeds produce identical sequences + -> StdGen mkStdGen seed = StdGen $ Function $ unsafePerformIO $ FFI.splitmix32 (fromIntegral seed) ----------------------------------------------------------------------------- -- | Create a new t'StdGen', defaulting to a random t'Seed'. @@ -56,7 +101,10 @@ StdGen . Function <$> FFI.splitmix32 seed ----------------------------------------------------------------------------- -- | Get the next t'StdGen', extracting the value, useful with t'State'. -next :: StdGen -> (Double, StdGen) +next + :: StdGen + -- ^ Current generator state + -> (Double, StdGen) next (StdGen func) = unsafePerformIO $ do result <- apply func () pure (result, StdGen func) @@ -73,7 +121,10 @@ getStdGen = readIORef globalStdGen ----------------------------------------------------------------------------- -- | Set the `globalStdGen` -setStdGen :: StdGen -> IO () +setStdGen + :: StdGen + -- ^ New generator to install as the global PRNG + -> IO () setStdGen = atomicWriteIORef globalStdGen ----------------------------------------------------------------------------- -- | Generate n amount of random numbers. Uses the global PRNG 'globalStdGen'. @@ -82,7 +133,10 @@ -- replicateRM 10 :: IO [Double] -- @ -- -replicateRM :: Int -> IO [Double] +replicateRM + :: Int + -- ^ Number of random 'Double' values to generate in @[0, 1)@ + -> IO [Double] replicateRM n = do atomicModifyIORef globalStdGen $ \gen -> do swap $ flip runState gen $ replicateM n (state next) diff --git a/src/Miso/Reload.hs b/src/Miso/Reload.hs --- a/src/Miso/Reload.hs +++ b/src/Miso/Reload.hs @@ -1,7 +1,5 @@ ----------------------------------------------------------------------------- {-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | @@ -12,35 +10,50 @@ -- Stability : experimental -- Portability : non-portable -- --- Support for live reloading of miso applications. +-- = Overview -- --- = Live Reload +-- "Miso.Reload" supports hot-reloading of miso applications during +-- interactive development with GHC WASM browser mode (@ghciwatch@ + +-- WASM GHCi). It provides two entry points that replace @startApp@ in +-- your @main@: -- --- This module exposes two functions meant to be used during interactive --- development with GHC WASM browser mode, 'live' and 'reload'. +-- ['reload'] clears @\@ and @\@ β€” full reset on every @:r@; model is lost +-- ['live'] clears @\@ only β€” model state survives @:r@ -- --- == Reload +-- = reload -- --- Use 'reload' if you'd like to redraw the page on each file change, resetting --- the working application state. +-- Clears both @\@ and @\@, kills any running scheduler thread, +-- and re-mounts the component from scratch. All application state is lost. +-- Use this when you are actively changing the @model@ type. -- -- @ -- main :: IO () --- main = 'reload' 'defaultEvents' app +-- main = 'reload' 'Miso.Event.Types.defaultEvents' app -- @ -- --- == Live +-- = live -- --- Use 'live' if you'd like to persist the working application state (all 'Component' 'model') --- between GHCi reloads. This only works if you do not alter the 'model' schema (e.g. add, remove, change a field's type). +-- Clears only @\@, then re-mounts the component using the __old +-- model__ value recovered from the previous GHCi session via a C-heap +-- stable pointer. @\@ injections (stylesheets, scripts) from the +-- previous session are preserved. -- -- @ -- main :: IO () --- main = 'live' 'defaultEvents' app +-- main = 'live' 'Miso.Event.Types.defaultEvents' app -- @ -- --- See the [miso-sampler](https://github.com/haskell-miso/miso-sampler) for example usage. +-- __Warning__: 'live' is unsafe if you change the @model@ type between +-- reloads (adding, removing, or changing a field's type). Such a change +-- will produce a segfault because the old in-memory model is coerced +-- directly into the new type. Use 'reload' whenever you alter the model +-- schema. -- +-- = See also +-- +-- * β€” reference project demonstrating 'live' +-- * "Miso.Runtime" β€” 'Miso.Runtime.initComponent' and component lifecycle +-- * "Miso.Event.Types" β€” 'Miso.Event.Types.defaultEvents' used as first argument ---------------------------------------------------------------------------- module Miso.Reload ( -- ** Functions @@ -48,21 +61,15 @@ , live ) where ----------------------------------------------------------------------------- +import Control.Concurrent import Control.Monad -#if __GLASGOW_HASKELL__ > 865 -import GHC.Conc.Sync (threadLabel) -import GHC.Conc (listThreads, killThread) -#endif ----------------------------------------------------------------------------- -#ifdef WASM -import Miso.DSL.TH.File (evalFile) -#endif import Miso.DSL ((!), jsg, setField) import qualified Miso.FFI.Internal as FFI import Miso.Types (Component(..), Events, App) import Miso.String (MisoString) -import Miso.Runtime (componentModel, initComponent, topLevelComponentId, resetComponentState, Hydrate(..)) -import Miso.Runtime.Internal (components) +import Miso.Runtime (componentModel, initComponent, topLevelComponentId, Hydrate(..)) +import Miso.Runtime.Internal (components, schedulerThread) ----------------------------------------------------------------------------- import Miso.Lens ----------------------------------------------------------------------------- @@ -104,31 +111,28 @@ reload :: Eq model => Events + -- ^ Event delegation map (typically 'Miso.Event.Types.defaultEvents') -> App model action + -- ^ Top-level application component to (re-)mount -> IO () reload events vcomp = do -#ifdef WASM - $(evalFile MISO_JS_PATH) -#endif - resetComponentState clearPage -#if __GLASGOW_HASKELL__ > 865 - threads <- listThreads - forM_ threads $ \threadId -> do - threadLabel threadId >>= \case - Just "scheduler" -> - killThread threadId - _ -> pure () -#endif - initComponent events Draw vcomp + exists <- x_exists + when (exists == 1) $ do + (_, oldSchedulerRef) <- deRefStablePtr =<< x_get + killThread =<< readIORef oldSchedulerRef + x_clear + clearPage + void (initComponent events Draw False vcomp) + x_store =<< newStablePtr (components, schedulerThread) ----------------------------------------------------------------------------- -- | Live reloading. Persists all t'Component' `model` between successive GHCi reloads. -- --- This means application state should persist between GHCi reloads +-- This means application state should persist between GHCi reloads -- --- Schema changes to 'model' are currently unsupported. If you're +-- Schema changes to 'model' are currently unsupported. If you're -- changing fields in 'model' (adding, removing, changing a field's type), this -- will more than likely segfault. If you change the 'view' or 'update' functions --- it will be fine. +-- it will be fine. -- -- Use 'reload' if you're changing the 'model' frequently and 'live' -- if you're adjusting the 'view' / 'update' function logic. @@ -142,26 +146,22 @@ live :: Eq model => Events + -- ^ Event delegation map (typically 'Miso.Event.Types.defaultEvents') -> App model action + -- ^ Top-level application component to (re-)mount with preserved model state -> IO () live events vcomp = do exists <- x_exists if exists == 1 then do -#if __GLASGOW_HASKELL__ > 865 - threads <- listThreads - forM_ threads $ \threadId -> do - threadLabel threadId >>= \case - Just "scheduler" -> - killThread threadId - _ -> pure () -#endif - -- clearPage (perform this with the context) - clearPage + -- clearBody (only clear the body) + clearBody -- Deref old state, update new state, set pointer in C heap. - _oldState <- readIORef =<< deRefStablePtr =<< x_get + (oldComponentsRef, oldSchedulerRef) <- deRefStablePtr =<< x_get + killThread =<< readIORef oldSchedulerRef + _oldState <- readIORef oldComponentsRef let oldModel = (_oldState IM.! topLevelComponentId) ^. componentModel initialVComp = vcomp { model = oldModel } @@ -170,26 +170,25 @@ -- Perform initial draw, this will fetch the model from the old component state -- and overwrite the old state with the new state for everything else. - initComponent events Draw initialVComp - + initComponent events Draw True initialVComp + -- Don't forget to flush (native mobile needs this too) FFI.flush - -- Clear and set static ptr to use new state + -- Clear and set static ptr to use new state (new CAF state) x_clear - x_store =<< newStablePtr components + x_store =<< newStablePtr (components, schedulerThread) else do -- This means it is initial load, just store the pointer. -#ifdef WASM - $(evalFile MISO_JS_PATH) -#endif - x_store =<< newStablePtr components - void (initComponent events Draw vcomp) + void (initComponent events Draw False vcomp) + x_store =<< newStablePtr (components, schedulerThread) ----------------------------------------------------------------------------- -clearPage :: IO () -clearPage = do +clearPage, clearBody, clearHead :: IO () +clearPage = clearBody >> clearHead +clearBody = do body_ <- jsg "document" ! ("body" :: MisoString) setField body_ "innerHTML" ("" :: MisoString) +clearHead = do head_ <- jsg "document" ! ("head" :: MisoString) setField head_ "innerHTML" ("" :: MisoString) ----------------------------------------------------------------------------- diff --git a/src/Miso/Router.hs b/src/Miso/Router.hs --- a/src/Miso/Router.hs +++ b/src/Miso/Router.hs @@ -14,6 +14,8 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -fno-warn-orphans #-} +----------------------------------------------------------------------------- -- | -- Module : Miso.Router -- Copyright : (C) 2016-2026 David M. Johnson @@ -22,95 +24,84 @@ -- Stability : experimental -- Portability : non-portable -- --- This module introduces a 'Router' that produces "correct-by-construction" URL --- encoding and decoding from any Haskell algebraic data type. This @Router@ can be used --- in conjunction with 'Miso.Subscription.History.uriSub' or 'Miso.Subscription.History.routerSub' --- to perform client-side routing. Further --- it also supports the construction of type-safe links in any @View model action@ via --- the 'href_' function exported from this module. --- --- This module can be used in two ways, one is the manual construction of a @Router@ --- as seen below. --- --- @ --- --- data Route = Widget Int --- deriving (Show, Eq) +-- = Overview -- --- instance Router Route where --- routeParser = routes [ Widget \<$\> (path "widget" *\> capture) ] --- fromRoute (Widget value) = [ toPath "widget", toCapture value ] +-- "Miso.Router" provides a type-safe, bidirectional client-side router. +-- A Haskell sum type represents your application's routes; the 'Router' +-- class encodes and decodes between that type and URL strings. The router +-- is used together with 'Miso.Subscription.History.uriSub' or +-- 'Miso.Subscription.History.routerSub' to react to browser navigation. -- --- main :: IO () --- main = print (runRouter "\/widget\/10" router) +-- = Approach 1 β€” Generic deriving (recommended) -- --- > Right (Widget "widget" 10) -- @ --- --- The second way is using the @Generic@ deriving mechanism. This should ensure that +-- {-\# LANGUAGE DeriveGeneric, DeriveAnyClass, DerivingStrategies \#-} +-- import GHC.Generics (Generic) +-- import "Miso.Router" -- +-- data Route +-- = Index -- \"\/\" +-- | About -- \"\/about\" +-- | User (Capture \"id\" Int) -- \"\/user\/42\" +-- | Search (QueryParam \"q\" 'Miso.String.MisoString') -- \"\/search?q=foo\" +-- deriving stock (Show, Eq, Generic) +-- deriving anyclass 'Router' -- @ -- --- {-# LANGUAGE DerivingStrategies #-} --- {-# LANGUAGE DeriveAnyClass #-} --- {-# LANGUAGE DeriveGeneric #-} +-- Decoding: -- --- data Route --- = About --- | Home --- | Widget (Capture "thing" Int) (Path "foo") (Capture "other" MisoString) (QueryParam "bar" Int) --- deriving stock (Generic, Show) --- deriving anyclass Router -- @ +-- 'toRoute' \"\/user\/42\" -- Right (User (Capture 42)) +-- 'toRoute' \"\/search?q=hello\" -- Right (Search (QueryParam (Just \"hello\"))) +-- @ -- --- The @Generic@ deriving works by converting the constructor name to a path so +-- Encoding (type-safe links): -- --- > test :: Either RoutingError Route --- > test = toRoute "/widget/23/foo/okay?bar=0" +-- @ +-- 'prettyRoute' (User (Capture 42)) -- \"\/user\/42\" +-- button_ [ 'href_' (User (Capture 42)) ] [ text \"Profile\" ] +-- @ -- --- Decodes as +-- = Approach 2 β€” Manual instance -- --- > Right (Widget (Capture 23) (Path "foo") (Capture "okay") (QueryParam (Just 0))) +-- @ +-- data Route = Widget Int deriving (Show, Eq) -- --- The order of t`Capture` and t`Path` matters when defined on your sum type. The order of t`QueryParam` and t`QueryFlag` does not. +-- instance 'Router' Route where +-- routeParser = 'routes' [ Widget \<$\> ('path' \"widget\" *\> 'capture') ] +-- fromRoute (Widget n) = [ 'toPath' \"widget\", 'toCapture' n ] +-- @ -- --- The router is "reversible" which means it can produce type-safe links using the `href_` function. +-- = Generic naming rules -- --- > prettyRoute $ Widget (Capture 23) (Path ("foo")) (Capture ("okay")) (QueryParam (Just 0)) --- > "/widget/23/foo/okay?bar=0" +-- * __Constructor name__ becomes the lowercase path segment: +-- @About@ β†’ @\/about@, @UserProfile@ β†’ @\/user@ (first camel-case hump only). +-- * The special name __@Index@__ encodes the root path @\/@. +-- * The position of 'Capture' and 'Path' fields in the constructor +-- determines their order in the URL path. The position of +-- 'QueryParam' and 'QueryFlag' does not matter. -- --- This can be used in conjunction with the @href_@ field below to embed type safe links into 'Miso.miso' @View model action@ code. +-- = URL types -- --- > button_ [ Miso.Router.href_ (Widget 10) ] [ "click me" ] +-- [@'Capture' sym a@] dynamic path segment β€” @Capture 42@ β†’ @\/42@ +-- [@'Path' sym@] fixed path segment β€” @Path \"foo\"@ β†’ @\/foo@ +-- [@'QueryParam' sym a@] optional query key β€” @QueryParam (Just 1)@ β†’ @?sym=1@ +-- [@'QueryFlag' sym@] boolean query flag β€” @QueryFlag True@ β†’ @?sym@ +-- [@'Fragment' sym@] hash fragment β€” @Fragment@ β†’ @#sym@ -- --- Note: the 'Miso.Router.Index' constructor is name special, it is used to encode the `"/"` path. +-- = Integration with history subscription -- -- @ --- --- data Route = Index --- deriving stock (Show, Eq) --- deriving anyclass (Router) --- --- main :: IO () --- main = print (fromRoute Index) --- --- -- "/" --- @ --- --- Lastly, camel-case constructors only use the first hump of the camel. +-- import "Miso.Subscription.History" ('routerSub') -- +-- subs :: ['Miso.Effect.Sub' Action] +-- subs = [ 'Miso.Subscription.History.routerSub' RouteChanged ] -- @ -- --- data Route = Index | FooBar --- deriving anyclass Router --- deriving stock (Show, Eq, Generic) --- --- main :: IO () --- main = print (prettyRoute FooBar) --- --- "/foo" --- @ +-- = See also -- +-- * "Miso.Subscription.History" β€” 'Miso.Subscription.History.uriSub', 'Miso.Subscription.History.routerSub', 'Miso.Subscription.History.pushURI' +-- * "Miso.Html.Property" β€” 'Miso.Html.Property.href_' (plain string version) ----------------------------------------------------------------------------- module Miso.Router ( -- ** Classes @@ -152,6 +143,7 @@ ----------------------------------------------------------------------------- import qualified Data.Map.Strict as M import Data.Maybe +import Data.Bifunctor (first) import Data.Functor import Data.Proxy import qualified Data.Char as C @@ -162,6 +154,7 @@ import GHC.TypeLits ----------------------------------------------------------------------------- import Miso.Types hiding (model, fragment, fragment_) +import Miso.JSON (FromJSON (..)) import Miso.Util import qualified Miso.Html.Property as P import Miso.Util.Parser hiding (NoParses) @@ -197,7 +190,7 @@ ----------------------------------------------------------------------------- instance (ToMisoString a, KnownSymbol path) => ToMisoString (QueryParam path a) where toMisoString (QueryParam maybeVal) = - maybe mempty (\param -> "?" <> param <> "=" <> val) (ms <$> maybeVal) + maybe mempty (\param -> "?" <> ms param <> "=" <> val) maybeVal where val = ms $ symbolVal (Proxy @path) ----------------------------------------------------------------------------- @@ -224,7 +217,13 @@ deriving (Show, Eq) ----------------------------------------------------------------------------- -- | Smart constructor for building a 'QueryParamToken' -toQueryParam :: ToMisoString s => MisoString -> s -> Token +toQueryParam + :: ToMisoString s + => MisoString + -- ^ Query parameter key + -> s + -- ^ Query parameter value + -> Token toQueryParam k v = QueryParamToken k (Just (ms v)) ----------------------------------------------------------------------------- -- | Smart constructor for building a capture variable @@ -336,6 +335,12 @@ Left (L.UnexpectedEOF eof) -> Left ("EOF: " <> ms (show eof)) Right tokens -> Right (tokensToURI tokens) ----------------------------------------------------------------------------- +instance FromMisoString URI where + fromMisoStringEither = first fromMisoString . parseURI +----------------------------------------------------------------------------- +instance FromJSON URI where + parseJSON = either fail pure . fromMisoStringEither <=< parseJSON +----------------------------------------------------------------------------- -- | Class used to facilitate routing for miso applications class Router route where fromRoute :: route -> [Token] @@ -387,7 +392,12 @@ -- @ -- ----------------------------------------------------------------------------- -runRouter :: MisoString -> RouteParser route -> Either RoutingError route +runRouter + :: MisoString + -- ^ The raw URL string to parse + -> RouteParser route + -- ^ Parser to apply against the tokenised URL + -> Either RoutingError route runRouter = parseRoute ----------------------------------------------------------------------------- -- | Convenience for specifying multiple routes diff --git a/src/Miso/Runtime.hs b/src/Miso/Runtime.hs --- a/src/Miso/Runtime.hs +++ b/src/Miso/Runtime.hs @@ -2,16 +2,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE BlockArguments #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- @@ -52,6 +47,7 @@ , mailParent , mailChildren , mailAncestors + , mailDescendants -- ** WebSocket , websocketConnect , websocketConnectJSON @@ -80,11 +76,11 @@ , arrayBuffer -- ** Internal Component state , components + , schedulerThread , componentIds , rootComponentId , componentId , modifyComponent - , resetComponentState , componentModel -- ** Scheduler , scheduler @@ -101,12 +97,12 @@ import Control.Category ((.)) import Control.Concurrent import Control.Exception (SomeException, catch, evaluate) -import Control.Monad (forM, forM_, when, void, (<=<), zipWithM_, forever, foldM) +import Control.Monad (forM, forM_, when, void, (<=<), zipWithM_, forever, foldM, unless) import Control.Monad.Reader (ask, asks) import Control.Monad.State hiding (state) -import Miso.JSON (FromJSON, ToJSON, Result(..), fromJSON, toJSON) -import Data.Foldable (toList) -import qualified Data.List as List +import Miso.JSON (FromJSON, ToJSON, Result(..), Value, encode, fromJSON, jsonStringify, toJSON) + +import Data.Foldable (foldl') import Data.Maybe import Data.Map.Strict (Map) import qualified Data.Map.Strict as M @@ -115,13 +111,11 @@ import Data.IORef (IORef, newIORef, atomicModifyIORef', readIORef, atomicWriteIORef) import qualified Data.Sequence as S import Data.Sequence (Seq) -#if __GLASGOW_HASKELL__ > 865 -import GHC.Conc (labelThread) -#endif import GHC.Conc (ThreadStatus(ThreadDied, ThreadFinished), threadStatus) import Prelude hiding ((.)) import System.IO.Unsafe (unsafePerformIO) import System.Mem.StableName (makeStableName) +import System.Mem (performMajorGC) #ifdef BENCH import Text.Printf #endif @@ -143,7 +137,6 @@ import qualified Miso.FFI.Internal as FFI import Miso.FFI.Internal (Blob(..), ArrayBuffer(..)) import qualified Miso.Hydrate as Hydrate -import Miso.JSON (encode, jsonStringify, Value) import Miso.Lens hiding (view) import Miso.String (ToMisoString(..)) import Miso.Types @@ -159,15 +152,17 @@ -- ^ Is the root node being rendered? -> props -- ^ Initial props for this component + -> Maybe Key + -- ^ Optional key for stable hot-reload model recovery -> Component parent props model action -> IO DOMRef -- ^ Callback function is used for obtaining the t'Miso.Types.Component' 'DOMRef'. -> IO (ComponentState parent props model action) -initialize events _componentParentId hydrate isRoot initialProps comp@Component {..} getComponentMountPoint = do +initialize events _componentParentId hydrate isRoot initialProps maybeKey comp@Component {..} getComponentMountPoint = do _componentId <- freshComponentId - let _componentProps = initialProps let - _componentSink = \action -> liftIO $ do + _componentProps = initialProps + _componentSink = \action -> do atomicModifyIORef' globalQueue (\q -> (enqueue _componentId action q, ())) notify globalWaiter @@ -175,42 +170,48 @@ case (hydrate, hydrateModel) of (Hydrate, Just m) -> m (Draw, _) -> do - IM.lookup _componentId <$> readIORef components >>= \case - Nothing -> - pure model - Just cs -> - -- hot reload scenario, let it flow - pure (cs ^. componentModel) + vcomps <- readIORef components + case maybeKey of + Just k -> pure $ fromMaybe model $ listToMaybe + [ cs ^. componentModel + | cs <- IM.elems vcomps + , cs ^. componentKey == Just k + ] + Nothing -> pure model _ -> pure model - _componentScripts <- (++) <$> renderScripts scripts <*> renderStyles styles + _componentScripts <- + IM.lookup _componentId <$> readIORef components >>= \case + Nothing -> (++) <$> renderScripts scripts <*> renderStyles styles + Just cs -> pure (_componentScripts cs) -- hot reload scenario, reuse already mounted scripts + _componentDOMRef <- getComponentMountPoint - _componentIsDirty <- pure False - _componentVTree <- liftIO $ newIORef (VTree (Object jsNull)) - _componentSubThreads <- liftIO (newIORef M.empty) + let _componentIsDirty = False + _componentVTree <- newIORef (VTree (Object jsNull)) + _componentSubThreads <- newIORef M.empty frame <- newEmptyMVar :: IO (MVar Double) - _componentMailbox <- pure S.empty + let _componentMailbox = S.empty rAFCallback <- asyncCallback1 $ \jsval -> do putMVar frame =<< fromJSValUnchecked jsval let _componentDraw = \newModel -> do - props <- (^. componentProps) . (IM.! _componentId) <$> readIORef components + currentProps <- (^. componentProps) . (IM.! _componentId) <$> readIORef components newVTree <- buildVTree events _componentParentId _componentId Draw - _componentSink logLevel (view props newModel) - oldVTree <- liftIO (readIORef _componentVTree) + _componentSink logLevel (view currentProps newModel) + oldVTree <- readIORef _componentVTree _frame <- requestAnimationFrame rAFCallback _timestamp :: Double <- takeMVar frame Diff.diff (Just oldVTree) (Just newVTree) _componentDOMRef FFI.updateRef oldVTree newVTree - liftIO (atomicWriteIORef _componentVTree newVTree) + atomicWriteIORef _componentVTree newVTree FFI.flush - let _componentApplyActions = \(actions :: [action]) model_ comps props -> do - let info = ComponentInfo _componentId _componentParentId _componentDOMRef props - List.foldl' (\(vcomps, m, ss, dirtySet) a -> + let _componentApplyActions = \(actions :: Seq action) model_ comps currentProps -> do + let info = ComponentInfo _componentId _componentParentId _componentDOMRef currentProps + foldl' (\(vcomps, m, ss, dirtySet) a -> case runEffect (update a) info m of (n, sss) -> let (newComps, newDirty) @@ -224,12 +225,18 @@ let vcomponent = ComponentState { _componentEvents = events + , _componentKey = maybeKey , _componentMailbox = mailbox , _componentBindings = bindings , _componentTopics = mempty , _componentModelDirty = modelCheck , _componentChildren = mempty , _componentModel = initializedModel + , _prevComponentProps = _componentProps + , _componentPropsPhase = \oldProps newProps -> + case onPropsChanged of + Just f -> _componentSink (f oldProps newProps) + _ -> pure () , .. } @@ -289,8 +296,8 @@ initSubs subs_ _componentSubThreads _componentSink = do forM_ subs_ $ \sub_ -> do threadId <- forkIO (sub_ _componentSink) - subKey <- liftIO freshSubId - liftIO $ atomicModifyIORef' _componentSubThreads $ \m -> + subKey <- freshSubId + atomicModifyIORef' _componentSubThreads $ \m -> (M.insert subKey threadId m, ()) ----------------------------------------------------------------------------- -- | Diffs two models, returning True if a redraw is necessary @@ -313,13 +320,14 @@ forever $ do getBatch >>= \case Nothing -> wait globalWaiter - Just (vcompId, []) + Just (vcompId, S.Empty) | vcompId < 0 -> do -- props propagation, negated 'ComponentId' indicates render-phase only. - vcomps <- liftIO (readIORef components) - forM_ (IM.lookup (negate vcompId) vcomps) $ \ComponentState {..} -> + vcomps <- readIORef components + forM_ (IM.lookup (negate vcompId) vcomps) $ \ComponentState {..} -> do _componentDraw _componentModel - + _componentPropsPhase _prevComponentProps _componentProps + Just (vcompId, actions) -> do mounted <- isMounted vcompId when mounted (run vcompId actions) @@ -327,11 +335,11 @@ ----------------------------------------------------------------------------- -- | Execute the commit phase against the model, perform top-down render -- of the entire Component tree. - run :: ComponentId -> [action] -> IO () + run :: ComponentId -> Seq action -> IO () run vcompId = renderComponents <=< commit vcompId ----------------------------------------------------------------------------- -- | Apply the actions across the model, evaluate async and sync IO. - commit :: ComponentId -> [action] -> IO ComponentIds + commit :: ComponentId -> Seq action -> IO ComponentIds commit vcompId events = do (updatedModel, schedules, dirtySet, ComponentState{..}) <- do atomicModifyIORef' components $ \vcomps -> do @@ -359,13 +367,15 @@ -- Reset the dirty bit if a render occurs -- renderComponents :: ComponentIds -> IO () -renderComponents dirtySet = do - forM_ (IS.toAscList dirtySet) $ \vcompId -> - IM.lookup vcompId <$> liftIO (readIORef components) >>= mapM \ComponentState {..} -> do - when _componentIsDirty $ do - _componentDraw _componentModel - FFI.modelHydration _componentId =<< toObject jsNull - modifyComponent _componentId (isDirty .= False) +renderComponents dirtySet = + IS.foldr (\vcompId acc -> renderOne vcompId >> acc) (pure ()) dirtySet + where + renderOne vcompId = + IM.lookup vcompId <$> readIORef components >>= mapM_ \ComponentState {..} -> do + when _componentIsDirty $ do + _componentDraw _componentModel + FFI.modelHydration _componentId =<< toObject jsNull + modifyComponent _componentId (isDirty .= False) ----------------------------------------------------------------------------- -- | Modify a single t'Component p m a' at a t'ComponentId'. -- @@ -374,13 +384,9 @@ :: ComponentId -> State (ComponentState parent props model action) a -> IO () -modifyComponent vcompId go = liftIO $ do +modifyComponent vcompId go = atomicModifyIORef' components $ \vcomps -> - case IM.lookup vcompId vcomps of - Nothing -> - (vcomps, ()) - Just comp -> - (IM.insert vcompId (execState go comp) vcomps, ()) + (IM.adjust (execState go) vcompId vcomps, ()) ---------------------------------------------------------------------------- propagate :: ComponentId @@ -408,7 +414,7 @@ ----------------------------------------------------------------------------- type Synch p props m a x = State (DFS p props m a) x ----------------------------------------------------------------------------- -visited :: Lens (DFS p props m a) (ComponentIds) +visited :: Lens (DFS p props m a) ComponentIds visited = lens _visited $ \r x -> r { _visited = x } ----------------------------------------------------------------------------- state :: Lens (DFS p props m a) (IntMap (ComponentState p props m a)) @@ -423,7 +429,7 @@ go :: ComponentState p props m a -> Synch p props m a () go cs = do seen <- IS.member (cs ^. componentId) <$> use visited - when (not seen) $ do + unless seen $ do propagateParent cs (cs ^. parentId) propagateChildren cs (cs ^. children) markVisited (cs ^. componentId) @@ -550,23 +556,23 @@ buildVTree events _componentParentId _componentId Draw _componentSink logLevel (view _componentProps initializedModel) Diff.diff Nothing (Just newTree) _componentDOMRef - liftIO (atomicWriteIORef _componentVTree newTree) + atomicWriteIORef _componentVTree newTree else atomicWriteIORef _componentVTree vtree ----------------------------------------------------------------------------- -- | Pulls the next Component for processing out of the queue, along with -- its events. -getBatch :: IO (Maybe (ComponentId, [action])) +getBatch :: IO (Maybe (ComponentId, Seq action)) getBatch = do - liftIO $ atomicModifyIORef' globalQueue $ \q -> + atomicModifyIORef' globalQueue $ \q -> case dequeue q of Nothing -> (q, Nothing) Just (vcompId, actions, newQueue) -> (newQueue, Just (vcompId, actions)) ----------------------------------------------------------------------------- -- | Helper for event extraction at a specific 'ComponentId' -drainQueueAt :: ComponentId -> IO [a] -drainQueueAt vcompId = liftIO $ atomicModifyIORef' globalQueue (dequeueAt vcompId) +drainQueueAt :: ComponentId -> IO (Seq a) +drainQueueAt vcompId = atomicModifyIORef' globalQueue (dequeueAt vcompId) ----------------------------------------------------------------------------- -- | Data type for holding the events in the system along with -- the schedule of what events should be processed next @@ -612,15 +618,15 @@ dequeue :: forall action . Queue action - -> Maybe (ComponentId, [action], Queue action) + -> Maybe (ComponentId, Seq action, Queue action) dequeue q = case q ^. queueSchedule of S.Empty -> Nothing - sched@(vcompId S.:<| leftover) -> + sched@(vcompId S.:<| _) -> case q ^. queue . at vcompId of Nothing -> let (_, remaining) = S.spanl (== vcompId) sched - in Just (vcompId, [], q & queueSchedule .~ remaining) + in Just (vcompId, S.empty, q & queueSchedule .~ remaining) Just actions -> case S.spanl (==vcompId) sched of (scheduled, remaining) -> @@ -629,7 +635,7 @@ let updated = q & queueSchedule .~ remaining & queue.at vcompId .~ do if null rest then Nothing else Just rest - Just (vcompId, toList process, updated) + Just (vcompId, process, updated) ----------------------------------------------------------------------------- -- | Dequeues everything from the Queue at a specific t'ComponentId', draining -- both the queue events and the queue schedule. @@ -637,15 +643,15 @@ :: forall action . ComponentId -> Queue action - -> (Queue action, [action]) + -> (Queue action, Seq action) dequeueAt vcompId q = case q ^. queue . at vcompId of - Nothing -> (q, []) + Nothing -> (q, S.empty) Just actions -> do -- dmj: remove from schedule, extract all events let updated = q & queueSchedule %~ S.filter (/=vcompId) & queue.at vcompId .~ Nothing - (updated, toList actions) + (updated, actions) ----------------------------------------------------------------------------- globalWaiter :: Waiter {-# NOINLINE globalWaiter #-} @@ -658,10 +664,13 @@ componentId :: Lens (ComponentState parent props model action) ComponentId componentId = lens _componentId $ \record field -> record { _componentId = field } ----------------------------------------------------------------------------- +componentKey :: Lens (ComponentState parent props model action) (Maybe Key) +componentKey = lens _componentKey $ \record field -> record { _componentKey = field } +----------------------------------------------------------------------------- parentId :: Lens (ComponentState parent props model action) ComponentId parentId = lens _componentParentId $ \record field -> record { _componentParentId = field } ----------------------------------------------------------------------------- -children :: Lens (ComponentState parent props model action) (ComponentIds) +children :: Lens (ComponentState parent props model action) ComponentIds children = lens _componentChildren $ \record field -> record { _componentChildren = field } ----------------------------------------------------------------------------- componentTopics :: Lens (ComponentState parent props model action) (Map MisoString (Value -> IO ())) @@ -679,6 +688,9 @@ componentProps :: Lens (ComponentState parent props model action) props componentProps = lens _componentProps $ \record field -> record { _componentProps = field } ----------------------------------------------------------------------------- +prevComponentProps :: Lens (ComponentState parent props model action) props +prevComponentProps = lens _prevComponentProps $ \record field -> record { _prevComponentProps = field } +----------------------------------------------------------------------------- -- | Hydrate avoids calling @diff@, and instead calls @hydrate@ -- 'Draw' invokes 'Miso.Diff.diff' data Hydrate @@ -691,10 +703,14 @@ = ComponentState { _componentId :: ComponentId -- ^ The ID of the current t'Miso.Types.Component' + , _componentKey :: Maybe Key + -- ^ Optional key for stable hot-reload model recovery , _componentParentId :: ComponentId -- ^ The ID of the t'Miso.Types.Component''s parent , _componentProps :: props -- ^ The current props passed to this t'Miso.Types.Component' + , _prevComponentProps :: props + -- ^ The previous Component props passed to this t'Miso.Types.Component' , _componentSubThreads :: IORef (Map MisoString ThreadId) -- ^ Mapping of all 'Sub' in use by t'Miso.Types.Component' , _componentDOMRef :: DOMRef @@ -717,10 +733,12 @@ -- ^ Mailbox for asynchronous t'Miso.Types.Component' communication , _componentDraw :: model -> IO () -- ^ Helper function for t'Miso.Types.Component' rendering + , _componentPropsPhase :: props -> props -> IO () + -- ^ Helper function for t'Miso.Types.Component' props changed phase. , _componentModelDirty :: model -> model -> Bool -- ^ Model diffing , _componentApplyActions - :: [action] + :: Seq action -> model -> IntMap (ComponentState parent props model action) -> props @@ -767,7 +785,7 @@ -- | Subscribe -- | Unsubscribe -- --- update_ :: Action -> Effect Int Action +-- update_ :: Action -> Effect parent props Int Action -- update_ = \case -- Unsubscribe -> -- unsubscribe arithmetic @@ -786,46 +804,46 @@ topic :: MisoString -> Topic a topic = Topic ----------------------------------------------------------------------------- --- | Subscribes to a @Topic@, provides callback function that writes to t'Miso.Types.Component' 'Sink' +-- | Subscribes a t'Miso.Types.Component' to a t'Topic'. -- --- If a @Topic message@ does not exist when calling 'subscribe' it is generated dynamically. --- Each subscriber decodes the received 'Value' using it's own 'FromJSON' instance. This provides --- for loose-coupling between t'Miso.Types.Component'. As long as the underlying 'Value' are identical --- t'Miso.Types.Component' can use their own types without serialization issues. @Topic message@ should --- have their own JSON API specification when being distributed. +-- Registers a callback in the component that decodes incoming messages +-- using its own 'FromJSON' instance and dispatches them to the component's +-- 'Sink'. If the component is already subscribed to the named topic the +-- previous callback is replaced. -- +-- Because each subscriber uses its own 'FromJSON', components can use +-- different Haskell types for the same topic as long as the underlying +-- JSON is compatible, enabling loose coupling between t'Miso.Types.Component'. +-- -- @ -- +-- data Message = Increment | Decrement +-- deriving (Show, Eq, Generic, ToJSON, FromJSON) +-- -- arithmetic :: Topic Message -- arithmetic = topic "arithmetic" -- --- clientComponent :: MisoString -> Component Int Action --- clientComponent name = component 0 update_ $ \m -> --- div_ --- [] --- [ br_ [] --- , text (name <> " : " <> ms (m ^. _id)) --- , button_ [ onClick Unsubscribe ] [ "unsubscribe" ] --- , button_ [ onClick Subscribe ] [ "subscribe" ] --- ] where --- update_ :: Action -> Effect Int Action --- update_ = \case --- AddOne -> do --- _id += 1 --- SubtractOne -> --- _id -= 1 --- Unsubscribe -> --- unsubscribe arithmetic --- Subscribe -> --- subscribe arithmetic Notification --- Notification (Success Increment) -> do --- update_ AddOne --- Notification (Success Decrement) -> do --- update_ SubtractOne --- Notification (Error msg) -> --- io_ $ consoleError ("Decode failure: " <> ms msg) --- _ -> pure () +-- data Action +-- = Notify Message +-- | NotifyError MisoString +-- | Subscribe +-- | Unsubscribe +-- | AddOne +-- | SubtractOne -- +-- update_ :: Action -> Effect parent props Int Action +-- update_ = \\case +-- Subscribe -> +-- subscribe arithmetic Notify NotifyError +-- Unsubscribe -> +-- unsubscribe arithmetic +-- Notify Increment -> update_ AddOne +-- Notify Decrement -> update_ SubtractOne +-- NotifyError msg -> +-- io_ $ consoleError ("Decode failure: " <> msg) +-- AddOne -> _count += 1 +-- SubtractOne -> _count -= 1 +-- -- @ -- -- @since 1.9.0.0 @@ -845,47 +863,20 @@ Success s -> successful s Error e -> errorful e) ----------------------------------------------------------------------------- --- Pub / Sub implementation --- --- (Subscribe) --- --- Check if you're already subscribed to this topic. --- --- [true] - If you're already subscribed, then it's a no-op (warn) --- --- [false] - If you're not subscribed then fork a new thread that holds the duplicated topic --- and blocks on the read end of the duplicated topic, sink messages into component sink --- --- (Unsubscribe) --- --- Check if you're already subscribed to this topic --- --- [true] - Kill the thread, delete the subscriber entry --- --- [false] - If you're not subscribed, then it's a no-op (warn) --- --- (Publish) --- --- Check if the Topic exists --- --- [true] - If it exists then write the message to the topic --- --- [false] - If it doesn't exist, create it. --- --- N.B. Components can be both publishers and subscribers to their own topics. ------------------------------------------------------------------------------ --- | Unsubscribe from a t'Topic' +-- | Unsubscribes a t'Miso.Types.Component' from a t'Topic'. -- --- Unsubscribes a t'Miso.Types.Component' from receiving messages from t'Topic' +-- Removes the callback registered by 'subscribe' so the component no longer +-- receives messages published to the topic. If the component is not +-- currently subscribed this is a no-op. -- --- See 'subscribe' for more use. +-- See 'subscribe' for example usage. -- -- @since 1.9.0.0 unsubscribe :: Topic message -> Effect parent props model action unsubscribe (Topic topicName) = do ComponentInfo {..} <- ask io_ $ modifyComponent _componentInfoId $ do - (componentTopics %= M.delete topicName) + componentTopics %= M.delete topicName ----------------------------------------------------------------------------- -- | Publish to a t'Topic message' -- @@ -902,7 +893,7 @@ -- arithmetic :: Topic Message -- arithmetic = topic "arithmetic" -- --- server :: Component () Action +-- server :: Component parent props () Action -- server = component () update_ $ \() -> -- div_ -- [] @@ -912,7 +903,7 @@ -- , component_ (client_ "client 1") -- , component_ (client_ "client 2") -- ] where --- update_ :: Action -> Effect parent () Action +-- update_ :: Action -> Effect parent props () Action -- update_ = \case -- AddOne -> -- publish arithmetic Increment @@ -927,14 +918,14 @@ => Topic message -> message -> IO () -publish (Topic topicName) message = mapM_ go =<< IM.elems <$> readIORef components +publish (Topic topicName) message = mapM_ go . IM.elems =<< readIORef components where - go ComponentState {..} = do + go ComponentState {..} = case M.lookup topicName _componentTopics of Nothing -> pure () - Just f -> do - liftIO (f (toJSON message)) + Just f -> + f (toJSON message) ----------------------------------------------------------------------------- subIds :: IORef Int {-# NOINLINE subIds #-} @@ -966,6 +957,50 @@ freshComponentId :: IO ComponentId freshComponentId = atomicModifyIORef' componentIds $ \y -> (y + 1, y) ----------------------------------------------------------------------------- +-- | 'cleanup' is used to remove previous application state (when using miso w/ GHCi). +-- +-- As seen in +-- +-- * Detect if previous 'Component' tree is present. +-- * Unmount in descending order (top-level 'Component' removed last), invoking finalizers +-- * Kill the scheduler thread (a new one is created on ':r'). +-- * Erase all 'Component' +-- * Erase 'Queue' +-- * Reset 'componentId' +-- * Recreate 'DOMRef', GCs previous event listeners in JS. +-- * Yield to the scheduler (unwind thread stacks). +-- * Perform major garbage collection (cleans out old state). +-- +-- This GC should remove the previous 'Notify' / 'MVar' as well since the 'sink' +-- closure should go out of scope. +-- +cleanup :: Bool -> DOMRef -> IO () +cleanup live domRef = do + vcomps <- readIORef components + when (IM.size vcomps > 0) $ do + killThread =<< readIORef schedulerThread + if live + then do + -- In hot reload we want to reset subs and connections, and free lifecycle hooks + forM_ (IM.toDescList vcomps) $ \(_, cs@ComponentState{..}) -> do + mapM_ killThread =<< readIORef _componentSubThreads + finalizeWebSockets _componentId + finalizeEventSources _componentId + freeLifecycleHooks cs + else do + -- We can do a full unmount if we're not doing hot reload + forM_ (IM.toDescList vcomps) $ \(_, vcomp_) -> + unmountComponent vcomp_ + atomicWriteIORef componentIds topLevelComponentId + atomicWriteIORef globalQueue mempty + unless live (atomicWriteIORef components mempty) + abort <- domRef ! "abort" + isnull <- isNull abort + unless isnull $ do + void $ (domRef # "abort") () + yield + performMajorGC +----------------------------------------------------------------------------- -- | componentMap -- -- This is a global t'Miso.Types.Component' @Map@ that holds the state of all currently @@ -988,7 +1023,7 @@ -> IO () drain ComponentState {..} = do drainQueueAt _componentId >>= \case - [] -> pure () + S.Empty -> pure () actions -> do vcomps <- readIORef components case _componentApplyActions actions _componentModel vcomps _componentProps of @@ -1007,12 +1042,14 @@ unloadScripts :: ComponentState parent props model action -> IO () unloadScripts ComponentState {..} = do head_ <- FFI.getHead - forM_ _componentScripts (FFI.removeChild head_) + forM_ _componentScripts $ \domRef -> do + contains <- fromJSValUnchecked =<< do head_ # "contains" $ [domRef] + when contains (FFI.removeChild head_ domRef) ----------------------------------------------------------------------------- -- | Helper to drop all lifecycle and mounting hooks if defined. freeLifecycleHooks :: ComponentState parent props model action -> IO () freeLifecycleHooks ComponentState {..} = do - VTree (Object comp) <- liftIO (readIORef _componentVTree) + VTree (Object comp) <- readIORef _componentVTree mapM_ freeFunction =<< fromJSVal =<< comp ! ("mount" :: MisoString) mapM_ freeFunction =<< fromJSVal =<< comp ! ("unmount" :: MisoString) ----------------------------------------------------------------------------- @@ -1021,27 +1058,17 @@ :: ComponentState parent props model action -> IO () unmountComponent cs@ComponentState {..} = do - liftIO (mapM_ killThread =<< readIORef _componentSubThreads) + mapM_ killThread =<< readIORef _componentSubThreads drain cs finalizeWebSockets _componentId finalizeEventSources _componentId unloadScripts cs freeLifecycleHooks cs - liftIO $ do - modifyComponent _componentParentId $ do - children.at _componentId .= Nothing - atomicModifyIORef' components $ \m -> (IM.delete _componentId m, ()) + modifyComponent _componentParentId $ do + children.at _componentId .= Nothing + atomicModifyIORef' components $ \m -> (IM.delete _componentId m, ()) FFI.unmountComponent _componentId ----------------------------------------------------------------------------- -resetComponentState :: IO () -> IO () -resetComponentState clear = do - cs <- atomicModifyIORef' components $ \vcomps -> (mempty, vcomps) - atomicWriteIORef globalQueue mempty - atomicWriteIORef componentIds topLevelComponentId - atomicWriteIORef subIds 0 - forM_ cs unmountComponent - clear ------------------------------------------------------------------------------ -- | Internal function for construction of a Virtual DOM. -- -- Component mounting should be synchronous. @@ -1065,7 +1092,7 @@ mountCallback <- do syncCallback1' $ \parent_ -> do - ComponentState {..} <- initialize events_ vcompId hydrate False newProps app (pure parent_) + ComponentState {..} <- initialize events_ vcompId hydrate False newProps maybeKey app (pure parent_) modifyComponent vcompId (children %= IS.insert _componentId) vtree <- toJSVal =<< readIORef _componentVTree FFI.set "parent" vcomp_ (Object vtree) @@ -1091,7 +1118,9 @@ componentId_ <- fromJSValUnchecked =<< vcomp_ ! ("componentId" :: MisoString) currentProps <- _componentProps . (IM.! componentId_) <$> readIORef components when (currentProps /= newProps) $ do - modifyComponent componentId_ (componentProps .= newProps) + modifyComponent componentId_ $ do + componentProps .= newProps + prevComponentProps .= currentProps enqueueSchedule componentId_ FFI.set "diffProps" diffPropsCallback vcomp_ @@ -1106,7 +1135,7 @@ vnode_ <- createNode "vnode" ns tag setAttrs vnode_ attrs snk logLevel_ events_ vchildren <- toJSVal =<< procreate vnode_ - flip (FFI.set "children") vnode_ vchildren + FFI.set "children" vchildren vnode_ flip (FFI.set "type") vnode_ =<< toJSVal VNodeType pure (VTree vnode_) where @@ -1202,8 +1231,8 @@ -- | Registers components in the global state registerComponent :: MonadIO m => ComponentState parent props model action -> m () registerComponent componentState = liftIO $ - atomicModifyIORef' components $ \cs -> - (IM.insert (_componentId componentState) componentState cs, ()) + atomicModifyIORef' components $ \vcomps' -> + (IM.insert (_componentId componentState) componentState vcomps', ()) ----------------------------------------------------------------------------- -- | Renders styles -- @@ -1396,6 +1425,32 @@ io_ $ do ComponentState {..} <- (IM.! _componentInfoId) <$> readIORef components forM_ (IS.toList _componentChildren) (flip mail msg) +----------------------------------------------------------------------------- +-- | Send any @ToJSON message => message@ to all descendants t'Miso.Types.Component' mailbox +-- +-- Unlike 'mailChildren', this is relevant for all descendants 'Component'. +-- +-- @ +-- mailDescendants ("test message" :: MisoString) :: Effect parent props model action +-- @ +-- +-- @since 1.12.0.0 +mailDescendants + :: ToJSON message + => message + -- ^ Message to send + -> Effect parent props model action +mailDescendants msg = do + ComponentInfo {..} <- ask + io_ $ do + cs <- (IM.! _componentInfoId) <$> readIORef components + forM_ (IS.toList (_componentChildren cs)) $ \child -> do + walk . (IM.! child) =<< readIORef components + where + walk ComponentState {..} = do + mail _componentId msg + forM_ (IS.toList _componentChildren) $ \child -> do + walk . (IM.! child) =<< readIORef components ---------------------------------------------------------------------------- -- | Helper function for processing @Mail@ from 'mail'. -- @@ -1646,8 +1701,8 @@ ----------------------------------------------------------------------------- finalizeWebSockets :: ComponentId -> IO () finalizeWebSockets vcompId = do - mapM_ (mapM_ FFI.websocketClose . IM.elems) =<< - IM.lookup vcompId <$> readIORef websocketConnections + mapM_ (mapM_ FFI.websocketClose . IM.elems) . + IM.lookup vcompId =<< readIORef websocketConnections dropComponentWebSockets where dropComponentWebSockets :: IO () @@ -1804,7 +1859,7 @@ ----------------------------------------------------------------------------- -- | A null t'WebSocket' is one with a negative descriptor. emptyWebSocket :: WebSocket -emptyWebSocket = (-1) +emptyWebSocket = -1 ----------------------------------------------------------------------------- -- | A type for holding an t'EventSource' descriptor. newtype EventSource = EventSource Int @@ -1812,7 +1867,7 @@ ----------------------------------------------------------------------------- -- | A null t'EventSource' is one with a negative descriptor. emptyEventSource :: EventSource -emptyEventSource = (-1) +emptyEventSource = -1 ----------------------------------------------------------------------------- eventSourceConnections :: IORef EventSources {-# NOINLINE eventSourceConnections #-} @@ -1922,8 +1977,8 @@ ----------------------------------------------------------------------------- finalizeEventSources :: ComponentId -> IO () finalizeEventSources vcompId = do - mapM_ (mapM_ FFI.eventSourceClose . IM.elems) =<< - IM.lookup vcompId <$> readIORef eventSourceConnections + mapM_ (mapM_ FFI.eventSourceClose . IM.elems) . + IM.lookup vcompId =<< readIORef eventSourceConnections dropComponentEventSources where dropComponentEventSources :: IO () @@ -1958,16 +2013,26 @@ :: (Eq parent, Eq model) => Events -> Hydrate + -> Bool -> Component parent () model action -> IO () -initComponent events hydrate vcomp_@Component {..} = withJS $ do - root <- Diff.mountElement (getMountPoint mountPoint) - void $ initialize events rootComponentId hydrate True () vcomp_ (pure root) -#if __GLASGOW_HASKELL__ > 865 - flip labelThread "scheduler" =<< forkIO scheduler -#else - void (forkIO scheduler) -#endif +initComponent events hydrate live vcomp_@Component {..} = do + withJS $ do + root <- Diff.mountElement (getMountPoint mountPoint) + cleanup live root + void $ initialize events rootComponentId hydrate True () Nothing vcomp_ (pure root) + atomicWriteIORef schedulerThread =<< forkIO scheduler +---------------------------------------------------------------------------- +-- | Global variable to hold the scheduler thread +-- +-- N.B. 'undefined' is safe here, it will always get populated. +-- Also, we use this in 'cleanup' when interactive mode (GHCi) is detected +-- in that circumstance 'schedulerThread' will always be populated. It's an +-- invariant. +-- +schedulerThread :: IORef ThreadId +{-# NOINLINE schedulerThread #-} +schedulerThread = unsafePerformIO (newIORef undefined) ---------------------------------------------------------------------------- -- | Load miso's javascript. -- diff --git a/src/Miso/Runtime/Internal.hs b/src/Miso/Runtime/Internal.hs --- a/src/Miso/Runtime/Internal.hs +++ b/src/Miso/Runtime/Internal.hs @@ -3,29 +3,47 @@ ----------------------------------------------------------------------------- -- | -- Module : Miso.Runtime.Internal --- Copyright : (C) 2016-2026 David M. Johnson (@dmjio) +-- Copyright : (C) 2016-2026 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable -- --- This is an internal module not meant for consumption during application --- development. This is primarily meant to give user's access to the --- global @component@ state for testing. Use at your own risk. You have been warned. +-- = Overview -- --- We currently consume this module for the miso integration testing package @miso-tests@. +-- "Miso.Runtime.Internal" is a __testing-only__ facade that re-exports +-- the miso runtime's global mutable state from "Miso.Runtime". -- --- Alterations to these global variables *will* break your application. Again, do not --- use these in your main application, only use with the miso testing framework to test --- your application. +-- __Do not import this module in application code.__ Mutating any of +-- the exported 'Data.IORef.IORef' values will corrupt the component +-- lifecycle and produce undefined behaviour. The module exists solely to +-- give the @miso-tests@ integration-test package direct access to +-- component state for assertions. -- +-- = Exported names +-- +-- * 'components' β€” global 'Data.IORef.IORef' mapping 'Miso.Effect.ComponentId' +-- to 'ComponentState' for every mounted component. +-- * 'componentIds' β€” monotonically increasing 'Data.IORef.IORef' used to +-- assign fresh component identifiers. +-- * 'rootComponentId' β€” the well-known identifier of the top-level app component. +-- * 'ComponentState' β€” record holding the live model, scheduler mailbox, and +-- other per-component runtime fields. +-- * 'schedulerThread' β€” 'Data.IORef.IORef' holding the 'Control.Concurrent.ThreadId' +-- of the event-loop scheduler thread. +-- +-- = See also +-- +-- * "Miso.Runtime" β€” the authoritative definitions of everything exported here +-- * "Miso.Reload" β€” uses these internals to kill and restart the scheduler on @:r@ ---------------------------------------------------------------------------- module Miso.Runtime.Internal ( components , componentIds , rootComponentId , ComponentState(..) + , schedulerThread ) where ---------------------------------------------------------------------------- -import Miso.Runtime (components, ComponentState(..), componentIds, rootComponentId) +import Miso.Runtime (components, ComponentState(..), componentIds, rootComponentId, schedulerThread) ---------------------------------------------------------------------------- diff --git a/src/Miso/State.hs b/src/Miso/State.hs --- a/src/Miso/State.hs +++ b/src/Miso/State.hs @@ -1,28 +1,60 @@ ----------------------------------------------------------------------------- -- | -- Module : Miso.State --- Copyright : (C) 2016-2026 David M. Johnson (@dmjio) +-- Copyright : (C) 2016-2026 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable -- --- State management for Miso applications. +-- = Overview -- --- Similar to how one manages state in [React](https://react.dev/learn/managing-state), --- 'Miso.miso' applications manage state with the @State@ monad. +-- "Miso.State" re-exports the 'Control.Monad.RWS.RWS' combinators that are +-- most useful inside an 'Miso.Effect.Effect' handler. Because +-- 'Miso.Effect.Effect' is an @RWS@ monad, the full +-- 'Control.Monad.State.Class.MonadState', +-- 'Control.Monad.Reader.Class.MonadReader', and +-- 'Control.Monad.Writer.Class.MonadWriter' interfaces are available +-- without importing @mtl@ directly. -- --- The @State@ 'Monad' works well with 'Control.Monad.State.Class.MonadState' lenses as seen in [Miso.Lens](https://haddocks.haskell-miso.org) and the [lens](https://hackage.haskell.org/package/lens) library. +-- This module is re-exported in its entirety by "Miso", so most +-- applications do not need to import it explicitly. -- +-- = Quick start +-- -- @ --- updateModel :: Action -> Effect parent Model Action --- updateModel (AddOne event) = do --- modify (+1) --- io_ (consoleLog "Added One!") +-- import "Miso" -- re-exports Miso.State +-- -- or +-- import "Miso.State" -- explicit import +-- +-- data Model = Model { _count :: Int } deriving (Eq) +-- data Action = Increment | Decrement | Reset | Log +-- +-- update :: Action -> 'Miso.Effect.Effect' p props Model Action +-- update Increment = 'modify' (\\m -> m { _count = _count m + 1 }) +-- update Decrement = 'modify'' (\\m -> m { _count = _count m - 1 }) +-- update Reset = 'put' (Model 0) +-- update Log = do +-- n <- 'gets' _count +-- 'Miso.Effect.io_' (consoleLog ('Miso.String.ms' n)) -- @ -- --- This module re-exports select combinators from 'Control.Monad.RWS' and serves as a placeholder to add new state management combinators. +-- When using "Miso.Lens" or "Miso.Lens.TH", the lens update operators +-- (@'.='@, @'+='@, @'%='@, …) are built directly on 'modify', so +-- explicit calls to 'modify' \/ 'put' are rarely needed. -- +-- = Exported combinators +-- +-- * __Reader__ (component metadata): 'ask', 'asks' +-- * __State__ (model): 'get', 'gets', 'modify', 'modify'', 'put' +-- * __Writer__ (schedule IO): 'tell' +-- * __IO lift__: 'liftIO' +-- +-- = See also +-- +-- * "Miso.Effect" β€” 'Miso.Effect.Effect', 'Miso.Effect.io', 'Miso.Effect.io_', 'Miso.Effect.sync' +-- * "Miso.Lens" β€” lens operators that wrap 'modify' +-- * "Miso.Lens.TH" β€” Template Haskell lens generation ---------------------------------------------------------------------------- module Miso.State ( ask diff --git a/src/Miso/Storage.hs b/src/Miso/Storage.hs --- a/src/Miso/Storage.hs +++ b/src/Miso/Storage.hs @@ -10,8 +10,55 @@ -- Stability : experimental -- Portability : non-portable -- --- This module provides an interface to the --- [Web Storage API](https://developer.mozilla.org/en-US/docs/Web/API/Web_Storage_API). +-- = Overview +-- +-- "Miso.Storage" wraps the browser's +-- , +-- providing access to both +-- +-- and +-- +-- through symmetric 'IO' functions. +-- +-- Both stores map 'Miso.String.MisoString' keys to 'Miso.String.MisoString' +-- values (the Web Storage API only persists strings). Reads return +-- @'Maybe' 'Miso.String.MisoString'@ β€” 'Nothing' when the key is absent. +-- +-- * __localStorage__ β€” persists across browser sessions until explicitly +-- cleared. +-- * __sessionStorage__ β€” persists only for the lifetime of the current +-- browser tab\/session; cleared automatically when the tab is closed. +-- +-- = Quick start +-- +-- @ +-- import "Miso.Storage" +-- import "Miso.String" ('Miso.String.ms') +-- +-- -- Persist a preference +-- saveTheme :: 'Miso.String.MisoString' -> IO () +-- saveTheme theme = 'setLocalStorage' \"theme\" theme +-- +-- -- Restore it on startup +-- loadTheme :: IO ('Maybe' 'Miso.String.MisoString') +-- loadTheme = 'getLocalStorage' \"theme\" +-- +-- -- Session-scoped token (cleared when tab closes) +-- saveToken :: 'Miso.String.MisoString' -> IO () +-- saveToken tok = 'setSessionStorage' \"auth_token\" tok +-- @ +-- +-- = API groups +-- +-- * __localStorage__: 'getLocalStorage', 'setLocalStorage', +-- 'removeLocalStorage', 'clearLocalStorage', 'localStorageLength' +-- * __sessionStorage__: 'getSessionStorage', 'setSessionStorage', +-- 'removeSessionStorage', 'clearSessionStorage', 'sessionStorageLength' +-- +-- = See also +-- +-- * "Miso.Effect" β€” schedule storage reads\/writes with 'Miso.Effect.io' \/ 'Miso.Effect.io_' +-- * "Miso.Subscription.History" β€” URL-based state that survives page reloads ---------------------------------------------------------------------------- module Miso.Storage ( -- ** Local @@ -36,6 +83,7 @@ -- | Retrieves a value stored under the given key in session storage. getSessionStorage :: MisoString + -- ^ Storage key to look up -> IO (Maybe MisoString) getSessionStorage key = do fromJSValUnchecked =<< flip getItem key =<< sessionStorage @@ -43,6 +91,7 @@ -- | Retrieves a value stored under the given key in local storage. getLocalStorage :: MisoString + -- ^ Storage key to look up -> IO (Maybe MisoString) getLocalStorage key = fromJSValUnchecked =<< flip getItem key =<< localStorage @@ -52,7 +101,9 @@ -- @setLocalStorage key value@ sets the value of @key@ to @value@. setLocalStorage :: MisoString + -- ^ Storage key to set -> MisoString + -- ^ Value to store -> IO () setLocalStorage key value = do s <- localStorage @@ -63,7 +114,9 @@ -- @setSessionStorage key value@ sets the value of @key@ to @value@. setSessionStorage :: MisoString + -- ^ Storage key to set -> MisoString + -- ^ Value to store -> IO () setSessionStorage key value = do s <- sessionStorage @@ -74,6 +127,7 @@ -- @removeLocalStorage key@ removes the value of @key@. removeLocalStorage :: MisoString + -- ^ Storage key to remove -> IO () removeLocalStorage key = do s <- localStorage @@ -84,6 +138,7 @@ -- @removeSessionStorage key@ removes the value of @key@. removeSessionStorage :: MisoString + -- ^ Storage key to remove -> IO () removeSessionStorage key = do s <- sessionStorage diff --git a/src/Miso/String.hs b/src/Miso/String.hs --- a/src/Miso/String.hs +++ b/src/Miso/String.hs @@ -12,6 +12,19 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- The 'MisoString' type and its conversion type classes. +-- +-- 'MisoString' is a platform-conditional alias: +-- +-- * On the client (WASM \/ GHC JS backend) it is @JSString@ β€” a zero-copy +-- wrapper around a native JavaScript string, giving optimal interop with +-- the DOM and JSON APIs. +-- * On the server (@VANILLA@ build) it is 'Data.Text.Text', enabling +-- server-side rendering without any FFI dependency. +-- +-- Use 'ms' (short for 'toMisoString') to convert from 'String', 'T.Text', +-- numeric types, etc. into 'MisoString'. ---------------------------------------------------------------------------- module Miso.String ( ToMisoString (..) @@ -45,10 +58,11 @@ ---------------------------------------------------------------------------- import Miso.DSL.FFI ---------------------------------------------------------------------------- --- | An efficient string type when building miso applications +-- | The primary string type in Miso applications. -- --- t'MisoString' is t'Text' when prerendering --- t'MisoString' is a JavaScript string when using the JS/WASM backends +-- * @VANILLA@ (server\/SSR build): alias for 'Data.Text.Text' +-- * WASM \/ GHC JS backend: alias for @JSString@ β€” a zero-copy wrapper around +-- a native JavaScript string, giving optimal interop with the DOM and JSON APIs -- #ifdef VANILLA type MisoString = Text @@ -56,24 +70,30 @@ type MisoString = JSString #endif ---------------------------------------------------------------------------- --- | Convenience class for creating `MisoString` from other string-like types +-- | A type that can be converted to 'MisoString'. +-- +-- Instances are provided for 'String', 'T.Text', 'LT.Text', 'B.ByteString', +-- 'BL.ByteString', 'Double', 'Float', 'Int', 'Word', and others. +-- Use 'ms' as a short alias for 'toMisoString'. class ToMisoString str where - -- | Convert a type into 'MisoString' + -- | Convert a value to 'MisoString'. toMisoString :: str -> MisoString ---------------------------------------------------------------------------- --- | Class used to parse a 'MisoString'. Like a safe 'Read' for 'MisoString' +-- | A type that can be parsed from a 'MisoString'. +-- Like a safe 'Read' that returns an error message on failure. class FromMisoString t where + -- | Parse a 'MisoString', returning @'Left' errMsg@ on failure. fromMisoStringEither :: MisoString -> Either String t ---------------------------------------------------------------------------- --- | Reads a 'MisoString', throws an error when decoding --- fails. Use `fromMisoStringEither` as a safe alternative. +-- | Parse a 'MisoString', throwing an error on failure. +-- Use 'fromMisoStringEither' as a safe alternative. fromMisoString :: FromMisoString a => MisoString -> a fromMisoString s = case fromMisoStringEither s of Left error_ -> error ("fromMisoString: " <> error_) Right x -> x ---------------------------------------------------------------------------- --- | Convenience function, shorthand for `toMisoString` +-- | Short alias for 'toMisoString'. The idiomatic way to construct a 'MisoString'. ms :: ToMisoString str => str -> MisoString ms = toMisoString ---------------------------------------------------------------------------- diff --git a/src/Miso/String/QQ.hs b/src/Miso/String/QQ.hs --- a/src/Miso/String/QQ.hs +++ b/src/Miso/String/QQ.hs @@ -9,11 +9,62 @@ ----------------------------------------------------------------------------- -- | -- Module : Miso.String.QQ --- Copyright : (C) 2016-2026 David M. Johnson (@dmjio) +-- Copyright : (C) 2016-2026 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.String.QQ" provides the 'misoString' quasi-quoter, which lets you +-- write multiline 'Miso.String.MisoString' literals with preserved +-- whitespace and indentation directly in Haskell source. +-- +-- Enable the extension and import the quoter: +-- +-- @ +-- {-\# LANGUAGE QuasiQuotes \#-} +-- import "Miso.String.QQ" ('misoString') +-- @ +-- +-- = Quick start +-- +-- @ +-- {-\# LANGUAGE QuasiQuotes \#-} +-- import "Miso.String.QQ" +-- import "Miso.String" ('Miso.String.MisoString') +-- +-- -- Multiline literal β€” newlines and indentation are preserved as-is +-- myCSS :: 'Miso.String.MisoString' +-- myCSS = ['misoString'| +-- body { +-- margin: 0; +-- font-family: sans-serif; +-- } +-- |] +-- +-- -- Useful for injecting inline \ or \ content: +-- view :: Model -> 'Miso.Types.View' Model Action +-- view _ = +-- 'Miso.Html.Element.div_' [] +-- [ 'Miso.Html.Element.style_' [] [ 'Miso.text' myCSS ] ] +-- @ +-- +-- = How it works +-- +-- The quasi-quoter is expression-only (@quoteExp@). At compile time it +-- splices @toMisoString \@, so the result is +-- identical to writing @'Miso.String.ms' \"…\"@ but without needing to +-- escape newlines or quotes inside the brackets. +-- +-- @quotePat@, @quoteType@, and @quoteDec@ are not implemented and will +-- produce a compile error if attempted. +-- +-- = See also +-- +-- * "Miso.FFI.QQ" β€” @[js| … |]@ quasi-quoter for inline JavaScript +-- * "Miso.String" β€” 'Miso.String.MisoString', 'Miso.String.ms', 'Miso.String.toMisoString' ---------------------------------------------------------------------------- module Miso.String.QQ ( misoString diff --git a/src/Miso/Subscription.hs b/src/Miso/Subscription.hs --- a/src/Miso/Subscription.hs +++ b/src/Miso/Subscription.hs @@ -7,7 +7,59 @@ -- Stability : experimental -- Portability : non-portable -- --- Subscriptions for external events (mouse, keyboard, window, history, etc.). +-- = Overview +-- +-- "Miso.Subscription" is the re-export hub for all of miso's built-in +-- 'Miso.Effect.Sub' subscriptions. A subscription is a long-running 'IO' +-- action of type @'Miso.Effect.Sink' action -> IO ()@ that delivers +-- external events β€” mouse moves, key presses, URL changes, animation +-- frames β€” into the update loop by calling its 'Miso.Effect.Sink'. +-- +-- Register subscriptions in the 'Miso.Types.subs' field of a +-- 'Miso.Types.Component': +-- +-- @ +-- import "Miso" +-- import "Miso.Subscription" +-- +-- myComponent = ('Miso.component' model update view) +-- { 'Miso.Types.subs' = +-- [ 'mouseSub' MouseMoved +-- , 'keyboardSub' KeyPressed +-- , 'uriSub' UrlChanged +-- , 'rAFSub' Tick +-- ] +-- } +-- @ +-- +-- = Subscription catalogue +-- +-- ['mouseSub'] global @pointermove@ β€” "Miso.Subscription.Mouse" +-- ['keyboardSub'] global @keydown@ \/ @keyup@ β€” "Miso.Subscription.Keyboard" +-- ['arrowsSub', 'wasdSub', 'directionSub'] arrow or WASD keys held β€” "Miso.Subscription.Keyboard" +-- ['uriSub'] browser @popstate@ (back\/forward\/pushState) β€” "Miso.Subscription.History" +-- ['routerSub'] same, decoded via 'Miso.Router.Router' β€” "Miso.Subscription.History" +-- ['windowCoordsSub'] global window @pointermove@ β€” "Miso.Subscription.Window" +-- ['windowPointerMoveSub'] global window @pointermove@ β€” "Miso.Subscription.Window" +-- ['windowSubWithOptions'] any window event β€” "Miso.Subscription.Window" +-- ['onLineSub'] @online@ \/ @offline@ change β€” "Miso.Subscription.OnLine" +-- ['rAFSub'] every @requestAnimationFrame@ tick β€” "Miso.Subscription.RAF" +-- +-- = History helpers +-- +-- The "Miso.Subscription.History" module also exports imperative +-- navigation functions usable from within 'Miso.Effect.Effect': +-- +-- @ +-- update GoHome = 'Miso.Effect.io_' ('pushURI' ('Miso.Router.toURI' Home)) +-- update GoBack = 'Miso.Effect.io_' 'back' +-- @ +-- +-- = See also +-- +-- * "Miso.Effect" β€” 'Miso.Effect.Sub', 'Miso.Effect.Sink', 'Miso.Effect.mapSub' +-- * "Miso.Subscription.Util" β€” 'Miso.Subscription.Util.createSub' for custom subscriptions +-- * "Miso.Router" β€” 'Miso.Router.Router' typeclass used by 'routerSub' ---------------------------------------------------------------------------- module Miso.Subscription ( -- ** Mouse @@ -20,6 +72,8 @@ , module Miso.Subscription.Window -- ** OnLine , module Miso.Subscription.OnLine + -- ** requestForAnimationFrame + , module Miso.Subscription.RAF ) where ----------------------------------------------------------------------------- import Miso.Subscription.Mouse @@ -27,4 +81,5 @@ import Miso.Subscription.History import Miso.Subscription.Window import Miso.Subscription.OnLine +import Miso.Subscription.RAF ----------------------------------------------------------------------------- diff --git a/src/Miso/Subscription/History.hs b/src/Miso/Subscription/History.hs --- a/src/Miso/Subscription/History.hs +++ b/src/Miso/Subscription/History.hs @@ -8,6 +8,59 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.Subscription.History" wraps the browser's +-- +-- and +-- +-- event, providing both a reactive subscription and imperative navigation +-- helpers. +-- +-- = Subscriptions +-- +-- 'uriSub' fires whenever the URL changes β€” through browser back\/forward +-- buttons or any of the imperative helpers below: +-- +-- @ +-- subs :: ['Miso.Effect.Sub' Action] +-- subs = [ 'uriSub' UrlChanged ] +-- @ +-- +-- 'routerSub' is a convenience wrapper that decodes the 'URI' via a +-- 'Miso.Router.Router' instance before delivering it as an action: +-- +-- @ +-- subs = [ 'routerSub' (RouteChanged . 'Data.Either.fromRight' NotFound) ] +-- @ +-- +-- = Imperative navigation +-- +-- These functions push or replace entries on the browser history stack and +-- simultaneously fire a synthetic @popstate@ event so that 'uriSub' and +-- 'routerSub' are notified automatically: +-- +-- @ +-- update GoHome = 'Miso.Effect.io_' ('pushURI' ('Miso.Router.toURI' Home)) +-- update GoProfile = 'Miso.Effect.io_' ('pushRoute' (User (Capture 42))) +-- update ReplaceUrl = 'Miso.Effect.io_' ('replaceURI' newUri) +-- update GoBack = 'Miso.Effect.io_' 'back' +-- update GoForward = 'Miso.Effect.io_' 'forward' +-- update (Jump n) = 'Miso.Effect.io_' ('go' n) +-- @ +-- +-- 'getURI' reads the current URL from @window.location@ without subscribing: +-- +-- @ +-- update Init = 'Miso.Effect.io' (GotURI \<$\> 'getURI') +-- @ +-- +-- = See also +-- +-- * "Miso.Router" β€” 'Miso.Router.Router', 'Miso.Router.URI', 'Miso.Router.toURI', 'Miso.Router.prettyURI' +-- * "Miso.Subscription" β€” re-export hub +-- * "Miso.Subscription.Util" β€” 'Miso.Subscription.Util.createSub' used internally ---------------------------------------------------------------------------- module Miso.Subscription.History ( -- *** Subscription @@ -35,7 +88,10 @@ import Miso.Subscription.Util ----------------------------------------------------------------------------- -- | Pushes a new URI onto the History stack. Also raises a `popstate` event. -pushURI :: URI -> IO () +pushURI + :: URI + -- ^ The URI to push onto the history stack + -> IO () pushURI uri = do pushState (prettyURI uri) raisePopState @@ -44,11 +100,18 @@ -- -- Converts the t'Route' to a t'URI' internally. -- -pushRoute :: Router route => route -> IO () +pushRoute + :: Router route + => route + -- ^ The route to push onto the history stack (converted to a URI internally) + -> IO () pushRoute = pushURI . toURI ----------------------------------------------------------------------------- -- | Replaces current URI on stack. Also raises a `popstate` event. -replaceURI :: URI -> IO () +replaceURI + :: URI + -- ^ The URI to replace the current history entry with + -> IO () replaceURI uri = do replaceState (prettyURI uri) raisePopState @@ -68,7 +131,10 @@ forward = void $ getHistory # "forward" $ () ----------------------------------------------------------------------------- -- | Jumps to a specific position in history. -go :: Int -> IO () +go + :: Int + -- ^ Number of steps to jump; positive = forward, negative = backward + -> IO () go n = void $ getHistory # "go" $ [n] ----------------------------------------------------------------------------- -- | Subscription for t'URI' changes, uses the History API. @@ -76,16 +142,23 @@ -- This returns a new t'URI' whenever `go`, `back`, `forward`, `pushState` -- or `replaceState` have been called. -- -uriSub :: (URI -> action) -> Sub action +uriSub + :: (URI -> action) + -- ^ Callback fired with the new 'URI' on every URL change + -> Sub action uriSub f sink = createSub acquire release sink where release = FFI.windowRemoveEventListener "popstate" acquire = FFI.windowAddEventListener "popstate" $ \_ -> - (sink =<< f <$> getURI) + sink . f =<< getURI ----------------------------------------------------------------------------- -- | Subscription for @popstate@ events, from the History API, mapped -- to a user-defined 'Router'. -routerSub :: Router route => (Either RoutingError route -> action) -> Sub action +routerSub + :: Router route + => (Either RoutingError route -> action) + -- ^ Callback fired with the decoded route (or 'RoutingError') on every URL change + -> Sub action routerSub f = uriSub $ \uri -> f (route uri) ----------------------------------------------------------------------------- -- | Retrieves the current relative URI by inspecting @pathname@, @search@ diff --git a/src/Miso/Subscription/Keyboard.hs b/src/Miso/Subscription/Keyboard.hs --- a/src/Miso/Subscription/Keyboard.hs +++ b/src/Miso/Subscription/Keyboard.hs @@ -9,6 +9,51 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.Subscription.Keyboard" provides global keyboard subscriptions that +-- track which keys are currently held down. All four subscriptions register +-- @keydown@, @keyup@, and @blur@ listeners on @window@; the @blur@ handler +-- clears the pressed-key set so keys cannot get stuck when the window loses +-- focus. +-- +-- = Quick start +-- +-- @ +-- import "Miso" +-- import "Miso.Subscription.Keyboard" +-- +-- -- Fire action with arrow-key state on every key change +-- subs :: ['Miso.Effect.Sub' Action] +-- subs = [ 'arrowsSub' ArrowsChanged ] +-- +-- update :: Action -> 'Miso.Effect.Effect' p props Model Action +-- update (ArrowsChanged ('Arrows' x y)) = do +-- -- x ∈ {-1, 0, 1}, y ∈ {-1, 0, 1} +-- 'Miso.Effect.io_' (move x y) +-- @ +-- +-- = Subscription variants +-- +-- * 'keyboardSub' β€” delivers the raw @'Data.IntSet.IntSet'@ of all currently +-- pressed +-- . +-- Use this when you need to handle arbitrary key combinations. +-- +-- * 'arrowsSub' β€” maps the four arrow keys (37–40) to an 'Arrows' value +-- with @arrowX ∈ {-1, 0, 1}@ and @arrowY ∈ {-1, 0, 1}@. +-- +-- * 'wasdSub' β€” same as 'arrowsSub' but for W\/A\/S\/D (keyCodes 87\/83\/65\/68). +-- +-- * 'directionSub' β€” fully configurable: supply your own @(up, down, left, right)@ +-- keyCode lists and get the same 'Arrows' mapping. +-- +-- = See also +-- +-- * "Miso.Subscription" β€” re-export hub +-- * "Miso.Event.Types" β€” 'Miso.Event.Types.KeyCode', 'Miso.Event.Types.KeyInfo' +-- * "Miso.Html.Event" β€” per-element 'Miso.Html.Event.onKeyDown' \/ 'Miso.Html.Event.onKeyUp' ---------------------------------------------------------------------------- module Miso.Subscription.Keyboard ( -- *** Types @@ -39,7 +84,9 @@ data Arrows = Arrows { arrowX :: !Int + -- ^ Horizontal direction: @-1@ (left), @0@ (neutral), @1@ (right) , arrowY :: !Int + -- ^ Vertical direction: @-1@ (down), @0@ (neutral), @1@ (up) } deriving (Show, Eq) ----------------------------------------------------------------------------- -- | Helper function to convert keys currently pressed to @Arrows@, given a @@ -71,7 +118,9 @@ -- The Ints represent [keyCode](https://developer.mozilla.org/en-US/docs/Web/API/KeyboardEvent/keyCode)s for each direction. directionSub :: ([Int], [Int], [Int], [Int]) + -- ^ @(up, down, left, right)@ keyCode lists for each direction -> (Arrows -> action) + -- ^ Callback fired with the current 'Arrows' state on every key change -> Sub action directionSub dirs = keyboardSub . (. toArrows dirs) ----------------------------------------------------------------------------- diff --git a/src/Miso/Subscription/Mouse.hs b/src/Miso/Subscription/Mouse.hs --- a/src/Miso/Subscription/Mouse.hs +++ b/src/Miso/Subscription/Mouse.hs @@ -8,6 +8,43 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.Subscription.Mouse" provides a single global subscription, +-- 'mouseSub', that fires on every @pointermove@ event on @window@, +-- delivering a 'Miso.Event.Types.PointerEvent' carrying coordinates, +-- pressure, pointer type, and other pointer metadata. +-- +-- It is a thin convenience wrapper over +-- @'Miso.Subscription.Window.windowSub' \"pointermove\" 'Miso.Event.Decoder.pointerDecoder'@. +-- Use 'Miso.Subscription.Window.windowPointerMoveSub' directly if you +-- need identical behaviour but prefer the window-level import. +-- +-- = Quick start +-- +-- @ +-- import "Miso" +-- import "Miso.Subscription.Mouse" +-- import "Miso.Event.Types" ('Miso.Event.Types.PointerEvent'(..)) +-- +-- data Action = MouseMoved 'Miso.Event.Types.PointerEvent' +-- +-- subs :: ['Miso.Effect.Sub' Action] +-- subs = [ 'mouseSub' MouseMoved ] +-- +-- update :: Action -> 'Miso.Effect.Effect' p props Model Action +-- update (MouseMoved ev) = do +-- let (cx, cy) = client ev -- (clientX, clientY) +-- ... +-- @ +-- +-- = See also +-- +-- * "Miso.Subscription.Window" β€” 'Miso.Subscription.Window.windowPointerMoveSub', +-- 'Miso.Subscription.Window.windowCoordsSub', 'Miso.Subscription.Window.windowSub' +-- * "Miso.Event.Types" β€” 'Miso.Event.Types.PointerEvent', 'Miso.Event.Types.PointerType' +-- * "Miso.Event.Decoder" β€” 'Miso.Event.Decoder.pointerDecoder' ---------------------------------------------------------------------------- module Miso.Subscription.Mouse ( -- *** Subscription @@ -20,6 +57,9 @@ ----------------------------------------------------------------------------- -- | Captures mouse coordinates as they occur and writes them to -- an event sink. -mouseSub :: (PointerEvent -> action) -> Sub action +mouseSub + :: (PointerEvent -> action) + -- ^ Callback fired with the full 'PointerEvent' on every @pointermove@ + -> Sub action mouseSub = windowSub "pointermove" pointerDecoder ----------------------------------------------------------------------------- diff --git a/src/Miso/Subscription/OnLine.hs b/src/Miso/Subscription/OnLine.hs --- a/src/Miso/Subscription/OnLine.hs +++ b/src/Miso/Subscription/OnLine.hs @@ -8,6 +8,41 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.Subscription.OnLine" provides 'onLineSub', a subscription that +-- tracks the browser's +-- +-- connectivity status. It registers @online@ and @offline@ event listeners +-- on @window@ and fires an action with 'True' when the connection is +-- restored and 'False' when it is lost. +-- +-- = Quick start +-- +-- @ +-- import "Miso" +-- import "Miso.Subscription.OnLine" +-- +-- data Action = OnLineChanged Bool +-- +-- subs :: ['Miso.Effect.Sub' Action] +-- subs = [ 'onLineSub' OnLineChanged ] +-- +-- update :: Action -> 'Miso.Effect.Effect' p props Model Action +-- update (OnLineChanged isOnLine) +-- | isOnLine = 'Miso.Effect.io_' (consoleLog \"Back online\") +-- | otherwise = 'Miso.Effect.io_' (consoleLog \"Offline\") +-- @ +-- +-- To read the current status imperatively without subscribing, use +-- 'Miso.Navigator.isOnLine' from "Miso.Navigator". +-- +-- = See also +-- +-- * "Miso.Navigator" β€” 'Miso.Navigator.isOnLine' for one-shot reads +-- * "Miso.Subscription" β€” re-export hub +-- * "Miso.Subscription.Util" β€” 'Miso.Subscription.Util.createSub' used internally ---------------------------------------------------------------------------- module Miso.Subscription.OnLine ( -- *** Subscriptions @@ -23,7 +58,10 @@ -- -- -- -onLineSub :: (Bool -> action) -> Sub action +onLineSub + :: (Bool -> action) + -- ^ Callback: 'True' when going online, 'False' when going offline + -> Sub action onLineSub f sink = createSub acquire release sink where release (cb1, cb2) = do diff --git a/src/Miso/Subscription/RAF.hs b/src/Miso/Subscription/RAF.hs new file mode 100644 --- /dev/null +++ b/src/Miso/Subscription/RAF.hs @@ -0,0 +1,129 @@ +----------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings #-} +----------------------------------------------------------------------------- +-- | +-- Module : Miso.Subscription.RAF +-- Copyright : (C) 2016-2026 David M. Johnson +-- License : BSD3-style (see the file LICENSE) +-- Maintainer : David M. Johnson +-- Stability : experimental +-- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.Subscription.RAF" provides 'rAFSub', a subscription that hooks +-- into the browser's +-- +-- loop. On each frame the browser calls back with a +-- +-- (milliseconds since page load, sub-millisecond precision), which is +-- forwarded to the component as an action. +-- +-- This is the recommended driver for canvas-based animations and games +-- because the browser throttles the callback to the display refresh rate +-- (typically 60 fps) and pauses it automatically when the tab is hidden. +-- +-- = Quick start +-- +-- @ +-- import "Miso" +-- import "Miso.Subscription.RAF" +-- import "Miso.Canvas" +-- +-- data Action = Tick Double -- DOMHighResTimeStamp in ms +-- +-- myComponent = ('Miso.component' model update view) +-- { 'Miso.Types.subs' = [ 'rAFSub' Tick ] +-- , 'Miso.Types.events' = 'Miso.Event.Types.defaultEvents' +-- } +-- +-- update :: Action -> 'Miso.Effect.Effect' p props Model Action +-- update (Tick t) = do +-- 'Miso.State.modify' (\\m -> m { time = t }) +-- @ +-- +-- = Lifecycle +-- +-- Internally 'rAFSub' uses 'Miso.Subscription.Util.createSub': +-- +-- * __Acquire__ β€” schedules the first @requestAnimationFrame@ callback, +-- which re-schedules itself on every invocation. +-- * __Release__ β€” calls 'Miso.DSL.freeFunction' to cancel the callback +-- and release the JS reference when the component unmounts. +-- +-- = See also +-- +-- * "Miso.Canvas" β€” canvas drawing API driven by 'rAFSub' ticks +-- * "Miso.Subscription.Util" β€” 'Miso.Subscription.Util.createSub' +-- * "Miso.Subscription" β€” re-export hub +---------------------------------------------------------------------------- +module Miso.Subscription.RAF + ( rAFSub + , rAFSubElapsed + ) where +---------------------------------------------------------------------------- +import Control.Monad (void) +import Data.IORef +---------------------------------------------------------------------------- +import Miso.DSL +import Miso.Effect (Sub) +import Miso.Subscription.Util (createSub) +---------------------------------------------------------------------------- +-- | A 'Sub' for 60FPS animations when using 'requestAnimationFrame'. +-- +-- The 'Double' returned is a [DOMHighResTimeStamp](https://developer.mozilla.org/en-US/docs/Web/API/DOMHighResTimeStamp) expressed in milliseconds. +-- +rAFSub + :: (Double -> action) + -- ^ Callback fired each frame with a 'DOMHighResTimeStamp' in milliseconds + -> Sub action +rAFSub toAction sink = createSub acquire release sink + where + acquire = do + ref <- newIORef (error "rAFSub: uninitialized, impossible") + callback <- + syncCallback1 $ \jsval -> do + sink . toAction =<< fromJSValUnchecked jsval + void (requestAnimationFrame =<< readIORef ref) + + writeIORef ref callback + void (requestAnimationFrame callback) + pure callback + + release callback = freeFunction (Function callback) +---------------------------------------------------------------------------- +-- | Like 'rAFSub' but fires @action@ at most once per @interval@ milliseconds. +-- +-- Elapsed time is accumulated in 'IORef's inside the subscription so the +-- model is not touched between ticks β€” Miso only re-renders when a tick +-- actually fires, rather than on every animation frame. +-- +-- @ +-- app = defaultApp model update view +-- { subs = [ rAFSubElapsed 175 Tick ] } +-- @ +-- +rAFSubElapsed + :: Double + -- ^ Minimum interval between ticks in milliseconds (e.g. @175@ for ~6 fps) + -> action + -- ^ Action to dispatch each time the interval elapses + -> Sub action +rAFSubElapsed interval action sink = createSub acquire release sink + where + acquire = do + cbRef <- newIORef (error "rAFSubElapsed: uninitialized, impossible") + let go lastT elap = do + cb <- syncCallback1 $ \jsval -> do + t <- fromJSValUnchecked jsval + let dt = if lastT == 0 then 0 else min interval (t - lastT) + newElap = elap + dt + if newElap >= interval + then sink action *> go t (newElap - interval) + else go t newElap + writeIORef cbRef cb + void (requestAnimationFrame cb) + go 0 0 + pure cbRef + release cbRef = freeFunction . Function =<< readIORef cbRef +---------------------------------------------------------------------------- diff --git a/src/Miso/Subscription/Util.hs b/src/Miso/Subscription/Util.hs --- a/src/Miso/Subscription/Util.hs +++ b/src/Miso/Subscription/Util.hs @@ -8,6 +8,60 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.Subscription.Util" provides 'createSub', the building block used +-- by every subscription in "Miso.Subscription". It handles the +-- acquire-use-release lifecycle of an external resource (an event +-- listener, an animation-frame callback, etc.) using +-- 'Control.Exception.bracket' so the resource is always cleaned up when +-- the 'Miso.Types.Component' unmounts, even if an exception is thrown. +-- +-- = Quick start +-- +-- Use 'createSub' to build a custom subscription from any pair of +-- acquire\/release actions. The subscription sleeps between polls and +-- relies entirely on the acquire step to register whatever callbacks +-- deliver events to the sink: +-- +-- @ +-- import "Miso.Subscription.Util" ('createSub') +-- import "Miso.Effect" ('Sub') +-- import qualified "Miso.FFI.Internal" as FFI +-- +-- -- Custom subscription: fire an action whenever the window is resized +-- resizeSub :: (Int -> action) -> 'Sub' action +-- resizeSub toAction sink = 'createSub' acquire release sink +-- where +-- acquire = +-- FFI.'Miso.FFI.Internal.windowAddEventListener' \"resize\" $ \\_ -> do +-- w <- FFI.'Miso.FFI.Internal.windowInnerWidth' +-- sink (toAction w) +-- release cb = +-- FFI.'Miso.FFI.Internal.windowRemoveEventListener' \"resize\" cb +-- @ +-- +-- = How it works +-- +-- @'createSub' acquire release sink@ runs: +-- +-- @ +-- 'Control.Exception.bracket' acquire release (\\_ -> forever (threadDelay 10000_000_000)) +-- @ +-- +-- The @forever@ loop keeps the subscription thread alive by sleeping in +-- very long increments. All actual work is done inside callbacks +-- registered during @acquire@, which call @sink@ directly. @release@ is +-- guaranteed to run (via 'Control.Exception.bracket') when the component +-- teardown kills the thread. +-- +-- = See also +-- +-- * "Miso.Effect" β€” 'Miso.Effect.Sub', 'Miso.Effect.Sink' +-- * "Miso.FFI.Internal" β€” 'Miso.FFI.Internal.windowAddEventListener', +-- 'Miso.FFI.Internal.windowRemoveEventListener' +-- * "Miso.Subscription" β€” all built-in subscriptions ---------------------------------------------------------------------------- module Miso.Subscription.Util ( -- ** Utilities diff --git a/src/Miso/Subscription/Window.hs b/src/Miso/Subscription/Window.hs --- a/src/Miso/Subscription/Window.hs +++ b/src/Miso/Subscription/Window.hs @@ -9,6 +9,58 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.Subscription.Window" provides subscriptions that listen to +-- . +-- It also exposes 'windowSub' and 'windowSubWithOptions' as the generic +-- primitives on which 'Miso.Subscription.Mouse.mouseSub' and other +-- per-event wrappers are built. +-- +-- = Quick start +-- +-- @ +-- import "Miso" +-- import "Miso.Subscription.Window" +-- +-- data Action +-- = MouseMoved 'Miso.Canvas.Coord' -- (clientX, clientY) +-- | PointerMoved 'Miso.Event.Types.PointerEvent' -- full pointer data +-- +-- subs :: ['Miso.Effect.Sub' Action] +-- subs = +-- [ 'windowCoordsSub' MouseMoved -- simple (x, y) pair +-- , 'windowPointerMoveSub' PointerMoved -- full PointerEvent +-- ] +-- @ +-- +-- = Subscription variants +-- +-- * 'windowCoordsSub' β€” fires @(clientX, clientY)@ as a 'Miso.Canvas.Coord' +-- on every @pointermove@. Simplest option when only screen position is needed. +-- +-- * 'windowPointerMoveSub' β€” fires the full 'Miso.Event.Types.PointerEvent' +-- (pressure, tilt, pointer type, …) on every @pointermove@. +-- +-- * 'windowSub' β€” listen to __any named window event__ by providing an event +-- name and a 'Miso.Event.Decoder.Decoder': +-- +-- @ +-- resizeSub :: ('Miso.Canvas.Coord' -> action) -> 'Miso.Effect.Sub' action +-- resizeSub f = 'windowSub' \"resize\" 'Miso.Event.Decoder.emptyDecoder' (const (f (0,0))) +-- @ +-- +-- * 'windowSubWithOptions' β€” same as 'windowSub' but accepts +-- 'Miso.Event.Types.Options' to call @preventDefault@ or @stopPropagation@ +-- on the raw event before forwarding it. +-- +-- = See also +-- +-- * "Miso.Subscription.Mouse" β€” 'Miso.Subscription.Mouse.mouseSub' (thin alias over 'windowPointerMoveSub') +-- * "Miso.Event.Decoder" β€” 'Miso.Event.Decoder.Decoder', 'Miso.Event.Decoder.pointerDecoder' +-- * "Miso.Event.Types" β€” 'Miso.Event.Types.PointerEvent', 'Miso.Event.Types.Options' +-- * "Miso.Subscription.Util" β€” 'Miso.Subscription.Util.createSub' used internally ---------------------------------------------------------------------------- module Miso.Subscription.Window ( -- *** Subscription @@ -33,21 +85,35 @@ ----------------------------------------------------------------------------- -- | Captures window coordinates changes as they occur and writes them to -- an event sink. -windowCoordsSub :: (Coord -> action) -> Sub action +windowCoordsSub + :: (Coord -> action) + -- ^ Callback fired with @(clientX, clientY)@ on every @pointermove@ event + -> Sub action windowCoordsSub f = windowPointerMoveSub (f . client) ----------------------------------------------------------------------------- -- | @windowSub eventName decoder toAction@ provides a subscription -- to listen to [window level events](https://developer.mozilla.org/en-US/docs/Web/API/Window#events). -windowSub :: MisoString -> Decoder r -> (r -> action) -> Sub action +windowSub + :: MisoString + -- ^ DOM event name to listen for on @window@ (e.g. @\"resize\"@, @\"pointermove\"@) + -> Decoder r + -- ^ 'Decoder' for extracting a value from the raw event object + -> (r -> action) + -- ^ Callback fired with the decoded value on each event + -> Sub action windowSub = windowSubWithOptions defaultOptions ----------------------------------------------------------------------------- -- | @windowSubWithOptions options eventName decoder toAction@ provides a -- subscription to listen to [window level events](https://developer.mozilla.org/en-US/docs/Web/API/Window#events). windowSubWithOptions :: Options + -- ^ Propagation options (@preventDefault@, @stopPropagation@) -> MisoString + -- ^ DOM event name to listen for on @window@ -> Decoder result + -- ^ 'Decoder' for extracting a value from the raw event object -> (result -> action) + -- ^ Callback fired with the decoded value on each event -> Sub action windowSubWithOptions Options{..} eventName Decoder {..} toAction sink = createSub acquire release sink @@ -68,6 +134,9 @@ ----------------------------------------------------------------------------- -- | @window.addEventListener ("pointermove", (event) => handle(event))@ -- A 'Sub' to handle t'PointerEvent's on window. -windowPointerMoveSub :: (PointerEvent -> action) -> Sub action +windowPointerMoveSub + :: (PointerEvent -> action) + -- ^ Callback fired with the full 'PointerEvent' on every @pointermove@ + -> Sub action windowPointerMoveSub = windowSub "pointermove" pointerDecoder ----------------------------------------------------------------------------- diff --git a/src/Miso/Svg.hs b/src/Miso/Svg.hs --- a/src/Miso/Svg.hs +++ b/src/Miso/Svg.hs @@ -7,22 +7,49 @@ -- Stability : experimental -- Portability : non-portable -- --- Example usage: +-- = Overview -- +-- "Miso.Svg" is the re-export hub for miso's SVG DSL. It re-exports +-- "Miso.Svg.Element" (all SVG element constructors) and "Miso.Svg.Event" +-- (SVG-specific event handlers). +-- +-- SVG property\/attribute combinators live in "Miso.Svg.Property" and +-- must be imported separately when needed. +-- +-- = Quick start +-- +-- Embed an SVG circle inside a miso view: +-- -- @ --- import Miso --- import Miso.Svg +-- import "Miso" +-- import "Miso.Svg" +-- import qualified "Miso.Svg.Property" as SP -- --- view_ :: Int -> View Int action --- view_ n = svg_ [ height_ "100", width "100" ] [ --- circle_ [ cx_ "50", cy_ "50", r_ "40", stroke_ "green", strokeWidth_ "4", fill_ "yellow" ] [] --- ] +-- badge :: 'Miso.Types.View' model action +-- badge = +-- 'svg_' [ SP.'Miso.Svg.Property.width_' \"100\", SP.'Miso.Svg.Property.height_' \"100\" ] +-- [ 'circle_' +-- [ SP.'Miso.Svg.Property.cx_' \"50\", SP.'Miso.Svg.Property.cy_' \"50\" +-- , SP.'Miso.Svg.Property.r_' \"40\" +-- , SP.'Miso.Svg.Property.stroke_' \"green\" +-- , SP.'Miso.Svg.Property.strokeWidth_' \"4\" +-- , SP.'Miso.Svg.Property.fill_' \"yellow\" +-- ] +-- ] -- @ -- --- More information on how to use miso is available on GitHub +-- = Modules -- --- +-- * "Miso.Svg.Element" β€” SVG element constructors (@svg_@, @circle_@, @path_@, @g_@, …) +-- * "Miso.Svg.Event" β€” SVG event handlers (@onBegin@, @onEnd@, @onClick@, …) +-- * "Miso.Svg.Property" β€” SVG attribute combinators (@cx_@, @r_@, @fill_@, @stroke_@, …) +-- /(not re-exported here β€” import separately)/ -- +-- = See also +-- +-- * "Miso.Html.Element" β€” HTML element constructors +-- * "Miso.Mathml.Element" β€” MathML element constructors +-- * ---------------------------------------------------------------------------- module Miso.Svg ( -- ** Element diff --git a/src/Miso/Svg/Element.hs b/src/Miso/Svg/Element.hs --- a/src/Miso/Svg/Element.hs +++ b/src/Miso/Svg/Element.hs @@ -8,6 +8,76 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.Svg.Element" provides smart constructors for every element in the +-- +-- vocabulary. All nodes are created in the @SVG@ namespace via +-- @document.createElementNS(\"http:\/\/www.w3.org\/2000\/svg\", …)@. +-- This module is re-exported in its entirety by "Miso.Svg". +-- +-- __Leaf elements__ (shapes, images, stops, …) omit the children argument: +-- +-- @ +-- circle_ :: ['Miso.Types.Attribute' action] -> 'Miso.Types.View' model action +-- @ +-- +-- __Container elements__ accept both attributes and children: +-- +-- @ +-- g_ :: ['Miso.Types.Attribute' action] -> ['Miso.Types.View' model action] -> 'Miso.Types.View' model action +-- @ +-- +-- = Quick start +-- +-- @ +-- import "Miso" +-- import "Miso.Svg" +-- import qualified "Miso.Svg.Property" as SP +-- +-- logo :: 'Miso.Types.View' model action +-- logo = +-- 'svg_' [ SP.'Miso.Svg.Property.viewBox_' \"0 0 200 200\", SP.'Miso.Svg.Property.width_' \"200\" ] +-- [ 'g_' [ SP.'Miso.Svg.Property.fill_' \"none\", SP.'Miso.Svg.Property.stroke_' \"black\" ] +-- [ 'circle_' [ SP.'Miso.Svg.Property.cx_' \"100\", SP.'Miso.Svg.Property.cy_' \"100\", SP.'Miso.Svg.Property.r_' \"80\" ] +-- , 'line_' [ SP.'Miso.Svg.Property.x1_' \"20\", SP.'Miso.Svg.Property.y1_' \"100\" +-- , SP.'Miso.Svg.Property.x2_' \"180\", SP.'Miso.Svg.Property.y2_' \"100\" ] +-- ] +-- , 'text_' [ SP.'Miso.Svg.Property.x_' \"100\", SP.'Miso.Svg.Property.y_' \"110\" +-- , SP.'Miso.Svg.Property.textAnchor_' \"middle\" ] +-- [ 'Miso.text' \"miso\" ] +-- ] +-- @ +-- +-- = Element groups +-- +-- * __Root__: 'svg_' +-- * __Graphics__ (leaf): 'circle_', 'ellipse_', 'image_', 'line_', +-- 'path_', 'polygon_', 'polyline_', 'rect_', 'use_' +-- * __Animation__: 'animate_', 'animateMotion_', 'animateTransform_', +-- 'mpath_', 'set_' +-- * __Descriptive__: 'desc_', 'metadata_', 'title_' +-- * __Containers__: 'defs_', 'g_', 'marker_', 'mask_', 'pattern_', +-- 'switch_', 'symbol_' +-- * __Text__: 'text_', 'textPath_', 'tspan_' +-- * __Gradients__: 'linearGradient_', 'radialGradient_', 'stop_' +-- * __Filters__: 'feBlend_', 'feColorMatrix_', 'feComponentTransfer_', +-- 'feComposite_', 'feConvolveMatrix_', 'feDiffuseLighting_', +-- 'feDisplacementMap_', 'feDropShadow_', 'feFlood_', +-- 'feFuncA_', 'feFuncB_', 'feFuncG_', 'feFuncR_', +-- 'feGaussianBlur_', 'feImage_', 'feMerge_', 'feMergeNode_', +-- 'feMorphology_', 'feOffset_', 'feSpecularLighting_', +-- 'feTile_', 'feTurbulence_' +-- * __Light sources__: 'feDistantLight_', 'fePointLight_', 'feSpotLight_' +-- * __Misc__: 'foreignObject_', 'clipPath_', 'filter_', 'script_', +-- 'style_', 'view_' +-- +-- = See also +-- +-- * "Miso.Svg.Property" β€” SVG attribute combinators (@cx_@, @r_@, @fill_@, …) +-- * "Miso.Svg.Event" β€” SVG event handlers +-- * "Miso.Html.Element" β€” HTML element constructors ---------------------------------------------------------------------------- module Miso.Svg.Element ( -- *** SVG diff --git a/src/Miso/Svg/Event.hs b/src/Miso/Svg/Event.hs --- a/src/Miso/Svg/Event.hs +++ b/src/Miso/Svg/Event.hs @@ -6,12 +6,67 @@ {-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | --- Module : Miso.Svg.Events +-- Module : Miso.Svg.Event -- Copyright : (C) 2016-2026 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.Svg.Event" provides event-handler 'Miso.Types.Attribute' values +-- for SVG-specific DOM events. All handlers use 'Miso.Event.emptyDecoder' +-- β€” they fire a fixed action with no payload extracted from the event +-- object. This module is re-exported by "Miso.Svg". +-- +-- For pointer and keyboard events on SVG elements, use the handlers from +-- "Miso.Html.Event" directly β€” they work on any DOM element regardless of +-- namespace. +-- +-- = Quick start +-- +-- @ +-- import "Miso" +-- import "Miso.Svg" +-- +-- data Action = AnimDone | Zoomed +-- +-- view :: Model -> 'Miso.Types.View' Model Action +-- view _ = +-- 'svg_' [] +-- [ 'animate_' +-- [ 'onEnd' AnimDone +-- , 'onZoom' Zoomed +-- ] +-- , 'circle_' +-- [ 'onClick' Toggle +-- , 'onMouseOver' Highlight +-- ] +-- ] +-- @ +-- +-- = Event groups +-- +-- * __Animation__ (@\@, @\@, …): +-- 'onBegin', 'onEnd', 'onRepeat' +-- +-- * __Document__ (fires on @\@ root): +-- 'onAbort', 'onError', 'onResize', 'onScroll', 'onZoom' +-- +-- * __Graphical__ (fires on any visible SVG element): +-- 'onActivate', 'onClick', 'onFocusIn', 'onFocusOut', +-- 'onMouseDown', 'onMouseMove', 'onMouseOut', 'onMouseOver', 'onMouseUp' +-- +-- Note: 'onClick' is re-exported from "Miso.Html.Event" and is identical +-- to the HTML version. +-- +-- = See also +-- +-- * "Miso.Html.Event" β€” 'Miso.Html.Event.onPointerDown', 'Miso.Html.Event.onKeyDown', … +-- work on SVG elements too +-- * "Miso.Svg.Element" β€” SVG element constructors +-- * "Miso.Event" β€” 'Miso.Event.on', 'Miso.Event.emptyDecoder' primitives ---------------------------------------------------------------------------- module Miso.Svg.Event ( -- *** Animation diff --git a/src/Miso/Svg/Property.hs b/src/Miso/Svg/Property.hs --- a/src/Miso/Svg/Property.hs +++ b/src/Miso/Svg/Property.hs @@ -9,8 +9,105 @@ -- Stability : experimental -- Portability : non-portable -- --- +-- = Overview -- +-- "Miso.Svg.Property" provides 'Miso.Types.Attribute' smart constructors +-- for all +-- . +-- Every combinator takes a 'Miso.String.MisoString' value and produces an +-- 'Miso.Types.Attribute' that is set on the SVG element by the virtual DOM. +-- +-- This module is __not__ re-exported by "Miso.Svg" and must be imported +-- separately. Qualify it to avoid clashing with same-named combinators +-- from "Miso.Html.Property": +-- +-- @ +-- import qualified "Miso.Svg.Property" as SP +-- @ +-- +-- = Quick start +-- +-- @ +-- import "Miso.Svg" +-- import qualified "Miso.Svg.Property" as SP +-- +-- arrow :: 'Miso.Types.View' model action +-- arrow = +-- 'Miso.Svg.Element.svg_' [ SP.'viewBox_' \"0 0 100 100\", SP.'width_' \"100\" ] +-- [ 'Miso.Svg.Element.path_' +-- [ SP.'d_' \"M 10 50 L 90 50 M 70 30 L 90 50 L 70 70\" +-- , SP.'stroke_' \"black\" +-- , SP.'strokeWidth_' \"4\" +-- , SP.'fill_' \"none\" +-- , SP.'strokeLinecap_' \"round\" +-- ] +-- ] +-- @ +-- +-- = Attribute groups +-- +-- * __Geometry__: 'cx_', 'cy_', 'r_', 'rx_', 'ry_', 'x_', 'y_', +-- 'x1_', 'y1_', 'x2_', 'y2_', 'width_', 'height_', 'd_', 'points_', +-- 'viewBox_', 'preserveAspectRatio_', 'pathLength_', 'textLength_' +-- +-- * __Paint__: 'fill_', 'fillOpacity_', 'fillRule_', 'stroke_', +-- 'strokeWidth_', 'strokeOpacity_', 'strokeDasharray_', +-- 'strokeDashoffset_', 'strokeLinecap_', 'strokeLinejoin_', +-- 'strokeMiterlimit_', 'color_', 'opacity_', 'stopColor_', 'stopOpacity_' +-- +-- * __Transform__: 'transform_', 'transformOrigin_', 'gradientTransform_', +-- 'patternTransform_', 'rotate_', 'scale_' +-- +-- * __Text__: 'textAnchor_', 'textDecoration_', 'textRendering_', +-- 'fontFamily_', 'fontSize_', 'fontSizeAdjust_', 'fontStyle_', +-- 'fontVariant_', 'fontWeight_', 'letterSpacing_', 'wordSpacing_', +-- 'direction_', 'writingMode_', 'unicodeBidi_', 'dominantBaseline_', +-- 'alignmentBaseline_', 'baselineShift_', 'dx_', 'dy_' +-- +-- * __Gradients__: 'gradientUnits_', 'spreadMethod_', 'fr_', 'fx_', 'fy_', +-- 'offset_', 'x1_', 'y1_', 'x2_', 'y2_' +-- +-- * __Filters__: 'in_\'', 'in2_', 'result_', 'mode_', 'operator_', +-- 'order_', 'kernelMatrix_', 'edgeMode_', 'stdDeviation_', +-- 'bias_', 'divisor_', 'amplitude_', 'exponent_', 'intercept_', +-- 'slope_', 'tableValues_', 'numOctaves_', 'seed_', 'baseFrequency_', +-- 'stitchTiles_', 'filterUnits_', 'primitiveUnits_', +-- 'diffuseConstant_', 'specularConstant_', 'specularExponent_', +-- 'surfaceScale_', 'azimuth_', 'elevation_', 'pointsAtX_', +-- 'pointsAtY_', 'pointsAtZ_', 'limitingConeAngle_', 'k1_', +-- 'k2_', 'k3_', 'k4_', 'xChannelSelector_', 'yChannelSelector_', +-- 'preserveAlpha_', 'radius_', 'scale_' +-- +-- * __Markers__: 'markerHeight_', 'markerWidth_', 'markerUnits_', +-- 'markerEnd_', 'markerMid_', 'markerStart_', 'orient_', 'refX_', 'refY_' +-- +-- * __Masks \/ Clips__: 'maskContentUnits_', 'maskUnits_', 'mask_', +-- 'clipPath_', 'clipRule_', 'clipPathUnits_' +-- +-- * __Pattern__: 'patternContentUnits_', 'patternUnits_' +-- +-- * __Animation__: 'begin_', 'dur_', 'end_', 'by_', 'from_', 'to_', +-- 'values_', 'calcMode_', 'keyTimes_', 'keySplines_', 'keyPoints_', +-- 'repeatCount_', 'repeatDur_', 'restart_', 'additive_', +-- 'accumulate_', 'attributeName_', 'type_\'', 'path_' +-- +-- * __Misc__: 'cursor_', 'display_', 'filter_', 'imageRendering_', +-- 'lightingColor_', 'overflow_', 'paintOrder_', 'pointerEvents_', +-- 'shapeRendering_', 'vectorEffect_', 'visibility_', +-- 'colorInterpolation_', 'colorInterpolationFilters_', +-- 'floodColor_', 'floodOpacity_', 'crossorigin_', 'decoding_', +-- 'media_', 'method_', 'side_', 'spacing_', 'startOffset_', +-- 'systemLanguage_', 'target_', 'targetX_', 'targetY_', 'z_' +-- +-- __Note__: Two SVG attributes clash with Haskell keywords and are given +-- disambiguated names: @'in_\''@ (for the @in@ attribute) and @'type_\''@ +-- (for the @type@ attribute). +-- +-- = See also +-- +-- * "Miso.Svg.Element" β€” SVG element constructors +-- * "Miso.Html.Property" β€” HTML property combinators (different namespace) +-- * ---------------------------------------------------------------------------- module Miso.Svg.Property ( -- *** Regular Attributes @@ -69,6 +166,7 @@ , min_ , mode_ , numOctaves_ + , offset_ , operator_ , order_ , orient_ @@ -418,6 +516,10 @@ -- | [numOctaves](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/numOctaves) attribute numOctaves_ :: MisoString -> Attribute action numOctaves_ = attr "numOctaves" +----------------------------------------------------------------------------- +-- | [offset](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/stop) attribute +offset_ :: MisoString -> Attribute action +offset_ = attr "offset" ----------------------------------------------------------------------------- -- | [operator](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/operator) attribute operator_ :: MisoString -> Attribute action diff --git a/src/Miso/Types.hs b/src/Miso/Types.hs --- a/src/Miso/Types.hs +++ b/src/Miso/Types.hs @@ -16,6 +16,8 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wno-orphans #-} +----------------------------------------------------------------------------- -- | -- Module : Miso.Types -- Copyright : (C) 2016-2026 David M. Johnson @@ -24,7 +26,105 @@ -- Stability : experimental -- Portability : non-portable -- --- Core types for Miso applications. +-- = Overview +-- +-- "Miso.Types" defines every core type that miso applications are built +-- from. It is re-exported in its entirety by "Miso", so most application +-- code never needs to import it directly. +-- +-- = The Component record +-- +-- @'Component' parent props model action@ is the central record type. It +-- wires together the MVU loop and all supporting runtime configuration: +-- +-- @ +-- data 'Component' parent props model action = Component +-- { model :: model +-- , hydrateModel :: Maybe (IO model) +-- , update :: action -> 'Miso.Effect.Effect' parent props model action +-- , view :: props -> model -> 'View' model action +-- , subs :: ['Miso.Effect.Sub' action] +-- , styles :: ['CSS'] +-- , scripts :: ['JS'] +-- , mountPoint :: Maybe 'MountPoint' +-- , logLevel :: 'LogLevel' +-- , mailbox :: Value -> Maybe action +-- , bindings :: ['Miso.Binding.Binding' parent model] +-- , eventPropagation :: Bool +-- , mount :: Maybe action +-- , unmount :: Maybe action +-- , onPropsChanged :: Maybe (props -> props -> action) +-- } +-- @ +-- +-- Use the 'component' smart constructor to build one with sane defaults, +-- then override only the fields you need: +-- +-- @ +-- myApp :: 'App' Model Action +-- myApp = ('component' initialModel update view) +-- { 'subs' = [ mySub ] +-- , 'styles' = [ 'Href' \"style.css\" False ] +-- } +-- @ +-- +-- = The View type +-- +-- @'View' model action@ is miso's virtual DOM tree. Its four constructors +-- map to the four node kinds the runtime handles: +-- +-- * 'VNode' β€” a regular DOM element (@\@, @\@, …) +-- * 'VText' β€” a text node +-- * 'VComp' β€” an embedded child 'Component' +-- * 'VFrag' β€” a keyless group of siblings (no wrapper element) +-- +-- = Key types at a glance +-- +-- ['Component'] full MVU application\/component record +-- ['App'] alias for @'Component' 'ROOT' () model action@ +-- ['ROOT'] phantom type marking a top-level component +-- ['View'] virtual DOM node +-- ['Attribute'] DOM property, class list, event handler, or style +-- ['Namespace'] @HTML@ \| @SVG@ \| @MATHML@ +-- ['Key'] reconciliation hint for list diffing +-- ['CSS'] stylesheet reference (@Href@, @Style@, @Sheet@) +-- ['JS'] script reference (@Src@, @Script@, @Module@, …) +-- ['LogLevel'] debug verbosity (@Off@, @DebugHydrate@, …) +-- ['URI'] parsed URL (path + query string + fragment) +-- +-- = Text combinators +-- +-- * 'text' β€” create a text node (HTML-escaped in SSR mode) +-- * 'textRaw' β€” create a text node without HTML escaping +-- * 'text_' β€” concatenate a list of strings with a space separator +-- * 'textKey' / 'textKey_' β€” keyed variants for efficient list diffing +-- * 'htmlEncode' β€” manually escape @< > & \" \'@ +-- +-- = Component mounting +-- +-- * @\"key\" '+>' comp@ β€” mount a child component with a key +-- * 'mount_' β€” mount without a key (unsafe in dynamic lists) +-- * 'mountWithProps' / 'mountWithProps_' β€” mount with explicit @props@ +-- +-- = Fragment and keyed combinators +-- +-- * 'fragment' / 'vfrag' β€” group siblings without a wrapper element +-- * 'fragment_' / 'vfrag_' β€” keyed fragment +-- * 'keyed' β€” attach a reconciliation key to any 'View' +-- +-- = Conditional view utilities +-- +-- * 'optionalAttrs' β€” add attributes conditionally +-- * 'optionalVoidAttrs' β€” same for void (no-children) elements +-- * 'optionalChildren' β€” add children conditionally +-- +-- = See also +-- +-- * "Miso.Effect" β€” 'Miso.Effect.Effect', 'Miso.Effect.Sub', 'Miso.Effect.Sink' +-- * "Miso.Html.Element" β€” element smart constructors built on 'node' +-- * "Miso.Html.Property" β€” attribute constructors built on 'Attribute' +-- * "Miso.Html.Render" β€” SSR serialisation via 'Miso.Html.Render.ToHtml' +-- * "Miso.Router" β€” 'Miso.Router.URI' parsing and pretty-printing ---------------------------------------------------------------------------- module Miso.Types ( -- ** Types @@ -172,23 +272,28 @@ -- ^ action to execute during t'Miso.Types.Component' unmount phase. -- -- @since 1.9.0.0 + , onPropsChanged :: Maybe (props -> props -> action) + -- ^ action to execute when 'Component' @props@ have changed (a.k.a. @props@ phase). + -- Receives previous @props@ and current @props@ as arguments. + -- + -- @since 1.11.0.0 } ----------------------------------------------------------------------------- -- | @mountPoint@ for t'Miso.Types.Component', e.g "body" type MountPoint = MisoString ----------------------------------------------------------------------------- --- | Allow users to express CSS and append it to \ before the first draw +-- | Allow users to express 'CSS' and append it to \ before the first draw -- --- > Href "http://domain.com/style.css" (True :: CacheBust) --- > Style "body { background-color: red; }" +-- > 'Href' "http://domain.com/style.css" ('True' :: 'CacheBust') +-- > 'Style' "body { background-color: red; }" -- data CSS = Href MisoString CacheBust - -- ^ URL linking to hosted CSS + -- ^ 'URL' linking to hosted 'CSS' | Style MisoString - -- ^ Raw CSS content in a 'Miso.Html.Element.style_' tag + -- ^ Raw 'CSS' content in a 'Miso.Html.Element.style_' tag | Sheet StyleSheet - -- ^ CSS built with 'Miso.CSS' + -- ^ 'CSS' built with "Miso.CSS" deriving (Show, Eq) ----------------------------------------------------------------------------- -- | Parameter used to indicate cache busting logic should be used. @@ -197,15 +302,15 @@ -- type CacheBust = Bool ----------------------------------------------------------------------------- --- | Allow users to express JS and append it to before the first draw +-- | Allow users to express JS and append it to \ before the first draw -- -- This is meant to be useful in development only. -- -- @ --- Src \"http:\/\/example.com\/script.js\" (False :: CacheBust) --- Script "alert(\"hi\");" --- ImportMap [ "key" =: "value" ] --- Module "console.log(\"hi\");" +-- 'Src' \"http:\/\/example.com\/script.js\" ('False' :: 'CacheBust') +-- 'Script' "alert(\"hi\");" +-- 'ImportMap' [ "key" '=:' "value" ] +-- 'Module' "console.log(\"hi\");" -- @ -- -- @since 1.9.0.0 @@ -250,6 +355,7 @@ , eventPropagation = False , mount = Nothing , unmount = Nothing + , onPropsChanged = Nothing } ----------------------------------------------------------------------------- -- | Synonym for 'component' @@ -554,8 +660,10 @@ -- | Virtual DOM implemented as a JavaScript t'Object'. -- Used for diffing, patching and event delegation. -- Not meant to be constructed directly, see t'Miso.Types.View' instead. -newtype VTree = VTree { getTree :: Object } - deriving newtype (ToObject, ToJSVal) +newtype VTree = VTree + { getTree :: Object + -- ^ Underlying JavaScript object representing the virtual DOM tree + } deriving newtype (ToObject, ToJSVal) ----------------------------------------------------------------------------- -- | Create a new 'Miso.Types.VNode'. -- @@ -564,9 +672,13 @@ -- the node is created and its children are initialized to @children@. node :: Namespace + -- ^ Element namespace (@HTML@, @SVG@, or @MATHML@) -> MisoString + -- ^ Tag name (e.g. @\"div\"@, @\"circle\"@) -> [Attribute action] + -- ^ Attributes, properties, and event handlers -> [View model action] + -- ^ Child nodes -> View model action node = VNode ----------------------------------------------------------------------------- @@ -576,9 +688,13 @@ -- vnode :: Namespace + -- ^ Element namespace (@HTML@, @SVG@, or @MATHML@) -> MisoString + -- ^ Tag name (e.g. @\"div\"@, @\"circle\"@) -> [Attribute action] + -- ^ Attributes, properties, and event handlers -> [View model action] + -- ^ Child nodes -> View model action vnode = node ----------------------------------------------------------------------------- @@ -729,8 +845,12 @@ -- data URI = URI - { uriPath, uriFragment :: MisoString + { uriPath :: MisoString + -- ^ Path component, e.g. @\"users\/42\"@ + , uriFragment :: MisoString + -- ^ Fragment identifier (without the leading @#@), e.g. @\"section-1\"@ , uriQueryString :: M.Map MisoString (Maybe MisoString) + -- ^ Query parameters. @'Just' v@ for @?key=v@ pairs; 'Nothing' for bare flags (@?flag@). } deriving stock (Show, Eq, Generic) deriving anyclass (ToJSVal, ToObject) ---------------------------------------------------------------------------- @@ -740,6 +860,9 @@ ---------------------------------------------------------------------------- instance ToMisoString URI where toMisoString = prettyURI +---------------------------------------------------------------------------- +instance ToJSON URI where + toJSON = toJSON . toMisoString ---------------------------------------------------------------------------- -- | Pretty-prints a t'URI'. prettyURI :: URI -> MisoString diff --git a/src/Miso/Util.hs b/src/Miso/Util.hs --- a/src/Miso/Util.hs +++ b/src/Miso/Util.hs @@ -7,7 +7,54 @@ -- Stability : experimental -- Portability : non-portable -- --- Utility functions for views, parsing, and general purpose combinators. +-- = Overview +-- +-- "Miso.Util" provides general-purpose combinators shared across miso's +-- internal modules and available to application code. It is re-exported +-- by "Miso". +-- +-- = View helpers +-- +-- * 'withFoldable' β€” @map@ over any 'Foldable' to produce a list of +-- views; particularly handy for @Maybe@: +-- +-- @ +-- 'withFoldable' (model ^. mAlert) $ \\msg -> +-- 'Miso.Html.Element.div_' [ 'Miso.Html.Property.class_' \"alert\" ] [ 'Miso.text' msg ] +-- @ +-- +-- * 'conditionalViews' β€” include a list of views only when a condition +-- is 'True'; returns @[]@ otherwise: +-- +-- @ +-- 'conditionalViews' isLoggedIn +-- [ 'Miso.Html.Element.button_' [ 'Miso.Html.Event.onClick' Logout ] [ 'Miso.text' \"Log out\" ] ] +-- @ +-- +-- = Parser \/ lexer combinators +-- +-- These 'Control.Applicative.Alternative'-polymorphic combinators work +-- with both 'Miso.Util.Lexer.Lexer' and 'Miso.Util.Parser.Parser': +-- +-- * 'oneOf' β€” try alternatives in order, succeeding on the first match +-- (analogous to 'Data.Foldable.asum') +-- * 'sepBy' / 'sepBy1' β€” parse a list interleaved with a separator +-- * 'enclosed' β€” parse something between two delimiters (@l *> x \<* r@) +-- * 'between' β€” parse two things separated by a third, returning a pair +-- * 'optionalDefault' β€” parse with a fallback default on failure +-- * 'exists' β€” test whether a combinator succeeds, returning 'Bool' +-- +-- = Miscellaneous +-- +-- * '(=:)' β€” infix tuple constructor for key-value pairs: +-- @\"key\" '=:' value@ +-- * 'compose' β€” forward function composition generalised to any +-- 'Control.Category.Category': @f \`compose\` g = g . f@ +-- +-- = See also +-- +-- * "Miso.Util.Lexer" β€” the 'Miso.Util.Lexer.Lexer' combinator library +-- * "Miso.Util.Parser" β€” the 'Miso.Util.Parser.Parser' combinator library ---------------------------------------------------------------------------- module Miso.Util ( withFoldable @@ -39,13 +86,24 @@ -- withFoldable (model ^. mSomeMaybeVal) $ \\someVal -> -- p_ [] [ text $ "Hey, look at this value: " <> ms (show someVal) ] -- @ -withFoldable :: Foldable t => t a -> (a -> b) -> [b] +withFoldable + :: Foldable t + => t a + -- ^ Container to map over (e.g. @Maybe@, @[]@) + -> (a -> b) + -- ^ Function to apply to each element + -> [b] withFoldable ta f = map f (toList ta) ----------------------------------------------------------------------------- -- | Conditionally includes views. -- Hides the 'Miso.Types.View's if the condition is False. Shows them when the condition -- is True. -conditionalViews :: Bool -> [view] -> [view] +conditionalViews + :: Bool + -- ^ When 'True' the views are included; when 'False' an empty list is returned + -> [view] + -- ^ Views to include conditionally + -> [view] conditionalViews condition views = if condition then views @@ -61,7 +119,15 @@ -- test :: Parser a -> Parser a -- test = enclosed (char '(') (char ')') -- @ -enclosed :: Applicative f => f a -> f b -> f c -> f c +enclosed + :: Applicative f + => f a + -- ^ Opening delimiter (e.g. @char '('@) + -> f b + -- ^ Closing delimiter (e.g. @char ')'@) + -> f c + -- ^ Inner parser\/lexer whose result is returned + -> f c enclosed l r x = l *> x <* r ---------------------------------------------------------------------------- -- | Allow the specification of default values during parsing / lexing @@ -71,7 +137,13 @@ -- test :: Parser MisoString -- test = optionalDefault "foo" (string "bar") -- @ -optionalDefault :: Alternative f => b -> f b -> f b +optionalDefault + :: Alternative f + => b + -- ^ Default value to use when the parser\/lexer fails + -> f b + -- ^ Parser\/lexer to attempt + -> f b optionalDefault def p = fromMaybe def <$> optional p ---------------------------------------------------------------------------- -- | Combinator for testing parsing / lexing failure on any input. @@ -90,7 +162,13 @@ -- test :: Parser [Int] -- test = sepBy1 (char ',') number -- @ -sepBy1 :: Alternative m => m sep -> m a -> m [a] +sepBy1 + :: Alternative m + => m sep + -- ^ Separator parser\/lexer (result discarded) + -> m a + -- ^ Element parser\/lexer + -> m [a] sepBy1 sep p = (:) <$> p <*> many (sep *> p) ---------------------------------------------------------------------------- -- | Interleaves one parser combinator with another, may not have any successful @@ -100,7 +178,13 @@ -- test :: Parser [Int] -- test = sepBy (char ',') number -- @ -sepBy :: Alternative m => m sep -> m a -> m [a] +sepBy + :: Alternative m + => m sep + -- ^ Separator parser\/lexer (result discarded) + -> m a + -- ^ Element parser\/lexer + -> m [a] sepBy sep p = sepBy1 sep p <|> pure [] ---------------------------------------------------------------------------- -- | Successfully parses the arguments between another combinator @@ -110,7 +194,15 @@ -- test = between (char '*') number number -- -- 5*5 -- @ -between :: Applicative f => f a -> f b -> f c -> f (b, c) +between + :: Applicative f + => f a + -- ^ Separator between the two elements (result discarded) + -> f b + -- ^ Left element parser\/lexer + -> f c + -- ^ Right element parser\/lexer + -> f (b, c) between c l r = (,) <$> l <*> (c *> r) ---------------------------------------------------------------------------- -- | Tuple constructor, useful for constructing key-value pairs. diff --git a/src/Miso/Util/Lexer.hs b/src/Miso/Util/Lexer.hs --- a/src/Miso/Util/Lexer.hs +++ b/src/Miso/Util/Lexer.hs @@ -2,11 +2,76 @@ ----------------------------------------------------------------------------- -- | -- Module : Miso.Util.Lexer --- Copyright : (C) 2016-2026 David M. Johnson (@dmjio) +-- Copyright : (C) 2016-2026 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.Util.Lexer" is an internal lexer combinator library used by +-- miso's JSON pipeline ("Miso.JSON.Lexer") and URI\/router tokeniser +-- ("Miso.Router"). It is __not__ designed for general application use, +-- but is exposed for downstream code that needs to build custom lexers. +-- +-- The central type is 'Lexer': +-- +-- @ +-- newtype 'Lexer' token = Lexer +-- { 'runLexer' :: 'Stream' -> Either 'LexerError' (token, 'Stream') } +-- @ +-- +-- 'Lexer' is a 'Monad', 'Alternative', and 'MonadFail'. Its +-- 'Control.Applicative.Alternative' instance implements the +-- /maximal munch/ rule: when both branches succeed, the one that +-- consumes the most input wins. +-- +-- = Key types +-- +-- * 'Stream' β€” the remaining input text together with a 'Location' +-- (line and column) cursor. +-- * 'Location' β€” @{line :: Int, column :: (Int, Int)}@, used in error +-- messages and 'Located' tokens. +-- * 'Located' token β€” a lexed value paired with the 'Location' at which +-- it was recognised. +-- * 'LexerError' β€” either @LexerError MisoString Location@ (unexpected +-- input) or @UnexpectedEOF Location@ (ran out of input). +-- +-- = Primitive combinators +-- +-- @ +-- 'satisfy' :: (Char -> Bool) -> 'Lexer' Char -- consume one matching char +-- 'char' :: Char -> 'Lexer' Char -- consume a specific char +-- 'string' :: 'Miso.String.MisoString' -> 'Lexer' 'Miso.String.MisoString' -- consume a literal prefix +-- 'string'' :: String -> 'Lexer' String -- same for 'String' +-- 'peek' :: 'Lexer' (Maybe Char) -- look ahead without consuming +-- 'oops' :: 'Lexer' token -- always fails +-- @ +-- +-- = Stream and location access +-- +-- @ +-- 'getInput' :: 'Lexer' 'Stream' +-- 'putInput' :: 'Stream' -> 'Lexer' () +-- 'modifyInput' :: ('Stream' -> 'Stream') -> 'Lexer' () +-- 'getLocation' :: 'Lexer' 'Location' +-- 'setLocation' :: 'Location' -> 'Lexer' () +-- @ +-- +-- = Running a lexer +-- +-- @ +-- 'runLexer' :: 'Lexer' token -> 'Stream' -> Either 'LexerError' (token, 'Stream') +-- 'mkStream' :: 'Miso.String.MisoString' -> 'Stream' -- create initial stream +-- @ +-- +-- = See also +-- +-- * "Miso.Util.Parser" β€” parser combinator library that consumes 'Lexer' output +-- * "Miso.JSON.Lexer" β€” JSON tokeniser built on this module +-- * "Miso.Router" β€” URI tokeniser built on this module +-- * "Miso.Util" β€” higher-level 'Miso.Util.sepBy', 'Miso.Util.oneOf', … ---------------------------------------------------------------------------- module Miso.Util.Lexer ( -- ** Types @@ -60,7 +125,9 @@ data Location = Location { line :: Int + -- ^ Current line number (1-based) , column :: (Int,Int) + -- ^ @(start, end)@ column offsets for the current token (1-based) } deriving Eq ---------------------------------------------------------------------------- instance Show Location where @@ -83,6 +150,7 @@ newtype Lexer token = Lexer { runLexer :: Stream -> Either LexerError (token, Stream) + -- ^ Run the lexer against a 'Stream'; returns the token and remaining input, or a 'LexerError' } ---------------------------------------------------------------------------- -- | Combinator that always fails to lex @@ -90,11 +158,17 @@ oops = Lexer $ \s -> Left (streamError s) ---------------------------------------------------------------------------- -- | Smart constructor for t'LexerError' -streamError :: Stream -> LexerError +streamError + :: Stream + -- ^ The stream at the point of failure; used to populate the error location + -> LexerError streamError (Stream xs l) = unexpected xs l ---------------------------------------------------------------------------- -- | Smart constructor for t'Stream' -mkStream :: MisoString -> Stream +mkStream + :: MisoString + -- ^ Input text to lex + -> Stream mkStream xs = Stream xs initialLocation ---------------------------------------------------------------------------- -- | A t'Stream' of text used as input to lexing @@ -111,7 +185,9 @@ data Located token = Located { token :: token + -- ^ The lexed token value , location :: Location + -- ^ 'Location' in the source at which this token was recognised } deriving Eq ---------------------------------------------------------------------------- instance Show token => Show (Located token) where @@ -161,7 +237,10 @@ Just (z,zs) -> (Just z, Stream (MS.singleton z <> zs) l) ---------------------------------------------------------------------------- -- | Predicate combinator that consumes matching input -satisfy :: (Char -> Bool) -> Lexer Char +satisfy + :: (Char -> Bool) + -- ^ Predicate; the next character is consumed only if this returns 'True' + -> Lexer Char satisfy predicate = Lexer $ \ys -> case ys of Stream s l -> @@ -182,7 +261,10 @@ getInput = Lexer $ \s -> Right (s, s) ---------------------------------------------------------------------------- -- | Overrides current t'Stream' in t'Lexer' to user-specified t'Stream'. -putInput :: Stream -> Lexer () +putInput + :: Stream + -- ^ Replacement stream; replaces the current lexer input + -> Lexer () putInput s = Lexer $ \_ -> Right ((), s) ---------------------------------------------------------------------------- -- | Retrieves the current t'Stream' t'Location' @@ -190,25 +272,40 @@ getLocation = Lexer $ \(Stream s l) -> pure (l, Stream s l) ---------------------------------------------------------------------------- -- | Sets the current t'Stream' t'Location' -setLocation :: Location -> Lexer () +setLocation + :: Location + -- ^ New location to record in the stream cursor + -> Lexer () setLocation l = Lexer $ \(Stream s _) -> pure ((), Stream s l) ---------------------------------------------------------------------------- -- | Modifies a t'Stream' -modifyInput :: (Stream -> Stream) -> Lexer () +modifyInput + :: (Stream -> Stream) + -- ^ Transform to apply to the current lexer input + -> Lexer () modifyInput f = do s <- getInput putInput (f s) ---------------------------------------------------------------------------- -- | Lexer combinator for matching a 'Char' -char :: Char -> Lexer Char +char + :: Char + -- ^ The exact character to consume + -> Lexer Char char c = satisfy (== c) ---------------------------------------------------------------------------- -- | Lexer combinator for matching a 'String' -string' :: String -> Lexer String +string' + :: String + -- ^ Literal string prefix to consume character by character + -> Lexer String string' = traverse char ---------------------------------------------------------------------------- -- | Lexer combinator for matching a 'MisoString' -string :: MisoString -> Lexer MisoString +string + :: MisoString + -- ^ Literal string prefix to consume from the input + -> Lexer MisoString string prefix = Lexer $ \s -> case s of Stream ys l @@ -218,7 +315,11 @@ Left (unexpected ys l) ---------------------------------------------------------------------------- -- | Lexer combinator for executing a t'Lexer' with annotated t'Location' information -withLocation :: ToMisoString token => Lexer token -> Lexer (Located token) +withLocation + :: ToMisoString token + => Lexer token + -- ^ Inner lexer whose result is wrapped with its source 'Location' + -> Lexer (Located token) withLocation lexer = do result <- lexer let diff --git a/src/Miso/Util/Parser.hs b/src/Miso/Util/Parser.hs --- a/src/Miso/Util/Parser.hs +++ b/src/Miso/Util/Parser.hs @@ -5,11 +5,79 @@ ----------------------------------------------------------------------------- -- | -- Module : Miso.Util.Parser --- Copyright : (C) 2016-2026 David M. Johnson (@dmjio) +-- Copyright : (C) 2016-2026 David M. Johnson -- License : BSD3-style (see the file LICENSE) -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.Util.Parser" is an internal parser combinator library that +-- operates over a token stream produced by "Miso.Util.Lexer". It is used +-- by miso's JSON pipeline ("Miso.JSON.Parser") and the client-side router +-- ("Miso.Router"). It is __not__ designed for general application use, +-- but is exposed for downstream code that needs to build custom parsers. +-- +-- = Core types +-- +-- @ +-- newtype 'ParserT' r token m a = Parser +-- { 'runParserT' :: r -> token -> m (a, token) } +-- +-- type 'Parser' token a = 'ParserT' () [token] [] a +-- @ +-- +-- 'ParserT' is a monad transformer parameterised by: +-- +-- * @r@ β€” a read-only environment (accessible via 'askParser') +-- * @token@ β€” the input stream type (typically @[t]@) +-- * @m@ β€” the result monad; using @[]@ gives non-deterministic\/backtracking parsing +-- * @a@ β€” the parsed result +-- +-- The @'Parser' token a@ convenience alias fixes @r = ()@ and @m = []@, +-- which gives a standard backtracking parser over a @[token]@ stream. +-- +-- = Primitive combinators +-- +-- @ +-- 'anyToken' :: 'ParserT' r [a] [] a -- consume any single token +-- 'satisfy' :: (a -> Bool) -> 'ParserT' r [a] [] a -- consume if predicate holds +-- 'token_' :: Eq t => t -> 'Parser' t t -- match a specific token +-- 'peek' :: 'Parser' a a -- look ahead without consuming +-- 'endOfInput' :: 'Parser' a () -- succeed only at end of stream +-- 'allTokens' :: 'ParserT' r a [] a -- return the entire remaining stream +-- 'modifyTokens' :: (t -> t) -> 'ParserT' r t [] () -- transform the token stream +-- 'askParser' :: 'ParserT' r token [] r -- read the environment +-- 'errorOut' :: e -> 'ParserT' r e [] () -- inject a custom error token +-- @ +-- +-- = Error type +-- +-- @ +-- data 'ParseError' a token +-- = UnexpectedParse [token] -- input remained after a successful parse +-- | LexicalError 'Miso.Util.Lexer.LexerError' -- upstream lex failure +-- | Ambiguous [(a, [token])] -- multiple distinct parses +-- | NoParses token -- no parse succeeded +-- | EmptyStream -- input was empty +-- @ +-- +-- = Running a parser +-- +-- @ +-- 'parse' :: 'Parser' token a -> [token] -> Either ('ParseError' a token) a +-- @ +-- +-- 'parse' returns 'Right' only when exactly one parse consumes all input. +-- Ambiguous or partial parses produce a 'Left' error. +-- +-- = See also +-- +-- * "Miso.Util.Lexer" β€” produces the token stream consumed here +-- * "Miso.JSON.Parser" β€” JSON parser built on this module +-- * "Miso.Router" β€” URI\/route parser built on this module +-- * "Miso.Util" β€” 'Miso.Util.sepBy', 'Miso.Util.oneOf' used alongside parsers ---------------------------------------------------------------------------- module Miso.Util.Parser ( -- ** Types @@ -48,7 +116,12 @@ deriving (Show, Eq) ---------------------------------------------------------------------------- -- | Executes a parser against a series of tokens. -parse :: Parser token a -> [token] -> Either (ParseError a token) a +parse + :: Parser token a + -- ^ Parser to run + -> [token] + -- ^ Input token stream + -> Either (ParseError a token) a parse _ [] = Left EmptyStream parse parser tokens = case runParserT parser () tokens of @@ -64,6 +137,8 @@ newtype ParserT r token m a = Parser { runParserT :: r -> token -> m (a, token) + -- ^ Run the parser given a read-only environment @r@ and input @token@; + -- returns zero or more @(result, remaining-input)@ pairs in @m@ } ---------------------------------------------------------------------------- instance Functor (ParserT r token []) where @@ -106,7 +181,10 @@ ---------------------------------------------------------------------------- -- | Succeeds for any token for which the predicate @f@ returns 'True'. -- Returns the parsed token. -satisfy :: (a -> Bool) -> ParserT r [a] [] a +satisfy + :: (a -> Bool) + -- ^ Predicate; the next token is consumed only if this returns 'True' + -> ParserT r [a] [] a satisfy f = do t <- anyToken guard (f t) @@ -114,7 +192,11 @@ ---------------------------------------------------------------------------- -- | Succeeds if the next token in the stream matches the given one. -- Returns the parsed token. -token_ :: Eq token => token -> Parser token token +token_ + :: Eq token + => token + -- ^ Expected token value + -> Parser token token token_ t = satisfy (==t) ---------------------------------------------------------------------------- -- | Returns all input from a parser @@ -122,7 +204,10 @@ allTokens = Parser $ \_ input -> [(input, input)] ---------------------------------------------------------------------------- -- | Modifies tokens -modifyTokens :: (t -> t) -> ParserT r t [] () +modifyTokens + :: (t -> t) + -- ^ Transform to apply to the current token stream + -> ParserT r t [] () modifyTokens f = Parser $ \_ input -> [((), f input)] ---------------------------------------------------------------------------- -- | Retrieves read-only state from a Parser @@ -137,7 +222,10 @@ (x:xs) -> [(x, x:xs)] ---------------------------------------------------------------------------- -- | Parser combinator that always fails -errorOut :: errorToken -> ParserT r errorToken [] () +errorOut + :: errorToken + -- ^ Error token injected as the current stream (useful for error propagation) + -> ParserT r errorToken [] () errorOut x = Parser $ \_ _ -> [((),x)] ---------------------------------------------------------------------------- -- | Parser combinator that only succeeds if there are no more tokens. diff --git a/src/Miso/WebSocket.hs b/src/Miso/WebSocket.hs --- a/src/Miso/WebSocket.hs +++ b/src/Miso/WebSocket.hs @@ -9,6 +9,101 @@ -- Maintainer : David M. Johnson -- Stability : experimental -- Portability : non-portable +-- +-- = Overview +-- +-- "Miso.WebSocket" provides a full-duplex +-- +-- client that integrates directly into the MVU loop. Every operation +-- β€” connecting, sending, and closing β€” returns an 'Miso.Effect.Effect', +-- making WebSocket communication a first-class citizen of the @update@ +-- function. +-- +-- = Quick start +-- +-- @ +-- import "Miso" +-- import "Miso.WebSocket" +-- +-- data Action +-- = Connect +-- | Connected 'WebSocket' +-- | Received 'Miso.String.MisoString' +-- | Disconnected 'Closed' +-- | WsError 'Miso.String.MisoString' +-- | Send 'Miso.String.MisoString' +-- | Disconnect +-- +-- -- Hold the socket handle in the model so we can send later +-- data Model = Model { ws :: 'WebSocket' } +-- +-- update :: Action -> 'Miso.Effect.Effect' p props Model Action +-- update Connect = +-- 'connectText' \"wss:\/\/echo.websocket.org\" +-- Connected Disconnected Received WsError +-- update (Connected sock) = +-- 'Miso.State.modify' (\\m -> m { ws = sock }) +-- update (Received msg) = +-- 'Miso.Effect.io_' (consoleLog msg) +-- update (Send txt) = do +-- sock <- 'Miso.State.gets' ws +-- 'sendText' sock txt +-- update Disconnect = do +-- sock <- 'Miso.State.gets' ws +-- 'close' sock +-- update _ = pure () +-- @ +-- +-- = Connection variants +-- +-- Five @connect@ functions cover every wire format. They all share the +-- same callback signature β€” @onOpen@, @onClosed@, @onMessage@, @onError@ +-- β€” but differ in how the message payload is decoded: +-- +-- ['connectText'] 'Miso.String.MisoString' β€” plain UTF-8 text +-- ['connectJSON'] @json@ ('Miso.JSON.FromJSON' json) β€” auto-decoded from JSON +-- ['connectBLOB'] 'Blob' β€” raw binary Blob +-- ['connectArrayBuffer'] 'ArrayBuffer' β€” raw binary buffer +-- ['connect'] @'Payload' json@ β€” mixed; caller pattern-matches the payload ADT +-- +-- = Sending messages +-- +-- The 'WebSocket' handle delivered to @onOpen@ must be stored in the +-- model and passed to each send call: +-- +-- @ +-- 'sendText' :: 'WebSocket' -> 'Miso.String.MisoString' -> 'Miso.Effect.Effect' p props model action +-- 'sendJSON' :: 'Miso.JSON.ToJSON' json => 'WebSocket' -> json -> 'Miso.Effect.Effect' p props model action +-- 'sendBLOB' :: 'WebSocket' -> 'Blob' -> 'Miso.Effect.Effect' p props model action +-- 'sendArrayBuffer' :: 'WebSocket' -> 'ArrayBuffer' -> 'Miso.Effect.Effect' p props model action +-- @ +-- +-- = Lifecycle +-- +-- * Always call 'close' when the connection is no longer needed to avoid +-- resource leaks. It is safe to call 'close' multiple times β€” subsequent +-- calls are no-ops. +-- * 'socketState' lets you query the current 'SocketState' +-- (@CONNECTING@, @OPEN@, @CLOSING@, @CLOSED@) asynchronously. +-- * 'emptyWebSocket' (@= -1@) is a null sentinel you can store in the +-- model before a connection has been established. +-- +-- = Types +-- +-- * 'WebSocket' β€” an opaque integer file descriptor returned by @onOpen@. +-- * 'URL' β€” alias for 'Miso.String.MisoString'. +-- * 'SocketState' β€” four-state enum mirroring the JS @readyState@ property. +-- * 'Closed' β€” close event data: 'closedCode', 'wasClean', 'reason'. +-- * 'CloseCode' β€” typed close codes from +-- . +-- * 'Payload' β€” @JSON value | BLOB Blob | TEXT MisoString | BUFFER ArrayBuffer@. +-- * 'Blob' / 'ArrayBuffer' β€” re-exported from "Miso.FFI.Internal". +-- +-- = See also +-- +-- * "Miso.EventSource" β€” Server-Sent Events (SSE), a unidirectional alternative +-- * "Miso.Fetch" β€” one-shot HTTP requests +-- * "Miso.Effect" β€” 'Miso.Effect.Effect', 'Miso.Effect.io_' ---------------------------------------------------------------------------- module Miso.WebSocket ( -- *** t'WebSocket'