packages feed

miso 1.7.1.0 → 1.12.0.0

raw patch · 122 files changed

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2016-2020, David M. Johnson+Copyright (c) 2016-2026, David M. Johnson All rights reserved.  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
README.md view
@@ -1,500 +1,428 @@ <h1 align="center">miso</h1>+ <p align="center">  <a href="https://haskell-miso.org">-  <img width=10% src="https://emojipedia-us.s3.amazonaws.com/thumbs/240/apple/96/steaming-bowl_1f35c.png">+  <img width=10% src="https://em-content.zobj.net/thumbs/240/apple/325/steaming-bowl_1f35c.png">+    </a>-<p align="center">A <i>tasty</i> <a href="https://www.haskell.org/"><strong>Haskell</strong></a> front-end framework</p>+<p align="center">A <a href="https://www.haskell.org/"><strong>Haskell</strong></a> library for building web and <a href="https://github.com/haskell-miso/miso-lynx">mobile</a> applications</p> </p> -<p align="center">-  <a href="https://haskell-miso-slack.herokuapp.com">-<img src="https://img.shields.io/badge/slack-miso-E01563.svg?style=flat-square" alt="Miso Slack">-  </a>-  <a href="https://haskell.org">-	<img src="https://img.shields.io/badge/language-Haskell-orange.svg?style=flat-square" alt="Haskell">+<p align="center"> +  <a href="https://matrix.to/#/#haskell-miso:matrix.org">+    <img src="https://img.shields.io/badge/matrix.org-miso-FF4B33.svg?style=for-the-badge" alt="Matrix #haskell-miso:matrix.org">   </a>-  <a href="https://miso-haskell.cachix.org">-	<img src="https://img.shields.io/badge/build-cachix-yellow.svg?style=flat-square" alt="Cachix">+  <a href="https://www.npmjs.com/package/haskell-miso">  +    <img src="https://img.shields.io/npm/v/haskell-miso?style=for-the-badge" />+  </a>  +  <a href="https://haskell-miso-cachix.cachix.org">+    <img src="https://img.shields.io/badge/build-cachix-yellow.svg?style=for-the-badge" alt="Cachix">   </a>-  <a href="https://travis-ci.org/dmjio/miso">-    <img src="https://img.shields.io/travis/dmjio/miso.svg?style=flat-square" alt="Travis CI">+  <a href="https://actions-badge.atrox.dev/dmjio/miso/goto?ref=master">+    <img alt="Build Status" src="https://img.shields.io/endpoint.svg?url=https%3A%2F%2Factions-badge.atrox.dev%2Fdmjio%2Fmiso%2Fbadge%3Fref%3Dmaster&style=for-the-badge" />   </a>   <a href="http://hackage.haskell.org/package/miso">-	<img src="https://img.shields.io/hackage/v/miso.svg?style=flat-square" alt="Hackage">-  </a>-  <a href="https://www.irccloud.com/invite?channel=%23haskell-miso&amp;hostname=irc.freenode.net&amp;port=6697&amp;ssl=1">-	<img src="https://img.shields.io/badge/irc-%23haskell--miso-1e72ff.svg?style=flat-square" alt="IRC #haskell-miso">-  </a>-  <a href="https://github.com/dmjio/miso/blob/master/LICENSE">-	<img src="http://img.shields.io/badge/license-BSD3-blueviolet.svg?style=flat-square" alt="LICENSE">+    <img src="https://img.shields.io/hackage/v/miso.svg?style=for-the-badge" alt="Hackage">   </a> </p> -**Miso** is a small, production-ready, "[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 applications. It features a virtual-dom, recursive diffing / patching algorithm, attribute and property normalization, event delegation, event batching, SVG, Server-sent events, Websockets, type-safe [servant](https://haskell-servant.github.io/)-style routing and an extensible Subscription-based subsystem. Inspired by [Elm](http://elm-lang.org/), [Redux](http://redux.js.org/) and [Bobril](http://github.com/bobris/bobril). **Miso** is pure by default, but side effects (like `XHR`) can be introduced into the system via the `Effect` data type. **Miso** makes heavy use of the [GHCJS](https://github.com/ghcjs/ghcjs) FFI 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.+<p align="center"> +Inspired by <a href="http://elm-lang.org/">Elm</a> and <a href="http://react.dev/">React</a>. See the <a href="https://github.com/haskell-miso">GitHub</a> org. <a href="https://try.haskell-miso.org">Try it</a>. Read the <a href="https://haddocks.haskell-miso.org/miso/Miso.html">docs</a>.+</p> +## Key features++- [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.++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).++> [!TIP]+> See the [Haskell miso organization](https://github.com/haskell-miso) on GitHub for the full ecosystem of packages and examples 🍜+ ## Table of Contents-- [Quick Start](#quick-start)-  - [Begin](#begin)-  - [Nix](#nix)-  - [Architecture](#architecture)-- [Examples](#examples)-  - [TodoMVC](#todomvc)-  - [Flatris](#flatris)-  - [2048](#2048)-  - [Snake](#snake)-  - [Mario](#mario)-  - [Miso Plane (Flappy Birds)](#miso-plane-flappy-birds)-  - [Websocket](#websocket)-  - [SSE](#sse)-  - [XHR](#xhr)-  - [Router](#router)-  - [SVG](#svg)-  - [Canvas 2D](#canvas-2d)-  - [ThreeJS](#threejs)-  - [Simple](#simple)-  - [File Reader](#file-reader)-  - [WebVR](#webvr)+- [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)-  - [GHC](#ghc)-  - [GHCJS](#ghcjs)-- [Sample Application](#sample-application)-- [Transition Application](#transition-application)-- [Live reload with JSaddle](#live-reload-with-jsaddle)-- [Docker](#docker)-- [Building examples](#building-examples)-- [Coverage](#coverage)-- [Isomorphic](#isomorphic)-- [Pinning nixpkgs](#pinning-nixpkgs)-- [Binary cache](#binary-cache)-- [Benchmarks](#benchmarks)+- [Wiki](#wiki)+- [Architecture](#architecture)+- [Examples](#examples)+- [HTTP](#interacting-with-http-apis-)+- [Testing](#testing-)+- [Native](#native-)+- [Benchmarks](#benchmarks-%EF%B8%8F)+- [Nix](#nix-)+  - [Pinning nixpkgs](#pinning-nixpkgs-)+  - [Binary cache](#binary-cache)+- [Community](#community-) - [Maintainers](#maintainers)-- [Commercial Users](#commercial-users)+- [Commercial](#commercial-) - [Contributing](#contributing)-- [Contributors](#contributors)+- [Contributors](#contributors-)+- [Partnerships](#partnerships-)+- [Backers](#backers)+- [Organizations](#organizations)+- [History](#history-) - [License](#license) -## Quick start-To get started quickly building applications, we recommend using the [`nix`](https://nixos.org/nix) package manager with miso's binary cache provided by [`cachix`](https://miso-haskell.cachix.org/). It is possible to use [`stack`](https://docs.haskellstack.org/en/stable/README/) to build GHCJS projects, but support for procuring `GHCJS` has been removed [as of stack 2.0](https://github.com/commercialhaskell/stack/issues/4086). `nix` is used to procure a working version of `GHCJS`. If you're using `cabal` we assume you have [obtained `GHCJS`](https://github.com/ghcjs/ghcjs#installation) by other means. All source code depicted below for the quick start app is available [here](https://github.com/dmjio/miso/tree/master/sample-app).--### Begin-To build the sample-app with `nix`, execute the commands below:+## Playground 🛝 -```bash-# optional use of cache-nix-env -iA cachix -f https://cachix.org/api/v1/install-# optional use of cache-cachix use miso-haskell-git clone https://github.com/dmjio/miso-cd miso/sample-app-nix-build-open ./result/bin/app.jsexe/index.html-```+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. -The above commands will add miso's binary cache to your nix installation (support for both Linux and OSX).-`nix-build` will fetch the dependencies from miso's cache and build the sample application.+## Quick Start (Nix) ⚡ -### Nix-`Nix` is a more 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/examples/haskell-miso.org) is an example of this.+> [!TIP]+> 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. -If unfamiliar with `nix`, we recommend [@Gabriel439](https://github.com/Gabriel439)'s ["Nix and Haskell in production"](https://github.com/Gabriel439/haskell-nix) guide.+The following requires [Nix Flakes](https://wiki.nixos.org/wiki/Flakes). See also [Binary cache](#binary-cache) to avoid rebuilding dependencies. -To begin, make the following directory layout: ```bash-➜  mkdir app && touch app/{Main.hs,app.cabal,default.nix} && tree app-app-|-- Main.hs-|-- app.cabal-`-- default.nix-```--Add a `cabal` file-```bash-➜  cat app/*.cabal-name:                app-version:             0.1.0.0-synopsis:            First miso app-category:            Web-build-type:          Simple-cabal-version:       >=1.10--executable app-  main-is:             Main.hs-  ghcjs-options:-    -dedupe-  build-depends:       base, miso-  default-language:    Haskell2010-```+# Install nix +curl -L https://nixos.org/nix/install | sh -Write a `default.nix` (this will fetch a recent version of `miso`). `miso` will provide you with a working `nixpkgs` named `pkgs`. `callCabal2nix` will automatically produce a nix expression that builds your cabal file.+# Enable flakes+echo 'experimental-features = nix-command flakes' >> ~/.config/nix/nix.conf -```nix-with (import (builtins.fetchTarball {-  url = "https://github.com/dmjio/miso/archive/ea25964565074e73d4052b56b60b6e101fa08bc5.tar.gz";-  sha256 = "1yb9yvc0ln4yn1jk2k5kwwa1s32310abawz40yd8cqqkm1z7w6wg";-}) {});-pkgs.haskell.packages.ghcjs.callCabal2nix "app" ./. {}+# 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' ``` -Add the source from [Sample Application](#sample-application) to `app/Main.hs`+## Manual Setup (GHCup / Cabal) -Build the project-```-nix-build-```+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/). -Open the result-```-open ./result/bin/app.jsexe/index.html-```+> [!TIP]+> 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/). -For development with `nix`, it can be nice to have `cabal` present for building. This command will make it available in your `PATH`.-```-nix-env -iA cabal-install -f '<nixpkgs>'-```+A minimal application requires three files: -To be put into a shell w/ `GHCJS` and all the dependencies for this project present, use `nix-shell`.-```-nix-shell -A env-```+  - `cabal.project`+  - `app.cabal`+  - `Main.hs` -To view the dependencies for your project, call `ghcjs-pkg list` when inside the shell.-```-nix-shell -A env --run 'ghcjs-pkg list'-```+### `cabal.project` -To build the project with `cabal` after entering the `nix-shell`-```-nix-shell -A env --run 'cabal configure --ghcjs && cabal build'-```+```cabal+packages:+  . -For incremental development inside of the `nix-shell` we recommend using a tool like [`entr`](http://eradman.com/entrproject/) to automatically rebuild on file changes, or roll your own solution with `inotify`.-```-ag -l | entr sh -c 'cabal build'+source-repository-package+  type: git+  location: https://github.com/dmjio/miso+  branch: master ``` -### 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/dmjio/miso/blob/master/examples/haskell-miso.org/haskell-miso.cabal#L16-L60). For more info on how to use `stack` with a `client`/`server` setup, see this [link](https://docs.haskellstack.org/en/stable/ghcjs/#project-with-both-client-and-server). For more information on how to use `nix` with a `client`/`server` setup, see the [nix scripts](https://github.com/dmjio/miso/blob/master/examples/haskell-miso.org/default.nix) for [https://haskell-miso.org](https://haskell-miso.org).--## Examples--### TodoMVC-  - [Link](http://todo-mvc.haskell-miso.org/) / [Source](https://github.com/dmjio/miso/blob/master/examples/todo-mvc/Main.hs)--### Flatris-  - [Link](http://flatris.haskell-miso.org/) / [Source](https://github.com/ptigwe/hs-flatris/)--### 2048-  - [Link](http://2048.haskell-miso.org/) / [Source](https://github.com/ptigwe/hs2048/)--### Snake-  - [Link](http://snake.haskell-miso.org/) / [Source](https://github.com/lbonn/miso-snake)--### Mario-  - [Link](http://mario.haskell-miso.org/) / [Source](https://github.com/dmjio/miso/blob/master/examples/mario/Main.hs)--### Miso Plane (Flappy Birds)-  - [Link](http://miso-plane.lermex.net/) / [Source](https://github.com/Lermex/miso-plane)--### Websocket-  - [Link](http://websocket.haskell-miso.org/) / [Source](https://github.com/dmjio/miso/blob/master/examples/websocket/Main.hs)--### SSE-  - [Link](http://sse.haskell-miso.org/) / [Client](https://github.com/dmjio/miso/blob/master/examples/sse/client/Main.hs) / [Server](https://github.com/dmjio/miso/blob/master/examples/sse/server/Main.hs)--### XHR-  - [Link](http://xhr.haskell-miso.org/) / [Source](https://github.com/dmjio/miso/blob/master/examples/xhr/Main.hs)--### Router-  - [Link](http://router.haskell-miso.org/) / [Source](https://github.com/dmjio/miso/blob/master/examples/router/Main.hs)--### SVG-  - [Link](http://svg.haskell-miso.org/) / [Source](https://github.com/dmjio/miso/blob/master/examples/svg/Main.hs)+> [!NOTE]+> Pinning to a specific `tag:` or `commit:` rather than `branch: master` is recommended for reproducible builds. -### Canvas 2D-  - [Link](http://canvas.haskell-miso.org/) / [Source](https://github.com/dmjio/miso/blob/master/examples/canvas2d/Main.hs)+### `app.cabal` -### ThreeJS-  - [Link](http://threejs.haskell-miso.org/) / [Source](https://github.com/dmjio/miso/blob/master/examples/three/Main.hs)+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. -### Simple-  - [Link](http://simple.haskell-miso.org/) / [Source](https://github.com/dmjio/miso/blob/master/exe/Main.hs)+```cabal+cabal-version: 2.2+name: app+version: 0.1.0.0+synopsis: Sample miso app+category: Web -### File Reader-  - [Link](http://file-reader.haskell-miso.org/) / [Source](https://github.com/dmjio/miso/blob/master/examples/file-reader/Main.hs)+common options+  if arch(wasm32)+    ghc-options:+      -no-hs-main+      -optl-mexec-model=reactor+      "-optl-Wl,--export=hs_start"+    cpp-options:+      -DWASM -### WebVR-  - [Link](http://fizruk.github.io/fpconf-2017-talk/miso-aframe-demo/dist/demo.jsexe/index.html) / [Source](https://github.com/fizruk/miso-aframe)+  if arch(javascript)+     ld-options:+       -sEXPORTED_RUNTIME_METHODS=HEAP8 -## Haddocks+executable app+  import:+    options+  main-is:+    Main.hs+  build-depends:+    base, miso+  default-language:+    Haskell2010+``` -### GHCJS-  - [Link](https://haddocks.haskell-miso.org/)+### `Main.hs` -### GHC-  - [Link](http://hackage.haskell.org/package/miso)+A counter application demonstrating the Model-View-Update pattern: -## Sample application ```haskell--- | Haskell language pragma+---------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}---- | Haskell module declaration+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE CPP               #-}+---------------------------------------------------------------------------- module Main where---- | Miso framework import-import Miso-import Miso.String---- | Type synonym for an application model-type Model = Int---- | Sum type for application events+----------------------------------------------------------------------------+import           Miso+import qualified Miso.Html as H+import           Miso.Lens+----------------------------------------------------------------------------+-- | Sum type for App events data Action   = AddOne   | SubtractOne-  | NoOp   | SayHelloWorld   deriving (Show, Eq)-+---------------------------------------------------------------------------- -- | Entry point for a miso application main :: IO ()-main = startApp App {..}-  where-    initialAction = SayHelloWorld -- initial action to be executed on application load-    model  = 0                    -- initial model-    update = updateModel          -- update function-    view   = viewModel            -- view function-    events = defaultEvents        -- default delegated events-    subs   = []                   -- empty subscription list-    mountPoint = Nothing          -- mount point for application (Nothing defaults to 'body')-    logLevel = Off                -- used during prerendering to see if the VDOM and DOM are in sync (only applies to `miso` function)-+main = startApp defaultEvents app+----------------------------------------------------------------------------+-- | WASM export, required when compiling w/ the WASM backend.+#ifdef WASM+foreign export javascript "hs_start" main :: IO ()+#endif+----------------------------------------------------------------------------+-- | `vcomp` takes as arguments the initial model, update function, view function+app :: App Int Action+app = vcomp 0 updateModel viewModel+---------------------------------------------------------------------------- -- | Updates model, optionally introduces side effects-updateModel :: Action -> Model -> Effect Action Model-updateModel action m =-  case action of-    AddOne-      -> noEff (m + 1)-    SubtractOne-      -> noEff (m - 1)-    NoOp-      -> noEff m-    SayHelloWorld-      -> m <# do consoleLog "Hello World" >> pure NoOp-+updateModel :: Action -> Effect parent props Int Action+updateModel = \case+  AddOne -> this += 1+  SubtractOne -> this -= 1+  SayHelloWorld -> io_ $ do+    alert "Hello World"+    consoleLog "Hello World"+---------------------------------------------------------------------------- -- | Constructs a virtual DOM from a model-viewModel :: Model -> View Action-viewModel x = div_ [] [-   button_ [ onClick AddOne ] [ text "+" ]- , text (ms x)- , button_ [ onClick SubtractOne ] [ text "-" ]- ]+viewModel :: () -> Int -> View Int Action+viewModel _props x = vfrag+    [ H.button_ [ H.onClick AddOne ] [ text "+" ]+    , text (ms x)+    , H.button_ [ H.onClick SubtractOne ] [ text "-" ]+    , H.br_ []+    , H.button_ [ H.onClick SayHelloWorld ] [ text "Alert Hello World!" ]+    ]+---------------------------------------------------------------------------- ``` -## Transition application+## Hot Reload 🔥 -An alternative, more powerful interface for constructing `miso` applications is using the `Transition` interface.-`Transition` is based on the `StateT` monad transformer, and can be used to construct components. It also works-very nicely with lenses based on `MonadState` (i.e. `(.=)`, `(%=)`,`(+=)`,`(-=)`).+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 -```haskell--- | Haskell language pragma-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}+See [Installation](docs/Install.md) for platform-specific installation instructions. --- | Haskell module declaration-module Main where+## Haddocks --- | Miso framework import-import Miso-import Miso.String+Official API reference. See also the [Miso](https://haddocks.haskell-miso.org/miso/Miso.html) module for a guided entry point into the library. --- | Lens import-import Control.Lens+| Platform | URL |+|------|-------------|+| GHCJS | [Link](https://haddocks.haskell-miso.org/) |+| GHC | [Link](http://hackage.haskell.org/package/miso) | --- | Type synonym for an application model-data Model-  = Model-  { _counter :: Int-  } deriving (Show, Eq)+## Wiki -counter :: Lens' Model Int-counter = lens _counter $ \record field -> record { _counter = field }+See the [DeepWiki](https://deepwiki.com/dmjio/miso) entry for an AI-assisted exploration of the source code. --- | Sum type for application events-data Action-  = AddOne-  | SubtractOne-  | NoOp-  | SayHelloWorld-  deriving (Show, Eq)+[![Ask DeepWiki](https://deepwiki.com/badge.svg)](https://deepwiki.com/dmjio/miso) --- | Entry point for a miso application-main :: IO ()-main = startApp App {..}-  where-    initialAction = SayHelloWorld -- initial action to be executed on application load-    model  = Model 0              -- initial model-    update = fromTransition . updateModel -- update function-    view   = viewModel            -- view function-    events = defaultEvents        -- default delegated events-    subs   = []                   -- empty subscription list-    mountPoint = Nothing          -- mount point for application (Nothing defaults to 'body')-    logLevel = Off                -- used during prerendering to see if the VDOM and DOM are in sync (only applies to `miso` function)+## Architecture --- | Updates model, optionally introduces side effects-updateModel :: Action -> Transition Action Model ()-updateModel action =-  case action of-    AddOne-      -> counter += 1-    SubtractOne-      -> counter -= 1-    NoOp-      -> pure ()-    SayHelloWorld-      -> scheduleIO_ (consoleLog "Hello World")+**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`. --- | Constructs a virtual DOM from a model-viewModel :: Model -> View Action-viewModel x = div_ [] [-   button_ [ onClick AddOne ] [ text "+" ]- , text . ms $ x^.counter- , button_ [ onClick SubtractOne ] [ text "-" ]- ]-```+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). -## Live reload with JSaddle+> [!TIP]+> 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). -It is possible to build `miso` applications with `ghcid`, `jsaddle` that allow live reloading of your application in reponse to changes in application code. See the [README](https://github.com/dmjio/miso/blob/master/sample-app-jsaddle/README.md) in the `sample-app-jsaddle` folder for more information.+## Examples -## Docker+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/). -Developing miso applications inside a Docker container is supported (allows applications to be built on Windows). See the [README](https://github.com/dmjio/miso/blob/master/docker/README.md) in the `docker` folder for more information.+> [!TIP]+> Use [cachix](https://cachix.org) to avoid rebuilding shared dependencies: `cachix use haskell-miso-cachix` -## Building examples+| 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)                | -The easiest way to build the examples is with the [`nix`](https://nixos.org/nix/) package manager-```-git clone https://github.com/dmjio/miso && cd miso && nix-build --arg examples true-```+## Interacting with HTTP APIs 🔌 -This will build all examples and documentation into a folder named `result`-```-➜  miso git:(master) ✗ tree -d ./result/bin-./result/bin-|-- canvas2d.jsexe-|-- compose-update.jsexe-|-- file-reader.jsexe-|-- mario.jsexe-|   `-- imgs-|-- mathml.jsexe-|-- router.jsexe-|-- simple.jsexe-|-- svg.jsexe-|-- tests.jsexe-|-- threejs.jsexe-|-- todo-mvc.jsexe-|-- websocket.jsexe-`-- xhr.jsexe-```+Two approaches are supported: -To see examples, we recommend hosting them with a webserver+  1. For simple JSON-based APIs, use the [Fetch](https://haddocks.haskell-miso.org/miso/Miso-Fetch.html) module directly. -```-cd result/bin/todo-mvc.jsexe && nix-shell -p python --run 'python -m SimpleHTTPServer'-Serving HTTP on 0.0.0.0 port 8000 ...-```+  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). -## Coverage+     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`: -The core algorithmic component of miso is [diff.js](https://github.com/dmjio/miso/blob/master/jsbits/diff.js). 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 [jsdom](https://github.com/jsdom/jsdom) and [jest](https://github.com/facebook/jest).+     ```+     source-repository-package+       type: git+       location: https://github.com/haskell-miso/servant-miso-client+       tag: master+     ``` -To run the tests and build the coverage report:+## Testing ✅ +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 TypeScript tests, install [bun](https://github.com/oven-sh/bun) first.+ ```bash-cd miso/tests-npm i-npm run test-## Or by using `yarn` instead of `npm`:-# yarn-# yarn test+$ curl -fsSL https://bun.sh/install | bash ```+or -## Isomorphic+```bash+$ nix-env -iA bun -f '<nixpkgs>'+``` -[Isomorphic javascript](https://en.wikipedia.org/wiki/Isomorphic_JavaScript) is a technique for increased SEO, code-sharing and perceived page load times. It works in two parts. First, the server sends a pre-rendered HTML body to the client's browser. Second, after the client javascript application loads, the pointers of the pre-rendered DOM are copied into the virtual DOM, and the application proceeds as normal. All subsequent page navigation is handled locally by the client, avoiding full-page postbacks as necessary.+and -The `miso` function is used to perform the pointer-copying behavior client-side.+```bash+$ bun install && bun run test+``` -For more information on how `miso` handles isomorphic javascript, we recommend [this tutorial](https://github.com/FPtje/miso-isomorphic-example).+## Native 📱 -## Pinning nixpkgs+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. -By default `miso` uses a known-to-work, pinned version of [`nixpkgs`](https://github.com/dmjio/miso/blob/master/nixpkgs.json).+## Benchmarks 🏎️ -## Binary cache+[According to benchmarks](https://krausest.github.io/js-framework-benchmark/current.html), `miso` performs competitively relative to other frameworks. -`nix` users on a Linux or OSX distro can take advantage of a [binary cache](https://miso-haskell.cachix.org) for faster builds. To use the binary cache follow the instructions on [cachix](https://miso-haskell.cachix.org/).+## Nix <img src="https://raw.githubusercontent.com/NixOS/nixos-artwork/refs/heads/master/logo/nix-snowflake-colours.svg" alt="nixos-snowflake" width="25"/> +`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 pinned version of [`nixpkgs`](https://github.com/dmjio/miso/blob/master/nix/nixpkgs.json) known as `pkgs`.++> [!NOTE]+> `miso` also maintains a `legacyPkgs` nixpkgs pin for tools such as `nixops` and for builds using the original `GHCJS 8.6` backend.++### Binary cache++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 miso-haskell+$ cachix use haskell-miso-cachix ``` -## Benchmarks+For CI pipelines using GitHub Actions: -[According to benchmarks](https://rawgit.com/krausest/js-framework-benchmark/master/webdriver-ts-results/table.html), `miso` is among the fastest functional programming web frameworks, second only to [Elm](http://elm-lang.org).+```yaml+- name: Install cachix+  uses: cachix/cachix-action@v16+  with:+    name: haskell-miso-cachix+``` -<a target="_blank" href="https://rawgit.com/krausest/js-framework-benchmark/master/webdriver-ts-results/table.html"><img src="https://cdn-images-1.medium.com/max/1600/1*6EjJTf1mhlTxd4QWsygCwA.png" width="500" height="600" /></a>+## Community :octocat: +- [Github](https://github.com/haskell-miso)+- [Matrix](https://matrix.to/#/#haskell-miso:matrix.org)+- [Discord](https://discord.gg/QVDtfYNSxq)+ ## Maintainers  [@dmjio](https://github.com/dmjio) -## Commercial Users-  - [Polimorphic](https://www.polimorphic.com)-  - [LumiGuide](https://lumi.guide/en/)-  - [Clovyr](https://clovyr.io)+## Commercial 🚀 +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 submit [PRs](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+## Contributors 🦾 -### Code Contributors+> [!NOTE]+> This project exists thanks to all the people who [contribute](CONTRIBUTING.md). -This project exists thanks to all the people who contribute. [[Contribute](CONTRIBUTING.md)]. <a href="https://github.com/dmjio/miso/graphs/contributors"><img src="https://opencollective.com/miso/contributors.svg?width=890&button=false" /></a> -### Financial Contributors+## Partnerships 🤝 -Become a financial contributor and help us sustain our community. [[Contribute](https://opencollective.com/miso/contribute)]+For inquiries regarding feature sponsorship or corporate partnerships, contact <a href="mailto:support@haskell-miso.org">support@haskell-miso.org</a>. -#### Individuals+## Backers +Become a [financial contributor](https://opencollective.com/miso/contribute) to help sustain the project.+ <a href="https://opencollective.com/miso"><img src="https://opencollective.com/miso/individuals.svg?width=890"></a> -#### Organizations+## organizations -Support this project with your organization. Your logo will show up here with a link to your website. [[Contribute](https://opencollective.com/miso/contribute)]+[Support this project](https://opencollective.com/miso/contribute) with your organization. Your logo will appear here with a link to your website. -<a href="https://opencollective.com/miso/organization/0/website"><img src="https://opencollective.com/miso/organization/0/avatar.svg"></a>-<a href="https://opencollective.com/miso/organization/1/website"><img src="https://opencollective.com/miso/organization/1/avatar.svg"></a>-<a href="https://opencollective.com/miso/organization/2/website"><img src="https://opencollective.com/miso/organization/2/avatar.svg"></a>-<a href="https://opencollective.com/miso/organization/3/website"><img src="https://opencollective.com/miso/organization/3/avatar.svg"></a>-<a href="https://opencollective.com/miso/organization/4/website"><img src="https://opencollective.com/miso/organization/4/avatar.svg"></a>-<a href="https://opencollective.com/miso/organization/5/website"><img src="https://opencollective.com/miso/organization/5/avatar.svg"></a>-<a href="https://opencollective.com/miso/organization/6/website"><img src="https://opencollective.com/miso/organization/6/avatar.svg"></a>-<a href="https://opencollective.com/miso/organization/7/website"><img src="https://opencollective.com/miso/organization/7/avatar.svg"></a>-<a href="https://opencollective.com/miso/organization/8/website"><img src="https://opencollective.com/miso/organization/8/avatar.svg"></a>-<a href="https://opencollective.com/miso/organization/9/website"><img src="https://opencollective.com/miso/organization/9/avatar.svg"></a>+<a target="_blank" href="https://opencollective.com/miso/organization/0/website"><img src="https://opencollective.com/miso/organization/0/avatar.svg"></a> +## 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 -[BSD3](LICENSE) © David Johnson+[BSD3](LICENSE) © dmjio
+ cbits/foreign.c view
@@ -0,0 +1,27 @@+#include <stdlib.h>+#include <stdint.h>++// dmj: like `foreign-store`, but just for a single Ptr.+// this is used to store a StablePtr (IORef a), retrieved after a GHCi reload++static void *stored_value = NULL;++// Store a pointer+void miso_x_store(void *ptr) {+    stored_value = ptr;+}++// Get the stored pointer+void *miso_x_get(void) {+    return stored_value;+}++// Check if a pointer is stored (non-NULL)+int miso_x_exists(void) {+    return stored_value != NULL;+}++// Clear the stored pointer+void miso_x_clear(void) {+    stored_value = NULL;+}
− exe/Main.hs 
@@ -1,65 +0,0 @@--- | Haskell language pragma-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE CPP #-}---- | Haskell module declaration-module Main where---- | Miso framework import-import Miso-import Miso.String--import Control.Monad.IO.Class--#ifdef IOS-import Language.Javascript.JSaddle.WKWebView as JSaddle--runApp :: JSM () -> IO ()-runApp = JSaddle.run-#else-import Language.Javascript.JSaddle.Warp as JSaddle--runApp :: JSM () -> IO ()-runApp = JSaddle.run 8080-#endif---- | Type synonym for an application model-type Model = Int---- | Sum type for application events-data Action-  = AddOne-  | SubtractOne-  | NoOp-  | SayHelloWorld-  deriving (Show, Eq)---- | Entry point for a miso application-main :: IO ()-main = runApp $ miso $ \_ -> App {..}-  where-    initialAction = SayHelloWorld -- initial action to be executed on application load-    model  = 0                    -- initial model-    update = updateModel          -- update function-    view   = viewModel            -- view function-    events = defaultEvents        -- default delegated events-    subs   = []                   -- empty subscription list-    mountPoint = Nothing          -- mount point for application (Nothing defaults to 'body')-    logLevel = Off                -- Used to copy DOM into VDOM, applies only to `miso` function---- | Updates model, optionally introduces side effects-updateModel :: Action -> Model -> Effect Action Model-updateModel AddOne m = noEff (m + 1)-updateModel SubtractOne m = noEff (m - 1)-updateModel NoOp m = noEff m-updateModel SayHelloWorld m = m <# do-  liftIO (putStrLn "Hello World") >> pure NoOp---- | Constructs a virtual DOM from a model-viewModel :: Model -> View Action-viewModel x = div_ [] [-   button_ [ onClick AddOne ] [ text "+" ]- , text (ms x)- , button_ [ onClick SubtractOne ] [ text "-" ]- ]
+ ffi/ghc/Miso/DSL/FFI.hs view
@@ -0,0 +1,203 @@+-----------------------------------------------------------------------------+module Miso.DSL.FFI where+-----------------------------------------------------------------------------+import           Data.Text (Text, pack, unpack)+import           Text.Read (readMaybe)+-----------------------------------------------------------------------------+-- | A type that represents any JS value+data JSVal = JSVal+-----------------------------------------------------------------------------+instance Eq JSVal where+  JSVal == JSVal = True+-----------------------------------------------------------------------------+toJSVal_Bool :: Bool -> IO JSVal+toJSVal_Bool = undefined+-----------------------------------------------------------------------------+toJSVal_Double :: Double -> IO JSVal+toJSVal_Double = undefined+-----------------------------------------------------------------------------+toJSVal_Int :: Int -> IO JSVal+toJSVal_Int = undefined+-----------------------------------------------------------------------------+toJSVal_List :: [JSVal] -> IO JSVal+toJSVal_List = undefined+-----------------------------------------------------------------------------+-- | The 'null' value in JS.+jsNull :: JSVal+jsNull = JSVal+-----------------------------------------------------------------------------+toJSVal_JSVal :: JSVal -> IO JSVal+toJSVal_JSVal = undefined+-----------------------------------------------------------------------------+toJSVal_Char :: Char -> IO JSVal+toJSVal_Char = undefined+-----------------------------------------------------------------------------+toJSVal_Float :: Float -> IO JSVal+toJSVal_Float = undefined+-----------------------------------------------------------------------------+toJSVal_Text :: Text -> IO JSVal+toJSVal_Text = undefined+-----------------------------------------------------------------------------+fromJSVal_Text :: JSVal -> IO (Maybe Text)+fromJSVal_Text = undefined+-----------------------------------------------------------------------------+fromJSValUnchecked_Text :: JSVal -> IO Text+fromJSValUnchecked_Text = undefined+-----------------------------------------------------------------------------+fromJSVal_Char :: JSVal -> IO (Maybe Char)+fromJSVal_Char = undefined+-----------------------------------------------------------------------------+fromJSValUnchecked_Char :: JSVal -> IO Char+fromJSValUnchecked_Char = undefined+-----------------------------------------------------------------------------+fromJSVal_Float :: JSVal -> IO (Maybe Float)+fromJSVal_Float = undefined+-----------------------------------------------------------------------------+fromJSValUnchecked_Float :: JSVal -> IO Float+fromJSValUnchecked_Float = undefined+-----------------------------------------------------------------------------+fromJSVal_Bool :: JSVal -> IO (Maybe Bool)+fromJSVal_Bool = undefined+-----------------------------------------------------------------------------+new_ffi :: JSVal -> JSVal -> IO JSVal+new_ffi = undefined+-----------------------------------------------------------------------------+eval_ffi :: Text -> IO JSVal+eval_ffi = undefined+-----------------------------------------------------------------------------+create_ffi :: IO JSVal+create_ffi = undefined+-----------------------------------------------------------------------------+getProp_ffi :: Text -> JSVal -> IO JSVal+getProp_ffi = undefined+-----------------------------------------------------------------------------+setProp_ffi :: Text -> JSVal -> JSVal -> IO ()+setProp_ffi = undefined+-----------------------------------------------------------------------------+setField_ffi :: JSVal -> Text -> JSVal -> IO ()+setField_ffi = undefined+-----------------------------------------------------------------------------+fromJSVal_Int :: JSVal -> IO (Maybe Int)+fromJSVal_Int = undefined+-----------------------------------------------------------------------------+fromJSVal_Double :: JSVal -> IO (Maybe Double)+fromJSVal_Double  = undefined+-----------------------------------------------------------------------------+getPropIndex_ffi :: Int -> JSVal -> IO JSVal+getPropIndex_ffi  = undefined+-----------------------------------------------------------------------------+isNull_ffi :: JSVal -> Bool+isNull_ffi = undefined+-----------------------------------------------------------------------------+isUndefined_ffi :: JSVal -> Bool+isUndefined_ffi = undefined+-----------------------------------------------------------------------------+freeFunction_ffi :: JSVal -> IO ()+freeFunction_ffi = undefined+-----------------------------------------------------------------------------+requestAnimationFrame :: JSVal -> IO Int+requestAnimationFrame = undefined+-----------------------------------------------------------------------------+cancelAnimationFrame :: Int -> IO ()+cancelAnimationFrame = undefined+-----------------------------------------------------------------------------+toJSVal_JSString :: Text -> IO JSVal+toJSVal_JSString = undefined+-----------------------------------------------------------------------------+fromJSValUnchecked_Maybe :: JSVal -> IO (Maybe JSVal)+fromJSValUnchecked_Maybe = undefined+-----------------------------------------------------------------------------+fromJSVal_Maybe :: JSVal -> IO (Maybe (Maybe JSVal))+fromJSVal_Maybe = undefined+-----------------------------------------------------------------------------+fromJSValUnchecked_Bool :: JSVal -> IO Bool+fromJSValUnchecked_Bool = undefined+-----------------------------------------------------------------------------+invokeFunction :: JSVal -> JSVal -> JSVal -> IO JSVal+invokeFunction = undefined+-----------------------------------------------------------------------------+listProps_ffi :: JSVal -> IO JSVal+listProps_ffi = undefined+-----------------------------------------------------------------------------+setPropIndex_ffi :: Int -> JSVal -> JSVal -> IO ()+setPropIndex_ffi = undefined+-----------------------------------------------------------------------------+-- | The @globalThis@ object in JS.+global :: JSVal+global = undefined+-----------------------------------------------------------------------------+fromJSVal_List :: JSVal -> IO (Maybe [JSVal])+fromJSVal_List = undefined+-----------------------------------------------------------------------------+fromJSValUnchecked_Int :: JSVal -> IO Int+fromJSValUnchecked_Int = undefined+-----------------------------------------------------------------------------+fromJSValUnchecked_Double :: JSVal -> IO Double+fromJSValUnchecked_Double = undefined+-----------------------------------------------------------------------------+fromJSVal_JSString :: JSVal -> IO (Maybe Text)+fromJSVal_JSString = undefined+-----------------------------------------------------------------------------+-- | A asynchronous callback+asyncCallback :: IO () -> IO JSVal+asyncCallback = undefined+-- | A asynchronous callback with one argument+asyncCallback1 :: (JSVal -> IO ()) -> IO JSVal+asyncCallback1 = undefined+-- | A asynchronous callback with two arguments+asyncCallback2 :: (JSVal -> JSVal -> IO ()) -> IO JSVal+asyncCallback2 = undefined+-- | A asynchronous callback with three arguments+asyncCallback3 :: (JSVal -> JSVal -> JSVal -> IO ()) -> IO JSVal+asyncCallback3 = undefined+-----------------------------------------------------------------------------+-- | A synchronous callback+syncCallback :: IO () -> IO JSVal+syncCallback = undefined+-- | A synchronous callback with a single argument+syncCallback1 :: (JSVal -> IO ()) -> IO JSVal+syncCallback1 = undefined+-- | A synchronous callback with two arguments+syncCallback2 :: (JSVal -> JSVal -> IO ()) -> IO JSVal+syncCallback2 = undefined+-- | A synchronous callback with three arguments+syncCallback3 :: (JSVal -> JSVal -> JSVal -> IO ()) -> IO JSVal+syncCallback3 = undefined+-----------------------------------------------------------------------------+-- | A synchronous callback that returns a value+syncCallback' :: IO JSVal -> IO JSVal+syncCallback' = undefined+-- | A synchronous callback that takes a single argument and returns a value+syncCallback1' :: (JSVal -> IO JSVal) -> IO JSVal+syncCallback1' = undefined+-- | A synchronous callback that takes two arguments and returns a value+syncCallback2' :: (JSVal -> JSVal -> IO JSVal) -> IO JSVal+syncCallback2' = undefined+-- | A synchronous callback that takes three arguments and returns a value+syncCallback3' :: (JSVal -> JSVal -> JSVal -> IO JSVal) -> IO JSVal+syncCallback3' = undefined+-----------------------------------------------------------------------------+parseInt :: Text -> Maybe Int+parseInt = readMaybe . unpack+-----------------------------------------------------------------------------+parseDouble :: Text -> Maybe Double+parseDouble = readMaybe . unpack+-----------------------------------------------------------------------------+parseWord :: Text -> Maybe Word+parseWord = readMaybe . unpack+-----------------------------------------------------------------------------+parseFloat :: Text -> Maybe Float+parseFloat = readMaybe . unpack+-----------------------------------------------------------------------------+toString_Int :: Int -> Text+toString_Int = pack . show+-----------------------------------------------------------------------------+toString_Word :: Word -> Text+toString_Word = pack . show+-----------------------------------------------------------------------------+toString_Float :: Float -> Text+toString_Float = pack . show+-----------------------------------------------------------------------------+toString_Double :: Double -> Text+toString_Double = pack . show+-----------------------------------------------------------------------------
+ ffi/js/Miso/DSL/FFI.hs view
@@ -0,0 +1,431 @@+-----------------------------------------------------------------------------+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+module Miso.DSL.FFI+  ( -- ** Types+    JSVal+  , JSString+    -- ** Serialization FFI+    -- *** ToJSVal+  , toJSVal_Char+  , toJSVal_Bool+  , toJSVal_Double+  , toJSVal_Float+  , toJSVal_Int+  , toJSVal_List+  , toJSVal_JSString+  , toJSVal_Text+    -- *** FromJSVal+  , fromJSVal_Text+  , fromJSValUnchecked_Text+  , fromJSVal_Char+  , fromJSValUnchecked_Char+  , fromJSVal_Bool+  , fromJSValUnchecked_Bool+  , fromJSVal_Double+  , fromJSValUnchecked_Double+  , fromJSVal_Float+  , fromJSValUnchecked_Float+  , fromJSVal_Int+  , fromJSValUnchecked_Int+  , fromJSVal_List+  , fromJSVal_JSString+  , fromJSVal_Maybe+  , fromJSValUnchecked_Maybe+  -- * Callback FFI+  , asyncCallback+  , asyncCallback1+  , asyncCallback2+  , asyncCallback3+  , syncCallback+  , syncCallback1+  , syncCallback2+  , syncCallback3+  , syncCallback'+  , syncCallback1'+  , syncCallback2'+  , syncCallback3'+  -- * DSL FFI+  , invokeFunction+  , setProp_ffi+  , new_ffi+  , getProp_ffi+  , eval_ffi+  , setPropIndex_ffi+  , getPropIndex_ffi+  , create_ffi+    -- *** Misc. FFI+  , global+  , isUndefined_ffi+  , isNull_ffi+  , jsNull+  , freeFunction_ffi+  , listProps_ffi+  , requestAnimationFrame+  , cancelAnimationFrame+  -- *** String FFI+  , parseInt+  , parseDouble+  , parseWord+  , parseFloat+  , toString_Double+  , toString_Float+  , toString_Word+  , toString_Int+  ) where+-----------------------------------------------------------------------------+import           Data.JSString+import           Data.Text+-----------------------------------------------------------------------------+import qualified GHCJS.Marshal as Marshal+import           GHCJS.Types+#ifdef GHCJS_NEW+import           GHC.JS.Prim+import qualified GHC.JS.Foreign.Callback as Callback+#elif GHCJS_OLD+import           GHCJS.Prim+import qualified GHCJS.Foreign.Callback as Callback+#endif+-----------------------------------------------------------------------------+foreign import javascript safe+#ifdef GHCJS_NEW+  "(($1,$2) => { return $1 === $2; })"+#else+  "$r = $1 === $2;"+#endif+  eq :: JSVal -> JSVal -> Bool+-----------------------------------------------------------------------------+instance Eq JSVal where+  (==) = eq+  {-# INLINE (==) #-}+-----------------------------------------------------------------------------+toJSVal_Bool :: Bool -> IO JSVal+toJSVal_Bool = Marshal.toJSVal+{-# INLINE toJSVal_Bool #-}+-----------------------------------------------------------------------------+toJSVal_Double :: Double -> IO JSVal+toJSVal_Double = Marshal.toJSVal+{-# INLINE toJSVal_Double #-}+-----------------------------------------------------------------------------+toJSVal_Int :: Int -> IO JSVal+toJSVal_Int = Marshal.toJSVal+{-# INLINE toJSVal_Int #-}+-----------------------------------------------------------------------------+toJSVal_List :: [JSVal] -> IO JSVal+toJSVal_List = Marshal.toJSVal+{-# INLINE toJSVal_List #-}+-----------------------------------------------------------------------------+fromJSVal_Bool :: JSVal -> IO (Maybe Bool)+fromJSVal_Bool = Marshal.fromJSVal+{-# INLINE fromJSVal_Bool #-}+-----------------------------------------------------------------------------+foreign import javascript safe+#ifdef GHCJS_NEW+  "(($1,$2) => { return new $1(...$2) })"+#else+  "$r = Reflect.construct($1, $2);"+#endif+  new_ffi :: JSVal -> JSVal -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1) => { return eval($1); })"+#else+  "$r = eval($1);"+#endif+  eval_ffi :: JSString -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(() => { return {}; })"+#else+  "$r = {};"+#endif+  create_ffi :: IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1,$2) => { return $2[$1]; })"+#else+  "$r=$2[$1]"+#endif+  getProp_ffi :: JSString -> JSVal -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1,$2,$3) => { return $3[$1]=$2; })"+#else+  "$3[$1]=$2"+#endif+  setProp_ffi+    :: JSString+    -- ^ Key+    -> JSVal+    -- ^ Value+    -> JSVal+    -- ^ Object+    -> IO ()+-----------------------------------------------------------------------------+fromJSVal_Int :: JSVal -> IO (Maybe Int)+fromJSVal_Int = Marshal.fromJSVal+{-# INLINE fromJSVal_Int #-}+-----------------------------------------------------------------------------+fromJSVal_Double :: JSVal -> IO (Maybe Double)+fromJSVal_Double  = Marshal.fromJSVal+{-# INLINE fromJSVal_Double #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1,$2) => { return $2[$1]; })"+#else+  "$r=$2[$1]"+#endif+  getPropIndex_ffi :: Int -> JSVal -> IO JSVal+-----------------------------------------------------------------------------+isNull_ffi :: JSVal -> Bool+isNull_ffi = isNull+{-# INLINE isNull_ffi #-}+-----------------------------------------------------------------------------+isUndefined_ffi :: JSVal -> Bool+isUndefined_ffi = isUndefined+{-# INLINE isUndefined_ffi #-}+-----------------------------------------------------------------------------+freeFunction_ffi :: JSVal -> IO ()+freeFunction_ffi _ = pure ()+{-# INLINE freeFunction_ffi #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1) => { return requestAnimationFrame($1); })"+#else+  "$r = requestAnimationFrame($1);"+#endif+  requestAnimationFrame :: JSVal -> IO Int+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1) => { return cancelAnimationFrame($1); })"+#else+  "cancelAnimationFrame($1);"+#endif+  cancelAnimationFrame :: Int -> IO ()+-----------------------------------------------------------------------------+toJSVal_JSString :: JSString -> IO JSVal+toJSVal_JSString = Marshal.toJSVal+{-# INLINE toJSVal_JSString #-}+-----------------------------------------------------------------------------+fromJSValUnchecked_Maybe :: JSVal -> IO (Maybe JSVal)+fromJSValUnchecked_Maybe = Marshal.fromJSValUnchecked+{-# INLINE fromJSValUnchecked_Maybe #-}+-----------------------------------------------------------------------------+fromJSVal_Maybe :: JSVal -> IO (Maybe (Maybe JSVal))+fromJSVal_Maybe = Marshal.fromJSVal+{-# INLINE fromJSVal_Maybe #-}+-----------------------------------------------------------------------------+fromJSValUnchecked_Bool :: JSVal -> IO Bool+fromJSValUnchecked_Bool = Marshal.fromJSValUnchecked+{-# INLINE fromJSValUnchecked_Bool #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1,$2,$3) => { return $1.apply($2, $3); })"+#else+  "$r = $1.apply($2, $3);"+#endif+  invokeFunction :: JSVal -> JSVal -> JSVal -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1) => { return Object.keys($1); })"+#else+  "$r = Object.keys($1);"+#endif+  listProps_ffi :: JSVal -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1,$2,$3) => { return $3[$1]=$2; })"+#else+  "$3[$1]=$2"+#endif+  setPropIndex_ffi+    :: Int+    -- ^ Key+    -> JSVal+    -- ^ Value+    -> JSVal+    -- ^ Object+    -> IO ()+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(() => { return globalThis; })"+#else+  "$r = globalThis"+#endif+  global :: JSVal+-----------------------------------------------------------------------------+fromJSVal_List :: JSVal -> IO (Maybe [JSVal])+fromJSVal_List = Marshal.fromJSVal+{-# INLINE fromJSVal_List #-}+-----------------------------------------------------------------------------+fromJSValUnchecked_Int :: JSVal -> IO Int+fromJSValUnchecked_Int = Marshal.fromJSValUnchecked+{-# INLINE fromJSValUnchecked_Int #-}+-----------------------------------------------------------------------------+fromJSValUnchecked_Double :: JSVal -> IO Double+fromJSValUnchecked_Double = Marshal.fromJSValUnchecked+{-# INLINE fromJSValUnchecked_Double #-}+-----------------------------------------------------------------------------+fromJSVal_JSString :: JSVal -> IO (Maybe JSString)+fromJSVal_JSString = Marshal.fromJSVal+{-# INLINE fromJSVal_JSString #-}+-----------------------------------------------------------------------------+toJSVal_Char :: Char -> IO JSVal+toJSVal_Char = Marshal.toJSVal+{-# INLINE toJSVal_Char #-}+-----------------------------------------------------------------------------+toJSVal_Float :: Float -> IO JSVal+toJSVal_Float = Marshal.toJSVal+{-# INLINE toJSVal_Float #-}+-----------------------------------------------------------------------------+toJSVal_Text :: Text -> IO JSVal+toJSVal_Text = Marshal.toJSVal+{-# INLINE toJSVal_Text #-}+-----------------------------------------------------------------------------+fromJSVal_Text :: JSVal -> IO (Maybe Text)+fromJSVal_Text = Marshal.fromJSVal+{-# INLINE fromJSVal_Text #-}+-----------------------------------------------------------------------------+fromJSValUnchecked_Text :: JSVal -> IO Text+fromJSValUnchecked_Text = Marshal.fromJSValUnchecked+{-# INLINE fromJSValUnchecked_Text #-}+-----------------------------------------------------------------------------+fromJSVal_Char :: JSVal -> IO (Maybe Char)+fromJSVal_Char = Marshal.fromJSVal+{-# INLINE fromJSVal_Char #-}+-----------------------------------------------------------------------------+fromJSValUnchecked_Char :: JSVal -> IO Char+fromJSValUnchecked_Char = Marshal.fromJSValUnchecked+{-# INLINE fromJSValUnchecked_Char #-}+-----------------------------------------------------------------------------+fromJSVal_Float :: JSVal -> IO (Maybe Float)+fromJSVal_Float = Marshal.fromJSVal+{-# INLINE fromJSVal_Float #-}+-----------------------------------------------------------------------------+fromJSValUnchecked_Float :: JSVal -> IO Float+fromJSValUnchecked_Float = Marshal.fromJSValUnchecked+{-# INLINE fromJSValUnchecked_Float #-}+-----------------------------------------------------------------------------+asyncCallback :: IO () -> IO JSVal+asyncCallback x = jsval <$> Callback.asyncCallback x+{-# INLINE asyncCallback #-}+asyncCallback1 :: (JSVal -> IO ()) -> IO JSVal+asyncCallback1 x = jsval <$> Callback.asyncCallback1 x+{-# INLINE asyncCallback1 #-}+asyncCallback2 :: (JSVal -> JSVal -> IO ()) -> IO JSVal+asyncCallback2 x = jsval <$> Callback.asyncCallback2 x+{-# INLINE asyncCallback2 #-}+asyncCallback3 :: (JSVal -> JSVal -> JSVal -> IO ()) -> IO JSVal+asyncCallback3 x = jsval <$> Callback.asyncCallback3 x+{-# INLINE asyncCallback3 #-}+-----------------------------------------------------------------------------+syncCallback :: IO () -> IO JSVal+syncCallback x = jsval <$> Callback.syncCallback Callback.ThrowWouldBlock x+{-# INLINE syncCallback #-}+syncCallback1 :: (JSVal -> IO ()) -> IO JSVal+syncCallback1 x = jsval <$> Callback.syncCallback1 Callback.ThrowWouldBlock x+{-# INLINE syncCallback1 #-}+syncCallback2 :: (JSVal -> JSVal -> IO ()) -> IO JSVal+syncCallback2 x = jsval <$> Callback.syncCallback2 Callback.ThrowWouldBlock x+{-# INLINE syncCallback2 #-}+syncCallback3 :: (JSVal -> JSVal -> JSVal -> IO ()) -> IO JSVal+syncCallback3 x = jsval <$> Callback.syncCallback3 Callback.ThrowWouldBlock x+{-# INLINE syncCallback3 #-}+-----------------------------------------------------------------------------+syncCallback' :: IO JSVal -> IO JSVal+syncCallback' x = jsval <$> Callback.syncCallback' x+{-# INLINE syncCallback' #-}+syncCallback1' :: (JSVal -> IO JSVal) -> IO JSVal+syncCallback1' x = jsval <$> Callback.syncCallback1' x+{-# INLINE syncCallback1' #-}+syncCallback2' :: (JSVal -> JSVal -> IO JSVal) -> IO JSVal+syncCallback2' x = jsval <$> Callback.syncCallback2' x+{-# INLINE syncCallback2' #-}+syncCallback3' :: (JSVal -> JSVal -> JSVal -> IO JSVal) -> IO JSVal+syncCallback3' x = jsval <$> Callback.syncCallback3' x+{-# INLINE syncCallback3' #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1) => { return parseInt($1); })"+#else+  "$r = parseInt($1)"+#endif+  parseInt_Unchecked :: JSString -> Double+-----------------------------------------------------------------------------+parseWord :: JSString -> Maybe Word+parseWord string = fromIntegral <$> parseInt string+{-# INLINE parseWord #-}+-----------------------------------------------------------------------------+parseInt :: JSString -> Maybe Int+parseInt string =+  case parseInt_Unchecked string of+    double | isNaN double -> Nothing+           | otherwise -> Just (round double)+{-# INLINE parseInt #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1) => { return parseFloat($1); })"+#else+  "$r = parseFloat($1)"+#endif+  parseDouble_Unchecked :: JSString -> Double+-----------------------------------------------------------------------------+parseDouble :: JSString -> Maybe Double+parseDouble string =+  case parseDouble_Unchecked string of+    double | isNaN double -> Nothing+           | otherwise -> Just double+{-# INLINE parseDouble #-}+-----------------------------------------------------------------------------+parseFloat :: JSString -> Maybe Float+parseFloat string = realToFrac <$> parseDouble string+{-# INLINE parseFloat #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1) => { return ($1).toString(); })"+#else+  "$r = String($1);"+#endif+  toString_Int :: Int -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1) => { return ($1).toString(); })"+#else+  "$r = String($1);"+#endif+  toString_Double :: Double -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1) => { return ($1).toString(); })"+#else+  "$r = String($1);"+#endif+  toString_Float :: Float -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+#if GHCJS_NEW+  "(($1) => { return ($1).toString(); })"+#else+  "$r = String($1);"+#endif+  toString_Word :: Word -> JSString+-----------------------------------------------------------------------------
+ ffi/wasm/Data/JSString.hs view
@@ -0,0 +1,920 @@+-----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultilineStrings  #-}+{-# LANGUAGE UnboxedTuples     #-}+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE MagicHash         #-}+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+module Data.JSString+  ( -- * Types+    JSString (..)+    -- * Creation and elimination+  , pack+  , unpack+  , singleton+  , empty+    -- * Basic interface+  , cons+  , snoc+  , append+  , uncons+  , unsnoc+  , head+  , last+  , tail+  , init+  , null+  , length+  , compareLength+    -- * Transformations+  , map+  , intercalate+  , intersperse+  , transpose+  , reverse+  , replace+    -- ** Case conversion+  , toCaseFold+  , toLower+  , toUpper+  , toTitle+    -- ** Justification+  , justifyLeft+  , justifyRight+  , center+    -- * Folds+  , foldl+  , foldl'+  , foldl1+  , foldr+  , foldr1+    -- ** Special folds+  , concat+  , concatMap+  , any+  , all+  , maximum+  , minimum+    -- * Construction+    -- ** Scans+  , scanl+  , scanl1+  , scanr+  , scanr1+    -- ** Accumulating maps+  , mapAccumL+  , mapAccumR+    -- ** Generation and unfolding+  , replicate+  , unfoldr+  , unfoldrN+    -- * Substrings+    -- ** Breaking strings+  , take+  , takeEnd+  , drop+  , dropEnd+  , takeWhile+  , takeWhileEnd+  , dropWhile+  , dropWhileEnd+  , dropAround+  , strip+  , stripStart+  , stripEnd+  , splitAt+  , breakOn+  , breakOnEnd+  , break+  , span+  , group+  , groupBy+  , inits+  , tails+  -- ** Breaking into many substrings+  , splitOn+  , split+  , chunksOf+  -- ** Breaking into lines and words+  , lines+  , words+  , unlines+  , unwords+  -- * Predicates+  , isPrefixOf+  , isSuffixOf+  , isInfixOf+    -- ** View patterns+  , stripPrefix+  , stripSuffix+  , commonPrefixes+    -- * Searching+  , filter+  -- , breakOnAll+  , find+  , partition+    -- * Indexing+  , index+  , findIndex+  , count+    -- * Zipping+  , zip+  , zipWith+   -- * Misc+  , textFromJSString+  , textToJSString+  , toJSString+  , fromJSString+  , toString_Double+  , toString_Float+  , toString_Word+  , toString_Int+  ) where+-----------------------------------------------------------------------------+import           Data.Array.Byte (ByteArray(..))+import           Data.Text.Internal hiding (pack, empty, append)+import           GHC.Exts+import           GHC.IO+import           GHC.Wasm.Prim+import qualified Data.List as List+import qualified Data.Text as T+import           Prelude+  hiding ( length, head, tail, filter, zip+         , zipWith, unlines, unwords, null+         , map, reverse, foldl', last, init+         , foldl, foldl1, foldr, foldr1, concat+         , concatMap, any, maximum, all, minimum+         , scanl, scanl1, scanr, scanr1, replicate+         , take, drop, takeWhile, dropWhile, splitAt+         , break, span, lines, words+         )+-----------------------------------------------------------------------------+pack :: String -> JSString+{-# INLINE pack #-}+pack = toJSString+-----------------------------------------------------------------------------+empty :: JSString+{-# INLINE empty #-}+empty = mempty+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return String.fromCharCode($1) + $2;+  """ cons :: Char -> JSString -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1 + String.fromCharCode($2);+  """ snoc :: JSString -> Char -> JSString+-----------------------------------------------------------------------------+append :: JSString -> JSString -> JSString+{-# INLINE append #-}+append = mappend+-----------------------------------------------------------------------------+unsnoc :: JSString -> Maybe (JSString, Char) +{-# INLINE unsnoc #-}+unsnoc s+  | 0 <- length s = Nothing+  | otherwise = Just (init s, last s)+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1.length === 0) throw new Error ('last: empty string');+  return $1.slice(-1).charCodeAt();+  """ last :: JSString -> Char+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1.length === 0) throw new Error ('init: empty string');+  return $1.slice(0,-1);+  """ init :: JSString -> JSString+-----------------------------------------------------------------------------+compareLength :: JSString -> Int -> Ordering+{-# INLINE compareLength #-}+compareLength str = compare (length str)+-----------------------------------------------------------------------------+map :: (Char -> Char) -> JSString -> JSString+{-# INLINE map #-}+map f s =+  case uncons s of+    Nothing -> mempty+    Just (c, next) ->+      f c `cons` map f next+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  const sep = String.fromCharCode($1)+  if ($2.length === 0) return '';+  else if ($2.length === 1) return $2;+  else return $2.split('').join(sep);+  """ intersperse :: Char -> JSString -> JSString+-----------------------------------------------------------------------------+transpose :: [JSString] -> [JSString]+{-# INLINE transpose #-}+transpose = fmap toJSString . List.transpose . fmap fromJSString+-----------------------------------------------------------------------------+-- | Reverses a t'Miso.String.MisoString'+--+-- @+-- reverse "abc"+-- "cba"+-- @+foreign import javascript unsafe+  """+  return [...$1].reverse().join('');+  """ reverse :: JSString -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $3.replace($1,$2);+  """ replace :: JSString -> JSString -> JSString -> JSString+-----------------------------------------------------------------------------+toCaseFold :: JSString -> JSString+{-# INLINE toCaseFold #-}+toCaseFold = textToJSString . T.toCaseFold . textFromJSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1.toLowerCase();+  """ toLower :: JSString -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1.toUpperCase();+  """ toUpper :: JSString -> JSString+-----------------------------------------------------------------------------+toTitle :: JSString -> JSString+{-# INLINE toTitle #-}+toTitle = textToJSString . T.toTitle . textFromJSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1 <= $3.length) return $3;+  let paddings = $1 - $3.length;+  while (paddings > 0) {+    $3 += String.fromCharCode($2);+    paddings--;+  }+  return $3;+  """ justifyLeft :: Int -> Char -> JSString -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1 <= $3.length) return $3;+  let paddings = $1 - $3.length;+  while (paddings > 0) {+    $3 = String.fromCharCode($2) + $3;+    paddings--;+  }+  return $3;+  """ justifyRight :: Int -> Char -> JSString -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1 <= $3.length) return $3;+  let paddings = ($1 - $3.length) / 2;+  let left = Math.ceil(paddings);+  let right = Math.floor(paddings);+  while (left > 0) {+    $3 = String.fromCharCode($2) + $3;+    left--;+  }+  while (right > 0) {+    $3 += String.fromCharCode($2);+    right--;+  }+  return $3;+  """ center :: Int -> Char -> JSString -> JSString+-----------------------------------------------------------------------------+foldl :: (a -> Char -> a) -> a -> JSString -> a+{-# INLINE foldl #-}+foldl f x ys =+  case uncons ys of+    Nothing -> x+    Just (c, next) -> foldl f (f x c) next+-----------------------------------------------------------------------------+foldl1 :: (Char -> Char -> Char) -> JSString -> Char+{-# INLINE foldl1 #-}+foldl1 f xs =+  case uncons xs of+    Nothing -> error "foldl1: empty string"+    Just (c,next) ->+      foldl f c next+-----------------------------------------------------------------------------+foldr :: (Char -> a -> a) -> a -> JSString -> a+{-# INLINE foldr #-}+foldr f x ys =+  case uncons ys of+    Nothing -> x+    Just (c, next) ->+      f c (foldr f x next)+-----------------------------------------------------------------------------+foldr1 :: (Char -> Char -> Char) -> JSString -> Char+{-# INLINE foldr1 #-}+foldr1 f ys =+  case uncons ys of+    Nothing -> error "foldr1: empty string"+    Just (c, next)+      | length next == 0 -> c+      | otherwise -> f c (foldr1 f next)+-----------------------------------------------------------------------------+any :: (Char -> Bool) -> JSString -> Bool+{-# INLINE any #-}+any f str =+  case uncons str of+    Nothing -> False+    Just (c, next) ->+      f c || any f next+-----------------------------------------------------------------------------+all :: (Char -> Bool) -> JSString -> Bool+{-# INLINE all #-}+all f str =+  case uncons str of+    Nothing -> True+    Just (c, next) ->+      f c && all f next+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1.length === 0) throw new Error ('maximum: empty string');++  let max = $1[0].charCodeAt();+  for (let i = 0; i < $1.length; i++) {+    if (max < $1[i].charCodeAt()) {+      max = $1[i].charCodeAt();+    }+  }+  return max;+  """ maximum :: JSString -> Char+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1.length === 0) throw new Error ('minimum: empty string');++  let min = $1[0].charCodeAt();+  for (let i = 0; i < $1.length; i++) {+    if ($1[i].charCodeAt() < min) {+      min = $1[i].charCodeAt();+    }+  }+  return min;+  """ minimum :: JSString -> Char+-----------------------------------------------------------------------------+scanl :: (Char -> Char -> Char) -> Char -> JSString -> JSString+{-# INLINE scanl #-}+scanl f x ys =+  case uncons ys of+    Nothing -> singleton x+    Just (c, next) ->+      x `cons` scanl f (f x c) next+-----------------------------------------------------------------------------+scanl1 :: (Char -> Char -> Char) -> JSString -> JSString+{-# INLINE scanl1 #-}+scanl1 f ys =+  case uncons ys of+    Nothing -> mempty+    Just (c, next) ->+      scanl f c next +-----------------------------------------------------------------------------+scanr :: (Char -> Char -> Char) -> Char -> JSString -> JSString+{-# INLINE scanr #-}+scanr f q0 ys = +  case uncons ys of+    Nothing -> singleton q0+    Just (x, xs) ->+      case uncons (scanr f q0 xs) of+        Just (q, qss) -> do+          let qs = q `cons` qss+          f x q `cons` qs+        Nothing -> error "scanr: impossible" +-----------------------------------------------------------------------------+scanr1 :: (Char -> Char -> Char) -> JSString -> JSString+{-# INLINE scanr1 #-}+scanr1 f ys = +  case uncons ys of+    Nothing -> mempty+    Just (x, xs)+      | length xs == 0 -> singleton x+      | otherwise -> do+          case uncons (scanr1 f xs) of+            Just (q, qss) -> f x q `cons` (q `cons` qss)+            Nothing -> error "scanr: impossible" +-----------------------------------------------------------------------------+mapAccumL :: (a -> Char -> (a, Char)) -> a -> JSString -> (a, JSString)+{-# INLINE mapAccumL #-}+mapAccumL f x str =+  case uncons str of+    Nothing -> (x, str)+    Just (c, next) -> do+      let (a, c') = f x c+      cons c' <$> mapAccumL f a next+-----------------------------------------------------------------------------+mapAccumR :: (a -> Char -> (a, Char)) -> a -> JSString -> (a, JSString)+{-# INLINE mapAccumR #-}+mapAccumR f x str =+  case uncons str of+    Nothing -> (x, str)+    Just (c, next) ->+      case mapAccumR f x next of+        (a, qs) ->+          case f a c of+            (a', k) -> (a', k `cons` qs)+-----------------------------------------------------------------------------+unfoldr :: (a -> Maybe (Char, a)) -> a -> JSString+{-# INLINE unfoldr #-}+unfoldr f x = do+  case f x of+    Nothing -> mempty+    Just (c, y) ->+      c `cons` unfoldr f y+-----------------------------------------------------------------------------+unfoldrN :: Int -> (a -> Maybe (Char, a)) -> a -> JSString+{-# INLINE unfoldrN #-}+unfoldrN n f seed = go seed mempty+  where+    go x acc+      | length acc == n = acc+      | otherwise =+          case f x of+            Nothing -> mempty+            Just (c,y) -> go y (c `cons` acc)+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1 < 1) return "";+  return $2.slice(0, $1);+  """ take :: Int -> JSString -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1 < 1) return "";+  return $2.slice(-$1);+  """ takeEnd :: Int -> JSString -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1 < 1) return "";+  return $2.slice(0, -$1);+  """ dropEnd :: Int -> JSString -> JSString+-----------------------------------------------------------------------------+takeWhile :: (Char -> Bool) -> JSString -> JSString+{-# INLINE takeWhile #-}+takeWhile f xs =+  case uncons xs of+    Nothing -> mempty+    Just (c, next) ->+      if f c+        then c `cons` takeWhile f next+        else mempty+-----------------------------------------------------------------------------+takeWhileEnd :: (Char -> Bool) -> JSString -> JSString+{-# INLINE takeWhileEnd #-}+takeWhileEnd f = reverse . takeWhile f . reverse+-----------------------------------------------------------------------------+dropWhile :: (Char -> Bool) -> JSString -> JSString+{-# INLINE dropWhile #-}+dropWhile f xs =+  case uncons xs of+    Nothing -> xs+    Just (c, next) ->+      if f c+        then dropWhile f next+        else xs+-----------------------------------------------------------------------------+dropWhileEnd :: (Char -> Bool) -> JSString -> JSString+{-# INLINE dropWhileEnd #-}+dropWhileEnd f = reverse . dropWhile f . reverse+-----------------------------------------------------------------------------+dropAround :: (Char -> Bool) -> JSString -> JSString+{-# INLINE dropAround #-}+dropAround f = dropWhile f . dropWhileEnd f+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1.trim();+  """ strip :: JSString -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1.trimStart();+  """ stripStart :: JSString -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1.trimEnd();+  """ stripEnd :: JSString -> JSString+-----------------------------------------------------------------------------+splitAt :: Int -> JSString -> (JSString, JSString)+{-# INLINE splitAt #-}+splitAt n xs = (take n xs, drop n xs)+-----------------------------------------------------------------------------+breakOn :: JSString -> JSString -> (JSString, JSString)+{-# INLINE breakOn #-}+breakOn n _ | 0 <- length n = error "breakOn: empty needle"+breakOn needle haystack = go (mempty, haystack)+  where+    go (acc, stack) =+      if needle `isPrefixOf` stack+        then (acc, stack)+        else+          case uncons stack of+            Nothing -> (acc, stack)+            Just (c,next) ->+              go (acc `snoc` c, next)+-----------------------------------------------------------------------------+breakOnEnd :: JSString -> JSString -> (JSString, JSString)+{-# INLINE breakOnEnd #-}+breakOnEnd n _ | 0 <- length n = error "breakOnEnd: empty needle"+breakOnEnd needle haystack = go (mempty, haystack)+  where+    go (acc, stack) =+      if needle `isSuffixOf` stack+        then (stack, acc)+        else+          case unsnoc stack of+            Nothing -> (stack, acc)+            Just (next, c) ->+              go (c `cons` acc, next)+-----------------------------------------------------------------------------+break :: (Char -> Bool) -> JSString -> (JSString, JSString)+{-# INLINE break #-}+break f s = go (mempty, s)+  where+    go (failed, rest) =+      case uncons rest of+        Nothing -> (failed, rest)+        Just (c,next) ->+          if f c+            then (failed, c `cons` next)+            else go (failed `snoc` c, next)+-----------------------------------------------------------------------------+span :: (Char -> Bool) -> JSString -> (JSString, JSString)+{-# INLINE span #-}+span f s = (takeWhile f s, dropWhile f s)+-----------------------------------------------------------------------------+group :: JSString -> [JSString]+{-# INLINE group #-}+group = groupBy (==)+-----------------------------------------------------------------------------+groupBy :: (Char -> Char -> Bool) -> JSString -> [JSString]+{-# INLINE groupBy #-}+groupBy eq s' =+  case uncons s' of+    Nothing -> []+    Just (c, next) -> do+      let (ys, zs) = span (eq c) next+      (c `cons` ys) : groupBy eq zs+-----------------------------------------------------------------------------+inits :: JSString -> [JSString]+{-# INLINE inits #-}+inits s = +  case unsnoc s of+    Nothing -> [""]+    Just (next, _) -> inits next <> [s]+-----------------------------------------------------------------------------+tails :: JSString -> [JSString]+{-# INLINE tails #-}+tails s =+  case uncons s of+    Nothing -> [""]+    Just (_, next) -> s : tails next+-----------------------------------------------------------------------------+splitOn :: JSString -> JSString -> [JSString]+{-# INLINE splitOn #-}+splitOn prefix _ | 0 <- length prefix = error "splitOn: empty prefix"+splitOn prefix str = go str mempty+  where+    go s acc | 0 <- length s = [acc]+    go s acc = do+      if prefix `isPrefixOf` s+        then acc : go (drop (length prefix) s) mempty+        else+          case uncons s of+            Nothing -> [acc]+            Just (c,next) ->+              go next (acc `snoc` c)+-----------------------------------------------------------------------------+split :: (Char -> Bool) -> JSString -> [JSString]+{-# INLINE split #-}+split f = go+  where+    go str | 0 <- length str = [empty]+    go str = do+      let+        found = takeWhile (not . f) str+        next = drop 1 (dropWhile (not . f) str)+      found : go next+-----------------------------------------------------------------------------+chunksOf :: Int -> JSString -> [JSString]+{-# INLINE chunksOf #-}+chunksOf 0 _ = []+chunksOf n s =+  case (take n s, drop n s) of+    (hd, tl) ->+      if length tl == 0+        then [hd]+        else hd : chunksOf n tl+-----------------------------------------------------------------------------+lines :: JSString -> [JSString]+{-# INLINE lines #-}+lines = splitOn "\n"+-----------------------------------------------------------------------------+words :: JSString -> [JSString]+{-# INLINE words #-}+words s = go (strip s)+  where+    go xs | length xs == 0 = []+    go xs = do+      let next = dropWhile (==' ') xs+      let payload = takeWhile (/=' ') next+      payload : go (drop (length payload) next)+-----------------------------------------------------------------------------+unwords :: [JSString] -> JSString+{-# INLINE unwords #-}+unwords = intercalate " "+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $2.endsWith($1);+  """ isSuffixOf :: JSString -> JSString -> Bool+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $2.includes($1);+  """ isInfixOf :: JSString -> JSString -> Bool+-----------------------------------------------------------------------------+stripPrefix :: JSString -> JSString -> Maybe JSString+{-# INLINE stripPrefix #-}+stripPrefix prefix string+  | not (prefix `isPrefixOf` string) = Nothing+  | otherwise = Just (drop (length prefix) string)+-----------------------------------------------------------------------------+stripSuffix :: JSString -> JSString -> Maybe JSString+{-# INLINE stripSuffix #-}+stripSuffix suffix string+  | not (suffix `isSuffixOf` string) = Nothing+  | otherwise = Just (dropEnd (length suffix) string)+-----------------------------------------------------------------------------+commonPrefixes :: JSString -> JSString -> Maybe (JSString, JSString, JSString)+{-# INLINE commonPrefixes #-}+commonPrefixes ls rs | length ls == 0 || length rs == 0 = Nothing+commonPrefixes ls' rs' = go mempty ls' rs'+  where+    go acc ls rs =+      case (uncons ls, uncons rs) of+        (Just (l,lss), Just (r,rss)) ->+          if l == r+            then go (acc `snoc` l) lss rss+            else+              if null acc+                then Nothing+                else Just (acc, l `cons` lss, r `cons` rss)+        _ -> Nothing+-----------------------------------------------------------------------------+filter :: (Char -> Bool) -> JSString -> JSString+{-# INLINE filter #-}+filter f xs =+  case uncons xs of+    Nothing -> mempty+    Just (c,next) ->+      if f c+        then c `cons` filter f next+        else filter f next+-----------------------------------------------------------------------------+-- breakOnAll :: JSString -> JSString -> [(JSString, JSString)]+-- breakOnAll = error "TODO: implement breakOnAll"+-----------------------------------------------------------------------------+find :: (Char -> Bool) -> JSString -> Maybe Char+{-# INLINE find #-}+find f xs = do+  (c,next) <- uncons xs+  if f c+    then pure c+    else find f next+-----------------------------------------------------------------------------+partition :: (Char -> Bool) -> JSString -> (JSString, JSString)+{-# INLINE partition #-}+partition f xs = (filter f xs, filter (not . f) xs)+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1.length === 0) throw new Error ('index: empty string')+  return $1[$2].charCodeAt();+  """ index :: JSString -> Int -> Char+-----------------------------------------------------------------------------+findIndex :: (Char -> Bool) -> JSString -> Maybe Int+findIndex f xs = go xs+  where+    len = length xs - 1+    go zs = do+      (next, ys) <- uncons zs+      if f next+        then pure (len - length ys)+        else go ys+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1.length === 0) throw new Error ('count: empty string')+  return $2.split($1).length - 1;+  """ count :: JSString -> JSString -> Int+-----------------------------------------------------------------------------+zip :: JSString -> JSString -> [(Char,Char)]+{-# INLINE zip #-}+zip l r =+  case (uncons l, uncons r) of+    (Just (l',ls), Just (r',rs)) ->+      (l',r') : zip ls rs+    _ -> []+-----------------------------------------------------------------------------+zipWith :: (Char -> Char -> Char) -> JSString -> JSString -> JSString+{-# INLINE zipWith #-}+zipWith f l r =+  case (uncons l, uncons r) of+    (Just (l', ls), Just (r', rs)) ->+      f l' r' `cons` zipWith f ls rs+    _ -> mempty+-----------------------------------------------------------------------------+newtype JSUint8Array = JSUint8Array JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe "(new TextEncoder()).encode($1)"+  js_str_encode :: JSString -> IO JSUint8Array+-----------------------------------------------------------------------------+foreign import javascript unsafe "$1.byteLength"+  js_buf_len :: JSUint8Array -> IO Int+-----------------------------------------------------------------------------+foreign import javascript unsafe "(new Uint8Array(__exports.memory.buffer, $2, $1.byteLength)).set($1)"+  js_from_buf :: JSUint8Array -> Ptr a -> IO ()+-----------------------------------------------------------------------------+foreign import javascript unsafe "(new TextDecoder('utf-8', {fatal: true})).decode(new Uint8Array(__exports.memory.buffer, $1, $2))"+  js_to_str :: Ptr a -> Int -> IO JSString+-----------------------------------------------------------------------------+textFromJSString :: JSString -> Text+{-# INLINE textFromJSString #-}+textFromJSString str = unsafeDupablePerformIO $ do+  buf <- js_str_encode str+  I# len# <- js_buf_len buf+  IO $ \s0 -> case newByteArray# len# s0 of+    (# s1, mba# #) -> case unIO (js_from_buf buf (Ptr (mutableByteArrayContents# mba#))) s1 of+      (# s2, _ #) -> case unIO (freeJSVal (coerce buf)) s2 of+        (# s3, _ #) -> case unsafeFreezeByteArray# mba# s3 of+          (# s4, ba# #) -> (# s4, Text (ByteArray ba#) 0 (I# len#) #)+-----------------------------------------------------------------------------+textToJSString :: Text -> JSString+{-# INLINE textToJSString #-}+textToJSString (Text (ByteArray ba#) (I# off#) (I# len#)) = unsafeDupablePerformIO $+  IO $ \s0 -> case newPinnedByteArray# len# s0 of+    (# s1, mba# #) -> case copyByteArray# ba# off# mba# 0# len# s1 of+      s2 -> keepAlive# mba# s2 $ unIO $ js_to_str (Ptr (mutableByteArrayContents# mba#)) $ I# len#+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1.length === 0+  """ null :: JSString -> Bool+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1 < 1 || $2.length === 0) return $2;+  return $2.slice($1, $2.length);+  """ drop :: Int -> JSString -> JSString+-----------------------------------------------------------------------------+foldl' :: (a -> Char -> a) -> a -> JSString -> a+{-# INLINE foldl' #-}+foldl' f x ys =+  case uncons ys of+    Nothing -> x+    Just (c, next) -> do+      let !z = f x c+      foldl' f z next+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1.length+  """ length :: JSString -> Int+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $2.startsWith($1)+  """ isPrefixOf :: JSString -> JSString -> Bool+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return String.fromCharCode($1);+  """ singleton :: Char -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1.length === 0) throw new Error ('head: empty string');+  return $1.slice(0).charCodeAt();+  """ head :: JSString -> Char+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1.slice(1,$1.length)+  """ tail :: JSString -> JSString+-----------------------------------------------------------------------------+uncons :: JSString -> Maybe (Char, JSString)+{-# INLINE uncons #-}+uncons str+  | 0 <- length str = Nothing+  | otherwise = Just (head str, tail str)+-----------------------------------------------------------------------------+unpack :: JSString -> String+{-# INLINE unpack #-}+unpack = fromJSString+-----------------------------------------------------------------------------+intercalate :: JSString -> [JSString] -> JSString+{-# INLINE intercalate #-}+intercalate sep = \case+  [] -> mempty+  [x] -> x+  (x:xs) -> x <> sep <> intercalate sep xs+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1 === $2) return 0;+  else if ($1 > $2) return 1;+  else return -1;+  """ jsstringOrd :: JSString -> JSString -> Int+-----------------------------------------------------------------------------+concat :: [JSString] -> JSString+{-# INLINE concat #-}+concat = mconcat+-----------------------------------------------------------------------------+concatMap :: (Char -> JSString) -> JSString -> JSString+{-# INLINE concatMap #-}+concatMap f str =+  case uncons str of+    Nothing -> mempty+    Just (c, next) -> f c <> concatMap f next+-----------------------------------------------------------------------------+unlines :: [JSString] -> JSString+{-# INLINE unlines #-}+unlines ks = concat [ snoc k '\n' | k <- ks ]+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1 < 1) { return ''; }+  else if ($1 === 1) { return $2; }+  else {+    const inc = $2;+    while (--$1) {+      $2 += inc;+    }+    return $2;+  }+  """ replicate :: Int -> JSString -> JSString+----------------------------------------------------------------------------+instance Ord JSString where+  compare s1 s2 =+    case jsstringOrd s1 s2 of+      0 -> EQ+      1 -> GT+      (-1) -> LT+      _ -> error "jsstringOrd: impossible"+  {-# INLINE compare #-}+----------------------------------------------------------------------------+instance Eq JSString where+  (==) = jsstringEq+  {-# INLINE (==) #-}+----------------------------------------------------------------------------+instance Semigroup JSString where+  (<>) = jsstringMappend+  {-# INLINE (<>) #-}+----------------------------------------------------------------------------+instance Monoid JSString where+  mempty = jsstringMempty+  {-# INLINE mempty #-}+----------------------------------------------------------------------------+instance Show JSString where+  show = show . fromJSString+  {-# INLINE show #-}+----------------------------------------------------------------------------+instance IsString JSString where+  fromString = toJSString+  {-# INLINE fromString #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe "return $1 === $2"+  jsstringEq :: JSString -> JSString -> Bool+-----------------------------------------------------------------------------+foreign import javascript unsafe "return $1 + $2"+  jsstringMappend :: JSString -> JSString -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe "return ''"+  jsstringMempty :: JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe "return ($1).toString()"+  toString_Int :: Int -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe "return ($1).toString()"+  toString_Double :: Double -> JSString+-----------------------------------------------------------------------------+foreign import javascript unsafe "return ($1).toString()"+  toString_Float :: Float -> JSString+-----------------------------------------------------------------------------+toString_Word :: Word -> JSString+{-# INLINE toString_Word #-}+toString_Word = toJSString . show+-----------------------------------------------------------------------------
+ ffi/wasm/Miso/DSL/FFI.hs view
@@ -0,0 +1,480 @@+-----------------------------------------------------------------------------+{-# LANGUAGE LambdaCase               #-}+{-# LANGUAGE TemplateHaskell          #-}+{-# LANGUAGE MultilineStrings         #-}+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+module Miso.DSL.FFI+  ( -- ** Types+    JSVal+  , JSString (..)+    -- ** Serialization FFI+    -- *** ToJSVal+  , toJSVal_Char+  , toJSVal_Bool+  , toJSVal_Double+  , toJSVal_Float+  , toJSVal_Int+  , toJSVal_List+  , toJSVal_JSString+  , toJSVal_Text+    -- *** FromJSVal+  , fromJSVal_Text+  , fromJSValUnchecked_Text+  , fromJSVal_Char+  , fromJSValUnchecked_Char+  , fromJSVal_Bool+  , fromJSValUnchecked_Bool+  , fromJSVal_Double+  , fromJSValUnchecked_Double+  , fromJSVal_Float+  , fromJSValUnchecked_Float+  , fromJSVal_Int+  , fromJSValUnchecked_Int+  , fromJSVal_List+  , fromJSValUnchecked_List+  , fromJSVal_JSString+  , fromJSVal_Maybe+  , fromJSValUnchecked_Maybe+  -- * Callback FFI+  , asyncCallback+  , asyncCallback1+  , asyncCallback2+  , asyncCallback3+  , syncCallback+  , syncCallback1+  , syncCallback2+  , syncCallback3+  , syncCallback'+  , syncCallback1'+  , syncCallback2'+  , syncCallback3'+  -- * DSL FFI+  , invokeFunction+  , setProp_ffi+  , new_ffi+  , getProp_ffi+  , eval_ffi+  , setPropIndex_ffi+  , getPropIndex_ffi+  , create_ffi+    -- *** Misc. FFI+  , global+  , isUndefined_ffi+  , isNull_ffi+  , jsNull+  , freeFunction_ffi+  , requestAnimationFrame+  , cancelAnimationFrame+  , listProps_ffi+  -- *** String FFI+  , parseInt+  , parseDouble+  , parseWord+  , parseFloat+  ) where+-----------------------------------------------------------------------------+import           Data.Text (Text)+import           Control.Monad+import           Data.JSString (textFromJSString, textToJSString)+import           Prelude hiding (length, head, tail, unlines, concat, null, drop, replicate, concatMap)+-----------------------------------------------------------------------------+import           GHC.Wasm.Prim+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1 === $2;+  """ eq :: JSVal -> JSVal -> Bool+-----------------------------------------------------------------------------+instance Eq JSVal where+  (==) = eq+  {-# INLINE (==) #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  if ($1 === 0.0) return false;+  return true;+  """ toJSVal_Bool :: Bool -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1+  """ toJSVal_Double :: Double -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1+  """ toJSVal_Int :: Int -> IO JSVal+-----------------------------------------------------------------------------+toJSVal_List :: [JSVal] -> IO JSVal+toJSVal_List js = do+  arr <- newArray+  forM_ js (pushArray arr)+  pure arr+{-# INLINE toJSVal_List #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return [];+  """ newArray :: IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  $1.push($2)+  """ pushArray :: JSVal -> JSVal -> IO ()+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1+  """+  toJSVal_Char :: Char -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1+  """+  toJSVal_Float :: Float -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1+  """ fromJSValUnchecked_Float :: JSVal -> IO Float+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1+  """ fromJSValUnchecked_Char :: JSVal -> IO Char+-----------------------------------------------------------------------------+fromJSVal_Char :: JSVal -> IO (Maybe Char)+fromJSVal_Char x =+  if isNullOrUndefined x+    then pure Nothing+    else Just <$> fromJSValUnchecked_Char x+{-# INLINE fromJSVal_Char #-}+-----------------------------------------------------------------------------+toJSVal_JSString :: JSString -> IO JSVal+toJSVal_JSString (JSString jsval) = pure jsval+{-# INLINE toJSVal_JSString #-}+-----------------------------------------------------------------------------+fromJSVal_Text :: JSVal -> IO (Maybe Text)+fromJSVal_Text x =+  if isNullOrUndefined x+    then pure Nothing+    else Just <$> fromJSValUnchecked_Text x+{-# INLINE fromJSVal_Text #-}+-----------------------------------------------------------------------------+fromJSValUnchecked_Text :: JSVal -> IO Text+fromJSValUnchecked_Text t =+  pure $ textFromJSString (JSString t)+{-# INLINE fromJSValUnchecked_Text #-}+-----------------------------------------------------------------------------+toJSVal_Text :: Text -> IO JSVal+toJSVal_Text t =+  case textToJSString t of+    JSString jsval -> pure jsval+{-# INLINE toJSVal_Text #-}+-----------------------------------------------------------------------------+fromJSVal_Float :: JSVal -> IO (Maybe Float)+fromJSVal_Float x =+  if isNullOrUndefined x+    then pure Nothing+    else Just <$> fromJSValUnchecked_Float x+{-# INLINE fromJSVal_Float #-}+-----------------------------------------------------------------------------+fromJSVal_Bool :: JSVal -> IO (Maybe Bool)+fromJSVal_Bool x =+  if isNullOrUndefined x+    then pure Nothing+    else Just <$> fromJSValUnchecked_Bool x+{-# INLINE fromJSVal_Bool #-}+-----------------------------------------------------------------------------+fromJSVal_Int :: JSVal -> IO (Maybe Int)+fromJSVal_Int x =+  if isNullOrUndefined x+    then pure Nothing+    else Just <$> fromJSValUnchecked_Int x+{-# INLINE fromJSVal_Int #-}+-----------------------------------------------------------------------------+fromJSVal_Double :: JSVal -> IO (Maybe Double)+fromJSVal_Double x =+  if isNullOrUndefined x+    then pure Nothing+    else Just <$> fromJSValUnchecked_Double x+{-# INLINE fromJSVal_Double #-}+-----------------------------------------------------------------------------+fromJSVal_List :: JSVal -> IO (Maybe [JSVal])+fromJSVal_List x = do+  if isNullOrUndefined x+    then pure Nothing+    else do+      arrayLike <- isArray x+      if not arrayLike+        then pure Nothing+        else Just <$> fromJSValUnchecked_List x+{-# INLINE fromJSVal_List #-}+-----------------------------------------------------------------------------+fromJSValUnchecked_List :: JSVal -> IO [JSVal]+fromJSValUnchecked_List x = do+   len <- length x+   forM [ 0 .. len - 1 ] (flip getPropIndex_ffi x)+{-# INLINE fromJSValUnchecked_List #-}+-----------------------------------------------------------------------------+fromJSVal_JSString :: JSVal -> IO (Maybe JSString)+fromJSVal_JSString x = do+  if isNullOrUndefined x+    then pure Nothing+    else Just <$> jsstringFromJSVal x+{-# INLINE fromJSVal_JSString #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe "return $1" jsstringFromJSVal :: JSVal -> IO JSString+-----------------------------------------------------------------------------+isNullOrUndefined :: JSVal -> Bool+isNullOrUndefined x = isNull_ffi x || isUndefined_ffi x+{-# INLINE isNullOrUndefined #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1 === undefined;+  """ isUndefined_ffi :: JSVal -> Bool+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1 === null;+  """ isNull_ffi :: JSVal -> Bool+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return null;+  """ jsNull :: JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe "return globalThis" global :: JSVal+-----------------------------------------------------------------------------+foreign import javascript "wrapper"+  asyncCallback+    :: IO ()+    -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript "wrapper"+  asyncCallback1+    :: (JSVal -> IO ())+    -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript "wrapper"+  asyncCallback2+    :: (JSVal -> JSVal -> IO ())+    -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript "wrapper"+  asyncCallback3+    :: (JSVal -> JSVal -> JSVal -> IO ())+    -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript "wrapper sync"+  syncCallback+    :: IO ()+    -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript "wrapper sync"+  syncCallback1+    :: (JSVal -> IO ())+    -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript "wrapper sync"+  syncCallback2+    :: (JSVal -> JSVal -> IO ())+    -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript "wrapper sync"+  syncCallback3+    :: (JSVal -> JSVal -> JSVal -> IO ())+    -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript "wrapper sync"+  syncCallback'+    :: IO JSVal+    -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript "wrapper sync"+  syncCallback1'+    :: (JSVal -> IO JSVal)+    -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript "wrapper sync"+  syncCallback2'+    :: (JSVal -> JSVal -> IO JSVal)+    -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript "wrapper sync"+  syncCallback3'+    :: (JSVal -> JSVal -> JSVal -> IO JSVal)+    -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return Object.keys($1);+  """+  listProps_ffi :: JSVal -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1.apply($2, $3);+  """+  invokeFunction+    :: JSVal+    -- ^ Func+    -> JSVal+    -- ^ Obj+    -> JSVal+    -- ^ Args+    -> IO JSVal+    -- ^ Return value+-----------------------------------------------------------------------------+foreign import javascript unsafe+  "$3[$1]=$2"+  setPropIndex_ffi+    :: Int+    -- ^ Index+    -> JSVal+    -- ^ Value+    -> JSVal+    -- ^ Object+    -> IO ()+-----------------------------------------------------------------------------+foreign import javascript unsafe+  "$3[$1]=$2"+  setProp_ffi+    :: JSString+    -- ^ Field+    -> JSVal+    -- ^ Value+    -> JSVal+    -- ^ Object+    -> IO ()+-----------------------------------------------------------------------------+-- | Regular FFIs+-----------------------------------------------------------------------------+foreign import javascript unsafe+  "return new $1(...$2)"+  new_ffi+    :: JSVal+    -- ^ Constructor+    -> JSVal+    -- ^ Args+    -> IO JSVal+    -- ^ Return+-----------------------------------------------------------------------------+foreign import javascript unsafe "return {}" create_ffi :: IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe "return $2[$1]"+  getProp_ffi+    :: JSString+    -- ^ Key+    -> JSVal+    -- ^ Value+    -> IO JSVal+    -- ^ Return+-----------------------------------------------------------------------------+-- | Unsafe JS eval, use at your own risk! You have been warned+foreign import javascript unsafe+  """+  return eval($1);+  """ eval_ffi :: JSString -> IO JSVal+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1+  """ fromJSValUnchecked_Int :: JSVal -> IO Int+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1+  """ fromJSValUnchecked_Double :: JSVal -> IO Double+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1+  """ fromJSValUnchecked_Bool :: JSVal -> IO Bool+-----------------------------------------------------------------------------+foreign import javascript unsafe "return $2[$1]"+  getPropIndex_ffi+    :: Int+    -- ^ Key+    -> JSVal+    -- ^ Value+    -> IO JSVal+    -- ^ Return+-----------------------------------------------------------------------------+freeFunction_ffi :: JSVal -> IO ()+freeFunction_ffi = freeJSVal+{-# INLINE freeFunction_ffi #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return requestAnimationFrame($1);+  """ requestAnimationFrame :: JSVal -> IO Int+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return cancelAnimationFrame($1);+  """ cancelAnimationFrame :: Int -> IO ()+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return Array.isArray($1);+  """ isArray :: JSVal -> IO Bool+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return $1.length+  """ length :: JSVal -> IO Int+-----------------------------------------------------------------------------+fromJSVal_Maybe :: JSVal -> IO (Maybe (Maybe JSVal))+fromJSVal_Maybe jsval = do+  if isNullOrUndefined jsval+    then pure (Just Nothing)+    else pure $ Just (Just jsval)+{-# INLINE fromJSVal_Maybe #-}+-----------------------------------------------------------------------------+fromJSValUnchecked_Maybe :: JSVal -> IO (Maybe JSVal)+fromJSValUnchecked_Maybe jsval = do+  if isNullOrUndefined jsval+    then pure Nothing+    else pure (Just jsval)+{-# INLINE fromJSValUnchecked_Maybe #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return parseInt($1);+  """+  parseInt_Unchecked :: JSString -> Double+-----------------------------------------------------------------------------+parseWord :: JSString -> Maybe Word+parseWord string = fromIntegral <$> parseInt string+{-# INLINE parseWord #-}+-----------------------------------------------------------------------------+parseInt :: JSString -> Maybe Int+parseInt string = do+  case parseInt_Unchecked string of+    double | isNaN double -> Nothing+           | otherwise -> Just (round double)+{-# INLINE parseInt #-}+-----------------------------------------------------------------------------+foreign import javascript unsafe+  """+  return parseFloat($1);+  """+  parseDouble_Unchecked :: JSString -> Double+-----------------------------------------------------------------------------+parseDouble :: JSString -> Maybe Double+parseDouble string = do+  case parseDouble_Unchecked string of+    double | isNaN double -> Nothing+           | otherwise -> Just double+{-# INLINE parseDouble #-}+-----------------------------------------------------------------------------+parseFloat :: JSString -> Maybe Float+parseFloat string = realToFrac <$> parseDouble string+{-# INLINE parseFloat #-}+-----------------------------------------------------------------------------
+ ffi/wasm/Miso/DSL/TH.hs view
@@ -0,0 +1,40 @@+-----------------------------------------------------------------------------+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE TemplateHaskell     #-}+{-# LANGUAGE LambdaCase          #-}+-----------------------------------------------------------------------------+module Miso.DSL.TH (evalTH) where+-----------------------------------------------------------------------------+import Control.Exception+import Language.Haskell.TH qualified as TH+import Language.Haskell.TH.Syntax qualified as TH+-----------------------------------------------------------------------------+-- | This is from @amesgen. It's a workaround until we can have proper+-- support for js-sources. It constructs an FFI declaration to import @miso.js@.+--+evalTH :: String -> [TH.Q TH.Type] -> TH.Q TH.Exp+evalTH jsChunk argTys = do+  ffiImportName <- TH.newName . show =<< TH.newName "wasm_ffi_import_eval"+  sig <- mkSig argTys+  let ffiImport =+        TH.ForeignD $+          TH.ImportF+            TH.JavaScript+            TH.Unsafe+            jsChunk+            ffiImportName+            sig+  TH.addTopDecls [ffiImport]++  argNames <- traverse (\_ -> TH.newName "x") argTys+  let argPats = TH.varP <$> argNames+      argExps = TH.varE <$> argNames+  -- Safe FFI imports return a thunk that needs to be evaluated to make sure+  -- that the FFI call actually completed ('unsafeInterleaveIO'-like). To avoid+  -- surprises, use this unconditionally.+  TH.lamE argPats [|evaluate =<< $(TH.appsE $ TH.varE ffiImportName : argExps)|]+  where+    mkSig = \case+      [] -> [t|IO ()|]+      t : ts -> [t|$t -> $(mkSig ts)|]+-----------------------------------------------------------------------------
+ ffi/wasm/Miso/DSL/TH/File.hs view
@@ -0,0 +1,20 @@+-----------------------------------------------------------------------------+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE TemplateHaskell     #-}+-----------------------------------------------------------------------------+module Miso.DSL.TH.File (evalFile) where+-----------------------------------------------------------------------------+import Language.Haskell.TH qualified as TH+-----------------------------------------------------------------------------+import Miso.DSL.TH (evalTH)+-----------------------------------------------------------------------------+-- | Like 'eval', but read the JS code to evaluate from a file.+evalFile+  :: FilePath+  -- ^ Path to JS file that will be converted into an FFI declaration.+  -> TH.Q TH.Exp+evalFile path = eval_ =<< TH.runIO (readFile path)+  where+    eval_ :: String -> TH.Q TH.Exp+    eval_ chunk = [| $(Miso.DSL.TH.evalTH chunk []) :: IO () |]+-----------------------------------------------------------------------------
− frontend-src/Miso.hs 
@@ -1,168 +0,0 @@-{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE CPP                 #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE LambdaCase          #-}-{-# LANGUAGE RecordWildCards     #-}-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE KindSignatures      #-}--#ifdef IOS-#else-{-# LANGUAGE TemplateHaskell     #-}-#endif--------------------------------------------------------------------------------- |--- Module      :  Miso--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso-  ( miso-  , startApp-  , module Miso.Effect-  , module Miso.Event-  , module Miso.Html-  , module Miso.Subscription-  , module Miso.Types-  , module Miso.Router-  , module Miso.Util-  , module Miso.FFI-  ) where--import           Control.Concurrent-import           Control.Monad-import           Control.Monad.IO.Class-import           Data.IORef-import           Data.List-import           Data.Sequence ((|>))-import           System.Mem.StableName-import qualified Data.Sequence as S-import qualified JavaScript.Object.Internal as OI--#ifdef JSADDLE-import           Language.Javascript.JSaddle (eval, waitForAnimationFrame)-#ifdef IOS-import           Miso.JSBits-#else-import           GHCJS.Types (JSString)-import           Data.FileEmbed-#endif-#else-import           JavaScript.Web.AnimationFrame-#endif--import           Miso.Concurrent-import           Miso.Delegate-import           Miso.Diff-import           Miso.Effect-import           Miso.Event-import           Miso.FFI-import           Miso.Html-import           Miso.Router-import           Miso.Subscription-import           Miso.Types-import           Miso.Util---- | Helper function to abstract out common functionality between `startApp` and `miso`-common-  :: Eq model-  => App model action-  -> model-  -> (Sink action -> JSM (IORef VTree))-  -> JSM ()-common App {..} m getView = do-#ifdef JSADDLE-#ifdef IOS-  mapM_ eval [delegateJs,diffJs,isomorphicJs,utilJs]-#else-  _ <- eval ($(embedStringFile "jsbits/delegate.js") :: JSString)-  _ <- eval ($(embedStringFile "jsbits/diff.js") :: JSString)-  _ <- eval ($(embedStringFile "jsbits/isomorphic.js") :: JSString)-  _ <- eval ($(embedStringFile "jsbits/util.js") :: JSString)-#endif-#endif-  -- init Notifier-  Notify {..} <- liftIO newNotify-  -- init empty actions-  actionsRef <- liftIO (newIORef S.empty)-  let writeEvent a = void . liftIO . forkIO $ do-        atomicModifyIORef' actionsRef $ \as -> (as |> a, ())-        notify-  -- init Subs-  forM_ subs $ \sub ->-    sub writeEvent-  -- Hack to get around `BlockedIndefinitelyOnMVar` exception-  -- that occurs when no event handlers are present on a template-  -- and `notify` is no longer in scope-  void . liftIO . forkIO . forever $ threadDelay (1000000 * 86400) >> notify-  -- Retrieves reference view-  viewRef <- getView writeEvent-  -- know thy mountElement-  mountEl <- mountElement mountPoint-  -- Begin listening for events in the virtual dom-  delegator mountEl viewRef events-  -- Process initial action of application-  writeEvent initialAction-  -- Program loop, blocking on SkipChan--  let-    loop !oldModel = liftIO wait >> do-        -- Apply actions to model-        actions <- liftIO $ atomicModifyIORef' actionsRef $ \actions -> (S.empty, actions)-        let (Acc newModel effects) = foldl' (foldEffects writeEvent update)-                                            (Acc oldModel (pure ())) actions-        effects-        oldName <- liftIO $ oldModel `seq` makeStableName oldModel-        newName <- liftIO $ newModel `seq` makeStableName newModel-        when (oldName /= newName && oldModel /= newModel) $ do-          swapCallbacks-          newVTree <- runView (view newModel) writeEvent-          oldVTree <- liftIO (readIORef viewRef)-          void $ waitForAnimationFrame-          (diff mountPoint) (Just oldVTree) (Just newVTree)-          releaseCallbacks-          liftIO (atomicWriteIORef viewRef newVTree)-        syncPoint-        loop newModel-  loop m---- | Runs an isomorphic miso application.--- Assumes the pre-rendered DOM is already present-miso :: Eq model => (URI -> App model action) -> JSM ()-miso f = do-  app@App {..} <- f <$> getCurrentURI-  common app model $ \writeEvent -> do-    let initialView = view model-    VTree (OI.Object iv) <- flip runView writeEvent initialView-    mountEl <- mountElement mountPoint-    -- Initial diff can be bypassed, just copy DOM into VTree-    copyDOMIntoVTree (logLevel == DebugPrerender) mountEl iv-    let initialVTree = VTree (OI.Object iv)-    -- Create virtual dom, perform initial diff-    liftIO (newIORef initialVTree)---- | Runs a miso application-startApp :: Eq model => App model action -> JSM ()-startApp app@App {..} =-  common app model $ \writeEvent -> do-    let initialView = view model-    initialVTree <- flip runView writeEvent initialView-    (diff mountPoint) Nothing (Just initialVTree)-    liftIO (newIORef initialVTree)---- | Helper-foldEffects-  :: Sink action-  -> (action -> model -> Effect action model)-  -> Acc model -> action -> Acc model-foldEffects sink update = \(Acc model as) action ->-  case update action model of-    Effect newModel effs -> Acc newModel newAs-      where-        newAs = as >> do-          forM_ effs $ \eff -> forkJSM (eff sink)--data Acc model = Acc !model !(JSM ())
− frontend-src/Miso/Delegate.hs 
@@ -1,32 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Miso.Delegate--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Delegate where--import           Control.Monad.IO.Class-import           Data.IORef-import qualified Data.Map as M-import           GHCJS.Marshal-import           GHCJS.Types (JSVal)-import qualified JavaScript.Object.Internal as OI-import           Miso.FFI-import           Miso.Html.Internal-import           Miso.String---- | Entry point for event delegation-delegator-  :: JSVal-  -> IORef VTree-  -> M.Map MisoString Bool-  -> JSM ()-delegator mountPointElement vtreeRef es = do-  evts <- toJSVal (M.toList es)-  delegateEvent mountPointElement evts $ do-    VTree (OI.Object val) <- liftIO (readIORef vtreeRef)-    pure val
− frontend-src/Miso/Dev.hs 
@@ -1,14 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Miso.Dev--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Dev-  ( clearBody-  ) where--import Miso.FFI (clearBody)
− frontend-src/Miso/Diff.hs 
@@ -1,49 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Miso.Diff--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Diff ( diff-                 , mountElement-                 ) where--import GHCJS.Foreign.Internal     hiding (Object)-import GHCJS.Types-import JavaScript.Object.Internal-import Miso.Html.Internal-import Miso.FFI---- | Entry point for diffing / patching algorithm-diff :: Maybe JSString -> Maybe VTree -> Maybe VTree -> JSM ()-diff mayElem current new =-  case mayElem of-    Nothing -> do-      body <- getBody-      diffElement body current new-    Just elemId -> do-      e <- getElementById elemId-      diffElement e current new---- | diffing / patching a given element-diffElement :: JSVal -> Maybe VTree -> Maybe VTree -> JSM ()-diffElement mountEl current new = do-  doc <- getDoc-  case (current, new) of-    (Nothing, Nothing) -> pure ()-    (Just (VTree current'), Just (VTree new')) -> do-      diff' current' new' mountEl doc-    (Nothing, Just (VTree new')) -> do-      diff' (Object jsNull) new' mountEl doc-    (Just (VTree current'), Nothing) -> do-      diff' current' (Object jsNull) mountEl doc---- | return the configured mountPoint element or the body-mountElement :: Maybe JSString -> JSM JSVal-mountElement mayMp =-  case mayMp of-    Nothing -> getBody-    Just eid -> getElementById eid
− frontend-src/Miso/Effect.hs 
@@ -1,97 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Miso.Effect--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------ This module defines `Effect` and `Sub` types, which are used to define--- `Miso.Types.update` function and `Miso.Types.subs` field of the `Miso.Types.App`.------------------------------------------------------------------------------module Miso.Effect (-  module Miso.Effect.Storage-, module Miso.Effect.DOM-, Effect (..), Sub, Sink-, mapSub-, noEff-, (<#)-, (#>)-, batchEff-, effectSub-) where--import Data.Bifunctor--import Control.Monad.IO.Class-import Miso.FFI (JSM)--import Miso.Effect.Storage-import Miso.Effect.DOM---- | An effect represents the results of an update action.------ It consists of the updated model and a list of subscriptions. Each 'Sub' is--- run in a new thread so there is no risk of accidentally blocking the--- application.-data Effect action model = Effect model [Sub action]---- | Type synonym for constructing event subscriptions.------ The 'Sink' callback is used to dispatch actions which are then fed--- back to the 'Miso.Types.update' function.-type Sub action = Sink action -> JSM ()---- | Function to asynchronously dispatch actions to the 'Miso.Types.update' function.-type Sink action = action -> IO ()---- | Turn a subscription that consumes actions of type @a@ into a subscription--- that consumes actions of type @b@ using the supplied function of type @a -> b@.-mapSub :: (actionA -> actionB) -> Sub actionA -> Sub actionB-mapSub f sub = \sinkB -> let sinkA = sinkB . f-                         in sub sinkA--instance Functor (Effect action) where-  fmap f (Effect m acts) = Effect (f m) acts--instance Applicative (Effect action) where-  pure m = Effect m []-  Effect fModel fActs <*> Effect xModel xActs = Effect (fModel xModel) (fActs ++ xActs)--instance Monad (Effect action) where-  return = pure-  Effect m acts >>= f =-    case f m of-      Effect m' acts' -> Effect m' (acts ++ acts')--instance Bifunctor Effect where-  bimap f g (Effect m acts) = Effect (g m) (map (\act -> \sink -> act (sink . f)) acts)---- | Smart constructor for an 'Effect' with no actions.-noEff :: model -> Effect action model-noEff m = Effect m []---- | Smart constructor for an 'Effect' with exactly one action.-(<#) :: model -> JSM action -> Effect action model-(<#) m a = effectSub m $ \sink -> a >>= liftIO . sink---- | `Effect` smart constructor, flipped-(#>) :: JSM action -> model -> Effect action model-(#>) = flip (<#)---- | Smart constructor for an 'Effect' with multiple actions.-batchEff :: model -> [JSM action] -> Effect action model-batchEff model actions = Effect model $-  map (\a sink -> liftIO . sink =<< a) actions---- | Like '<#' but schedules a subscription which is an IO computation which has--- access to a 'Sink' which can be used to asynchronously dispatch actions to--- the 'update' function.------ A use-case is scheduling an IO computation which creates a 3rd-party JS--- widget which has an associated callback. The callback can then call the sink--- to turn events into actions. To do this without accessing a sink requires--- going via a @'Sub'scription@ which introduces a leaky-abstraction.-effectSub :: model -> Sub action -> Effect action model-effectSub model sub = Effect model [sub]
− frontend-src/Miso/Effect/DOM.hs 
@@ -1,17 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Miso.Effect.DOM--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Effect.DOM-  ( focus-  , blur-  , scrollIntoView-  , alert-  ) where--import Miso.FFI
− frontend-src/Miso/Effect/Storage.hs 
@@ -1,108 +0,0 @@-{-# LANGUAGE ScopedTypeVariables       #-}-{-# LANGUAGE OverloadedStrings         #-}-{-# LANGUAGE ForeignFunctionInterface  #-}-{-# LANGUAGE LambdaCase                #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.Effect.Storage--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- 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).------------------------------------------------------------------------------module Miso.Effect.Storage-  ( -- * Retrieve storage-    getLocalStorage-  , getSessionStorage-    -- * Set items in storage-  , setLocalStorage-  , setSessionStorage-    -- * Remove items from storage-  , removeLocalStorage-  , removeSessionStorage-    -- * Clear storage-  , clearLocalStorage-  , clearSessionStorage-    -- * Get number of items in storage-  , localStorageLength-  , sessionStorageLength-  ) where--import           Data.Aeson hiding (Object, String)-import           Data.JSString-import           GHCJS.Marshal-import           GHCJS.Types--import           Miso.FFI--import qualified Miso.FFI.Storage as Storage---- | Helper for retrieving either local or session storage-getStorageCommon-  :: FromJSON b => (t -> JSM (Maybe JSVal)) -> t -> JSM (Either String b)-getStorageCommon f key = do-  result :: Maybe JSVal <- f key-  case result of-    Nothing -> pure $ Left "Not Found"-    Just v -> do-      r <- parse v-      pure $ case fromJSON r of-        Success x -> Right x-        Error y -> Left y---- | Retrieve a value stored under given key in session storage-getSessionStorage :: FromJSON model => JSString -> JSM (Either String model)-getSessionStorage =-  getStorageCommon $ \t -> do-    s <- Storage.sessionStorage-    r <- Storage.getItem s t-    fromJSVal r---- | Retrieve a value stored under given key in local storage-getLocalStorage :: FromJSON model => JSString -> JSM (Either String model)-getLocalStorage = getStorageCommon $ \t -> do-    s <- Storage.localStorage-    r <- Storage.getItem s t-    fromJSVal r---- | Set the value of a key in local storage.------ @setLocalStorage key value@ sets the value of @key@ to @value@.-setLocalStorage :: ToJSON model => JSString -> model -> JSM ()-setLocalStorage key model = do-  s <- Storage.localStorage-  Storage.setItem s key =<< stringify model---- | Set the value of a key in session storage.------ @setSessionStorage key value@ sets the value of @key@ to @value@.-setSessionStorage :: ToJSON model => JSString -> model -> JSM ()-setSessionStorage key model = do-  s <- Storage.sessionStorage-  Storage.setItem s key =<< stringify model--removeLocalStorage :: JSString -> JSM ()-removeLocalStorage key = do-  s <- Storage.localStorage-  Storage.removeItem s key--removeSessionStorage :: JSString -> JSM ()-removeSessionStorage key = do-  s <- Storage.sessionStorage-  Storage.removeItem s key--clearLocalStorage :: JSM ()-clearLocalStorage = Storage.clear =<< Storage.localStorage--clearSessionStorage :: JSM ()-clearSessionStorage = Storage.clear =<< Storage.sessionStorage--localStorageLength :: JSM Int-localStorageLength = Storage.length =<< Storage.localStorage--sessionStorageLength :: JSM Int-sessionStorageLength = Storage.length =<< Storage.sessionStorage
− frontend-src/Miso/Html/Internal.hs 
@@ -1,319 +0,0 @@-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE DataKinds                  #-}-{-# LANGUAGE KindSignatures             #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE ConstraintKinds            #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE UndecidableInstances       #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE RecordWildCards            #-}-{-# OPTIONS_GHC -fno-warn-orphans       #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.Html.Internal--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Html.Internal (-  -- * Core types and interface-    VTree  (..)-  , View   (..)-  , ToView (..)-  , Attribute (..)-  -- * Smart `View` constructors-  , node-  , text-  , textRaw-  -- * Key patch internals-  , Key    (..)-  , ToKey  (..)-  -- * Namespace-  , NS     (..)-  -- * Setting properties on virtual DOM nodes-  , prop-  -- * Setting css-  , style_-  -- * Handling events-  , on-  , onWithOptions-  -- * Life cycle events-  , onCreated-  , onDestroyed-  , onBeforeDestroyed-  -- * Events-  , defaultEvents-  -- * Subscription type-  , Sub-  ) where--import           Control.Monad-import           Control.Monad.IO.Class-import           Data.Aeson.Types (parseEither)-import           Data.JSString-import qualified Data.Map as M-import           Data.Proxy-import           Data.String (IsString(..))-import qualified Data.Text as T-import           GHCJS.Marshal-import           GHCJS.Types-import qualified JavaScript.Array as JSArray-import           JavaScript.Object-import           JavaScript.Object.Internal (Object (Object))-import           Servant.API--import           Miso.Effect (Sub)-import           Miso.Event.Decoder-import           Miso.Event.Types-import           Miso.String-import           Miso.Effect (Sink)-import           Miso.FFI---- | Virtual DOM implemented as a JavaScript `Object`.---   Used for diffing, patching and event delegation.---   Not meant to be constructed directly, see `View` instead.-newtype VTree = VTree { getTree :: Object }---- | Core type for constructing a `VTree`, use this instead of `VTree` directly.-newtype View action = View {-  runView :: Sink action -> JSM VTree-} deriving Functor---- | For constructing type-safe links-instance HasLink (View a) where-#if MIN_VERSION_servant(0,14,0)-  type MkLink (View a) b = MkLink (Get '[] ()) b-  toLink toA Proxy = toLink toA (Proxy :: Proxy (Get '[] ()))-#else-  type MkLink (View a) = MkLink (Get '[] ())-  toLink _ = toLink (Proxy :: Proxy (Get '[] ()))-#endif---- | Convenience class for using View-class ToView v where toView :: v -> View m---- | `ToJSVal` instance for `Decoder`-instance ToJSVal DecodeTarget where-  toJSVal (DecodeTarget xs) = toJSVal xs-  toJSVal (DecodeTargets xs) = toJSVal xs---- | Create a new @VNode@.------ @node ns tag key attrs children@ creates a new node with tag @tag@--- and 'Key' @key@ in the namespace @ns@. All @attrs@ are called when--- the node is created and its children are initialized to @children@.-node :: NS-     -> MisoString-     -> Maybe Key-     -> [Attribute m]-     -> [View m]-     -> View m-node ns tag key attrs kids = View $ \sink -> do-  vnode <- create-  cssObj <- objectToJSVal =<< create-  propsObj <- objectToJSVal =<< create-  eventObj <- objectToJSVal =<< create-  set "css" cssObj vnode-  set "props" propsObj vnode-  set "events" eventObj vnode-  set "type" ("vnode" :: JSString) vnode-  set "ns" ns vnode-  set "tag" tag vnode-  set "key" key vnode-  setAttrs vnode sink-  flip (set "children") vnode-    =<< ghcjsPure . jsval-    =<< setKids sink-  pure $ VTree vnode-    where-      setAttrs vnode sink =-        forM_ attrs $ \(Attribute attr) ->-          attr sink vnode-      setKids sink = do-        kidsViews <- traverse (objectToJSVal . getTree <=< flip runView sink) kids-        ghcjsPure (JSArray.fromList kidsViews)--instance ToJSVal Options-instance ToJSVal Key where toJSVal (Key x) = toJSVal x--instance ToJSVal NS where-  toJSVal SVG  = toJSVal ("svg" :: JSString)-  toJSVal HTML = toJSVal ("html" :: JSString)-  toJSVal MATHML = toJSVal ("mathml" :: JSString)---- | Namespace of DOM elements.-data NS-  = HTML -- ^ HTML Namespace-  | SVG  -- ^ SVG Namespace-  | MATHML  -- ^ MATHML Namespace-  deriving (Show, Eq)---- | Create a new @VText@ with the given content.-text :: MisoString -> View m-text t = View . const $ do-  vtree <- create-  set "type" ("vtext" :: JSString) vtree-  set "text" t vtree-  pure $ VTree vtree---- | For parity with server-side rendering. Don't use directly.-textRaw :: MisoString -> View m-textRaw = text---- | `IsString` instance-instance IsString (View a) where-  fromString = text . fromString---- | A unique key for a dom node.------ This key is only used to speed up diffing the children of a DOM--- node, the actual content is not important. The keys of the children--- of a given DOM node must be unique. Failure to satisfy this--- invariant gives undefined behavior at runtime.-newtype Key = Key MisoString---- | Convert custom key types to `Key`.------ Instances of this class do not have to guarantee uniqueness of the--- generated keys, it is up to the user to do so. `toKey` must be an--- injective function.-class ToKey key where toKey :: key -> Key--- | Identity instance-instance ToKey Key where toKey = id--- | Convert `MisoString` to `Key`-instance ToKey MisoString where toKey = Key--- | Convert `Text` to `Key`-instance ToKey T.Text where toKey = Key . toMisoString--- | Convert `String` to `Key`-instance ToKey String where toKey = Key . toMisoString--- | Convert `Int` to `Key`-instance ToKey Int where toKey = Key . toMisoString--- | Convert `Double` to `Key`-instance ToKey Double where toKey = Key . toMisoString--- | Convert `Float` to `Key`-instance ToKey Float where toKey = Key . toMisoString--- | Convert `Word` to `Key`-instance ToKey Word where toKey = Key . toMisoString---- | Attribute of a vnode in a `View`.------ The 'Sink' callback can be used to dispatch actions which are fed back to--- the @update@ function. This is especially useful for event handlers--- like the @onclick@ attribute. The second argument represents the--- vnode the attribute is attached to.-newtype Attribute action = Attribute (Sink action -> Object -> JSM ())---- | @prop k v@ is an attribute that will set the attribute @k@ of the DOM node associated with the vnode--- to @v@.-prop :: ToJSVal a => MisoString -> a -> Attribute action-prop k v = Attribute . const $ \n -> do-  val <- toJSVal v-  o <- getProp ("props" :: MisoString) n-  set k val (Object o)---- | Convenience wrapper for @onWithOptions defaultOptions@.------ > let clickHandler = on "click" emptyDecoder $ \() -> Action--- > in button_ [ clickHandler, class_ "add" ] [ text_ "+" ]----on :: MisoString-   -> Decoder r-   -> (r -> action)-   -> Attribute action-on = onWithOptions 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.------ @opts@ can be used to disable further event propagation.------ > let clickHandler = onWithOptions defaultOptions "click" emptyDecoder $ \() -> Action--- > in button_ [ clickHandler, class_ "add" ] [ text_ "+" ]----onWithOptions-  :: Options-  -> MisoString-  -> Decoder r-  -> (r -> action)-  -> Attribute action-onWithOptions options eventName Decoder{..} toAction =-  Attribute $ \sink n -> do-   eventObj <- getProp "events" n-   eventHandlerObject@(Object eo) <- create-   jsOptions <- toJSVal options-   decodeAtVal <- toJSVal decodeAt-   cb <- callbackToJSVal <=< asyncCallback1 $ \e -> do-       Just v <- fromJSVal =<< objectToJSON decodeAtVal e-       case parseEither decoder v of-         Left s -> error $ "Parse error on " <> unpack eventName <> ": " <> s-         Right r -> liftIO (sink (toAction r))-   set "runEvent" cb eventHandlerObject-   registerCallback cb-   set "options" jsOptions eventHandlerObject-   set eventName eo (Object eventObj)---- | @onCreated action@ is an event that gets called after the actual DOM--- element is created.------ Important note: Any node that uses this event MUST have a unique @Key@,--- otherwise the event may not be reliably called!-onCreated :: action -> Attribute action-onCreated action =-  Attribute $ \sink n -> do-    cb <- callbackToJSVal =<< asyncCallback (liftIO (sink action))-    set "onCreated" cb n-    registerCallback cb---- | @onDestroyed action@ is an event that gets called after the DOM element--- is removed from the DOM. The @action@ is given the DOM element that was--- removed from the DOM tree.------ Important note: Any node that uses this event MUST have a unique @Key@,--- otherwise the event may not be reliably called!-onDestroyed :: action -> Attribute action-onDestroyed action =-  Attribute $ \sink n -> do-    cb <- callbackToJSVal =<< asyncCallback (liftIO (sink action))-    set "onDestroyed" cb n-    registerCallback cb---- | @onBeforeDestroyed action@ is an event that gets called before the DOM element--- is removed from the DOM. The @action@ is given the DOM element that was--- removed from the DOM tree.------ Important note: Any node that uses this event MUST have a unique @Key@,--- otherwise the event may not be reliably called!-onBeforeDestroyed :: action -> Attribute action-onBeforeDestroyed action =-  Attribute $ \sink n -> do-    cb <- callbackToJSVal =<< asyncCallback (liftIO (sink action))-    set "onBeforeDestroyed" cb n-    registerCallback cb---- | @style_ attrs@ is an attribute that will set the @style@--- attribute of the associated DOM node to @attrs@.------ @style@ attributes not contained in @attrs@ will be deleted.------ > import qualified Data.Map as M--- > div_ [ style_  $ M.singleton "background" "red" ] [ ]------ <https://developer.mozilla.org/en-US/docs/Web/CSS>----style_ :: M.Map MisoString MisoString -> Attribute action-style_ m = Attribute . const $ \n -> do-   cssObj <- getProp "css" n-   forM_ (M.toList m) $ \(k,v) ->-     set k v (Object cssObj)
− frontend-src/Miso/JSBits.hs 
@@ -1,1 +0,0 @@-module Miso.JSBits where
− frontend-src/Miso/String.hs 
@@ -1,139 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans       #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.String--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.String (-    ToMisoString (..)-  , FromMisoString (..)-  , fromMisoString-  , MisoString-  , module Data.JSString-  , module Data.Monoid-  , ms-  ) where--#ifndef JSADDLE-import           Data.Aeson-#endif-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import           Data.Char-import           Data.JSString-import           Data.JSString.Text-import           Data.Monoid-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy as LT-import qualified Data.Text.Lazy.Encoding as LT-import           Prelude hiding (foldr)-import           Miso.FFI---- | String type swappable based on compiler-type MisoString = JSString--#ifndef JSADDLE----- | `ToJSON` for `MisoString`-instance ToJSON MisoString where-  toJSON = String . textFromJSString---- | `FromJSON` for `MisoString`-instance FromJSON MisoString where-  parseJSON =-    withText "Not a valid string" $ \x ->-      pure (toMisoString x)-#endif---- | Convenience class for creating `MisoString` from other string-like types-class ToMisoString str where-  toMisoString :: str -> MisoString--class FromMisoString t where-  -- -- | Reads a `MisoString` into an 'a', throws an error when-  fromMisoStringEither :: MisoString -> Either String t---- | Reads a `MisoString` into an 'a', throws an error when decoding--- fails. Use `fromMisoStringEither` for as a safe alternative.-fromMisoString :: FromMisoString a => MisoString -> a-fromMisoString s = case fromMisoStringEither s of-                     Left err -> error err-                     Right x  -> x---- | Convenience function, shorthand for `toMisoString`-ms :: ToMisoString str => str -> MisoString-ms = toMisoString--instance ToMisoString MisoString where-  toMisoString = id-instance ToMisoString String where-  toMisoString = pack-instance ToMisoString T.Text where-  toMisoString = textToJSString-instance ToMisoString LT.Text where-  toMisoString = lazyTextToJSString-instance ToMisoString B.ByteString where-  toMisoString = toMisoString . T.decodeUtf8-instance ToMisoString BL.ByteString where-  toMisoString = toMisoString . LT.decodeUtf8-instance ToMisoString Float where-  toMisoString = realFloatToJSString-instance ToMisoString Double where-  toMisoString = realFloatToJSString-instance ToMisoString Int where-  toMisoString = integralToJSString-instance ToMisoString Word where-  toMisoString = integralToJSString--instance FromMisoString MisoString where-  fromMisoStringEither = Right-instance FromMisoString String where-  fromMisoStringEither = Right . unpack-instance FromMisoString T.Text where-  fromMisoStringEither = Right . textFromJSString-instance FromMisoString LT.Text where-  fromMisoStringEither = Right . lazyTextFromJSString-instance FromMisoString B.ByteString where-  fromMisoStringEither = fmap T.encodeUtf8 . fromMisoStringEither-instance FromMisoString BL.ByteString where-  fromMisoStringEither = fmap LT.encodeUtf8 . fromMisoStringEither-instance FromMisoString Float where-  fromMisoStringEither = fmap realToFrac . jsStringToDoubleEither-instance FromMisoString Double where-  fromMisoStringEither = jsStringToDoubleEither-instance FromMisoString Int where-  fromMisoStringEither = parseInt-instance FromMisoString Word where-  fromMisoStringEither = parseWord--jsStringToDoubleEither :: JSString -> Either String Double-jsStringToDoubleEither s = let d = jsStringToDouble s-                           in if isNaN d then Left "jsStringToDoubleEither: parse failed"-                                         else Right d---parseWord   :: MisoString -> Either String Word-parseWord s = case uncons s of-                Nothing     -> Left "parseWord: parse error"-                Just (c,s') -> foldl' k (pDigit c) s'-  where-    pDigit c | isDigit c = Right . fromIntegral . digitToInt $ c-             | otherwise = Left "parseWord: parse error"-    k ea c = (\a x -> 10*a + x) <$> ea <*> pDigit c--parseInt   :: MisoString -> Either String Int-parseInt s = case uncons s of-               Just ('-',s') -> ((-1)*) . fromIntegral <$> parseWord s'-               _             ->           fromIntegral <$> parseWord s
− frontend-src/Miso/Subscription.hs 
@@ -1,24 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Miso.Subscription--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Subscription-  ( module Miso.Subscription.Mouse-  , module Miso.Subscription.Keyboard-  , module Miso.Subscription.History-  , module Miso.Subscription.Window-  , module Miso.Subscription.WebSocket-  , module Miso.Subscription.SSE-  ) where--import Miso.Subscription.Mouse-import Miso.Subscription.Keyboard-import Miso.Subscription.History-import Miso.Subscription.Window-import Miso.Subscription.WebSocket-import Miso.Subscription.SSE
− frontend-src/Miso/Subscription/History.hs 
@@ -1,107 +0,0 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TypeFamilies      #-}-{-# LANGUAGE TypeOperators     #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.Subscription.History--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Subscription.History-  ( getCurrentURI-  , pushURI-  , replaceURI-  , back-  , forward-  , go-  , uriSub-  , URI (..)-  ) where--import Control.Monad-import Control.Monad.IO.Class-import Miso.Concurrent-import Miso.FFI-import qualified Miso.FFI.History as FFI-import Miso.Html.Internal (Sub)-import Miso.String-import Network.URI hiding (path)-import System.IO.Unsafe---- | Retrieves current URI of page-getCurrentURI :: JSM URI-{-# INLINE getCurrentURI #-}-getCurrentURI = getURI---- | Retrieves current URI of page-getURI :: JSM URI-{-# INLINE getURI #-}-getURI = do-  href <- fromMisoString <$> FFI.getWindowLocationHref-  case parseURI href of-    Nothing  -> fail $ "Could not parse URI from window.location: " ++ href-    Just uri -> return uri---- | Pushes a new URI onto the History stack-pushURI :: URI -> JSM ()-{-# INLINE pushURI #-}-pushURI uri = pushStateNoModel uri { uriPath = toPath uri }---- | Prepend '/' if necessary-toPath :: URI -> String-toPath uri =-  case uriPath uri of-    "" -> "/"-    "/" -> "/"-    xs@('/' : _) -> xs-    xs -> '/' : xs---- | Replaces current URI on stack-replaceURI :: URI -> JSM ()-{-# INLINE replaceURI #-}-replaceURI uri = replaceTo' uri { uriPath = toPath uri }---- | Navigates backwards-back :: JSM ()-{-# INLINE back #-}-back = FFI.back---- | Navigates forwards-forward :: JSM ()-{-# INLINE forward #-}-forward = FFI.forward---- | Jumps to a specific position in history-go :: Int -> JSM ()-{-# INLINE go #-}-go n = FFI.go n--chan :: Notify-{-# NOINLINE chan #-}-chan = unsafePerformIO newEmptyNotify---- | Subscription for `popState` events, from the History API-uriSub :: (URI -> action) -> Sub action-uriSub = \f sink -> do-  void.forkJSM.forever $ do-    liftIO (wait chan)-    liftIO . sink . f =<< getURI-  windowAddEventListener "popstate" $ \_ ->-      liftIO . sink . f =<< getURI--pushStateNoModel :: URI -> JSM ()-{-# INLINE pushStateNoModel #-}-pushStateNoModel u = do-  FFI.pushState . pack . show $ u-  liftIO (notify chan)--replaceTo' :: URI -> JSM ()-{-# INLINE replaceTo' #-}-replaceTo' u = do-  FFI.replaceState . pack . show $ u-  liftIO (notify chan)
− frontend-src/Miso/Subscription/Keyboard.hs 
@@ -1,106 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RecordWildCards     #-}-{-# LANGUAGE OverloadedStrings   #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.Subscription.Keyboard--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Subscription.Keyboard-  ( -- * Types-    Arrows (..)-    -- * Subscriptions-  , arrowsSub-  , directionSub-  , keyboardSub-  , wasdSub-  ) where--import           Control.Monad.IO.Class-import           Data.IORef-import           Data.Set-import qualified Data.Set as S-import           GHCJS.Marshal-import           JavaScript.Object-import           JavaScript.Object.Internal--import           Miso.FFI-import           Miso.Html.Internal ( Sub )---- | type for arrow keys currently pressed---  37 left arrow  ( x = -1 )---  38 up arrow    ( y =  1 )---  39 right arrow ( x =  1 )---  40 down arrow  ( y = -1 )-data Arrows = Arrows {-   arrowX :: !Int- , arrowY :: !Int- } deriving (Show, Eq)---- | Helper function to convert keys currently pressed to `Arrow`, given a--- mapping for keys representing up, down, left and right respectively.-toArrows :: ([Int], [Int], [Int], [Int]) -> Set Int -> Arrows-toArrows (up, down, left, right) set' =-  Arrows {-    arrowX =-      case (check left, check right) of-        (True, False) -> -1-        (False, True) -> 1-        (_,_) -> 0-  , arrowY =-      case (check down, check up) of-        (True, False) -> -1-        (False, True) -> 1-        (_,_) -> 0-  }-  where-    check = any (`S.member` set')---- | Maps `Arrows` onto a Keyboard subscription-arrowsSub :: (Arrows -> action) -> Sub action-arrowsSub = directionSub ([38], [40], [37], [39])---- | Maps `WASD` onto a Keyboard subscription for directions-wasdSub :: (Arrows -> action) -> Sub action-wasdSub = directionSub ([87], [83], [65], [68])---- | Maps a specified list of keys to directions (up, down, left, right)-directionSub :: ([Int], [Int], [Int], [Int])-             -> (Arrows -> action)-             -> Sub action-directionSub dirs = keyboardSub . (. toArrows dirs)---- | Returns subscription for Keyboard-keyboardSub :: (Set Int -> action) -> Sub action-keyboardSub f sink = do-  keySetRef <- liftIO (newIORef mempty)-  windowAddEventListener "keyup" $ keyUpCallback keySetRef-  windowAddEventListener "keydown" $ keyDownCallback keySetRef-  windowAddEventListener "blur" $ blurCallback keySetRef-    where-      keyDownCallback keySetRef = \keyDownEvent -> do-          Just key <- fromJSVal =<< getProp "keyCode" (Object keyDownEvent)-          newKeys <- liftIO $ atomicModifyIORef' keySetRef $ \keys ->-             let !new = S.insert key keys-             in (new, new)-          liftIO (sink (f newKeys))--      keyUpCallback keySetRef = \keyUpEvent -> do-          Just key <- fromJSVal =<< getProp "keyCode" (Object keyUpEvent)-          newKeys <- liftIO $ atomicModifyIORef' keySetRef $ \keys ->-             let !new = S.delete key keys-             in (new, new)-          liftIO (sink (f newKeys))--      -- Assume keys are released the moment focus is lost. Otherwise going-      -- back and forth to the app can cause keys to get stuck.-      blurCallback keySetRef = \_ -> do-          newKeys <- liftIO $ atomicModifyIORef' keySetRef $ \_ ->-            let !new = S.empty-            in (new, new)-          liftIO (sink (f newKeys))
− frontend-src/Miso/Subscription/Mouse.hs 
@@ -1,30 +0,0 @@-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE OverloadedStrings #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.Subscription.Mouse--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Subscription.Mouse (mouseSub) where--import Control.Monad.IO.Class-import GHCJS.Marshal-import JavaScript.Object-import JavaScript.Object.Internal--import Miso.FFI-import Miso.Html.Internal ( Sub )---- | Captures mouse coordinates as they occur and writes them to--- an event sink-mouseSub :: ((Int,Int) -> action) -> Sub action-mouseSub f = \sink -> do-  windowAddEventListener "mousemove" $-    \mouseEvent -> do-      Just x <- fromJSVal =<< getProp "clientX" (Object mouseEvent)-      Just y <- fromJSVal =<< getProp "clientY" (Object mouseEvent)-      liftIO (sink $ f (x,y))
− frontend-src/Miso/Subscription/SSE.hs 
@@ -1,49 +0,0 @@-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE LambdaCase #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.Subscription.SSE--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Subscription.SSE- ( -- * Subscription-   sseSub-   -- * Types- , SSE (..)- ) where--import           Control.Monad.IO.Class-import           Data.Aeson-import           Miso.FFI-import           Miso.Html.Internal ( Sub )-import           Miso.String--import qualified Miso.FFI.SSE as SSE---- | Server-sent events Subscription-sseSub :: FromJSON msg => MisoString -> (SSE msg -> action) -> Sub action-sseSub url f = \sink -> do-  es <- SSE.new url-  SSE.addEventListener es "message" $ \val -> do-    dat <- parse =<< SSE.data' val-    (liftIO . sink) (f (SSEMessage dat))-  SSE.addEventListener es "error" $ \_ ->-    (liftIO . sink) (f SSEError)-  SSE.addEventListener es "close" $ \_ ->-    (liftIO . sink) (f SSEClose)---- | Server-sent events data-data SSE message-  = SSEMessage message-  | SSEClose-  | SSEError-  deriving (Show, Eq)---- | Test URL--- http://sapid.sourceforge.net/ssetest/webkit.events.php--- var source = new EventSource("demo_sse.php");
− frontend-src/Miso/Subscription/WebSocket.hs 
@@ -1,167 +0,0 @@-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE RankNTypes                 #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE CPP                        #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.Subscription.WebSocket--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Subscription.WebSocket-  ( -- * Types-    WebSocket   (..)-  , URL         (..)-  , Protocols   (..)-  , SocketState (..)-  , CloseCode   (..)-  , WasClean    (..)-  , Reason      (..)-    -- * Subscription-  , websocketSub-  , send-  , close-  , connect-  , getSocketState-  ) where--import           Control.Concurrent-import           Control.Monad-import           Control.Monad.IO.Class-import           Data.Aeson-import           Data.IORef-import           Data.Maybe-import           GHCJS.Marshal-import           GHCJS.Foreign-import           GHCJS.Types-import           Prelude hiding (map)-import           System.IO.Unsafe--import           Miso.FFI-import           Miso.FFI.WebSocket (Socket)-import qualified Miso.FFI.WebSocket as WS-import           Miso.Html.Internal ( Sub )-import           Miso.WebSocket--websocket :: IORef (Maybe Socket)-{-# NOINLINE websocket #-}-websocket = unsafePerformIO (newIORef Nothing)--closedCode :: IORef (Maybe CloseCode)-{-# NOINLINE closedCode #-}-closedCode = unsafePerformIO (newIORef Nothing)--secs :: Int -> Int-secs = (*1000000)---- | WebSocket subscription-websocketSub-  :: FromJSON m-  => URL-  -> Protocols-  -> (WebSocket m -> action)-  -> Sub action-websocketSub (URL u) (Protocols ps) f sink = do-  socket <- createWebSocket u ps-  liftIO (writeIORef websocket (Just socket))-  void . forkJSM $ handleReconnect-  WS.addEventListener socket "open" $ \_ -> liftIO $ do-    writeIORef closedCode Nothing-    sink (f WebSocketOpen)-  WS.addEventListener socket "message" $ \v -> do-    d <- parse =<< WS.data' v-    liftIO . sink $ f (WebSocketMessage d)-  WS.addEventListener socket "close" $ \e -> do-    code <- codeToCloseCode <$> WS.code e-    liftIO (writeIORef closedCode (Just code))-    reason <- WS.reason e-    clean <- WS.wasClean e-    liftIO . sink $ f (WebSocketClose code clean reason)-  WS.addEventListener socket "error" $ \v -> do-    liftIO (writeIORef closedCode Nothing)-    d' <- WS.data' v-#ifndef __GHCJS__        -    undef <- ghcjsPure (isUndefined d')-#else-    let undef = isUndefined d'-#endif-    if undef-      then do-         liftIO . sink $ f (WebSocketError mempty)-      else do-         Just d <- fromJSVal d'-         liftIO . sink $ f (WebSocketError d)-  where-    handleReconnect = do-      liftIO (threadDelay (secs 3))-      Just s <- liftIO (readIORef websocket)-      status <- WS.socketState s-      code <- liftIO (readIORef closedCode)-      if status == 3-        then do-          unless (code == Just CLOSE_NORMAL) $-            websocketSub (URL u) (Protocols ps) f sink-        else handleReconnect---- | Sends message to a websocket server-send :: ToJSON a => a -> JSM ()-{-# INLINE send #-}-send x = do-  Just socket <- liftIO (readIORef websocket)-  sendJson' socket x---- | Sends message to a websocket server-close :: JSM ()-{-# INLINE close #-}-close =-  mapM_ WS.close =<<-    liftIO (readIORef websocket)---- | Connects to a websocket server-connect :: URL -> Protocols -> JSM ()-{-# INLINE connect #-}-connect (URL url') (Protocols ps) = do-  Just ws <- liftIO (readIORef websocket)-  s <- WS.socketState ws-  when (s == 3) $ do-    socket <- createWebSocket url' ps-    liftIO (atomicWriteIORef websocket (Just socket))---- | Retrieves current status of `WebSocket`-getSocketState :: JSM SocketState-getSocketState = do-  Just ws <- liftIO (readIORef websocket)-  toEnum <$> WS.socketState ws--sendJson' :: ToJSON json => Socket -> json -> JSM ()-sendJson' socket m = WS.send socket =<< stringify m--createWebSocket :: JSString -> [JSString] -> JSM Socket-{-# INLINE createWebSocket #-}-createWebSocket url' protocols =-  WS.create url' =<< toJSVal protocols--codeToCloseCode :: Int -> CloseCode-codeToCloseCode = go-  where-    go 1000 = CLOSE_NORMAL-    go 1001 = CLOSE_GOING_AWAY-    go 1002 = CLOSE_PROTOCOL_ERROR-    go 1003 = CLOSE_UNSUPPORTED-    go 1005 = CLOSE_NO_STATUS-    go 1006 = CLOSE_ABNORMAL-    go 1007 = Unsupported_Data-    go 1008 = Policy_Violation-    go 1009 = CLOSE_TOO_LARGE-    go 1010 = Missing_Extension-    go 1011 = Internal_Error-    go 1012 = Service_Restart-    go 1013 = Try_Again_Later-    go 1015 = TLS_Handshake-    go n    = OtherCode n
− frontend-src/Miso/Subscription/Window.hs 
@@ -1,56 +0,0 @@-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE OverloadedStrings #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.Subscription.Window--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Subscription.Window where--import Control.Monad-import Control.Monad.IO.Class--import GHCJS.Marshal-import JavaScript.Object-import JavaScript.Object.Internal--import Miso.Event-import Miso.FFI-import Miso.Html.Internal         ( Sub )-import Miso.String--import Data.Aeson.Types (parseEither)---- | Captures window coordinates changes as they occur and writes them to--- an event sink-windowCoordsSub :: ((Int, Int) -> action) -> Sub action-windowCoordsSub f = \sink -> do-  liftIO . sink . f =<< (,) <$> windowInnerHeight <*> windowInnerWidth-  windowAddEventListener "resize" $-    \windowEvent -> do-      target <- getProp "target" (Object windowEvent)-      Just w <- fromJSVal =<< getProp "innerWidth" (Object target)-      Just h <- fromJSVal =<< getProp "innerHeight" (Object target)-      liftIO . sink $ f (h, w)---- | @windowOn eventName decoder toAction@ is a subscription which parallels the--- attribute handler `on`, providing a subscription to listen to window level events.-windowSub :: MisoString -> Decoder r -> (r -> action) -> Sub action-windowSub  = windowSubWithOptions defaultOptions--windowSubWithOptions :: Options -> MisoString -> Decoder r -> (r -> action) -> Sub action-windowSubWithOptions Options{..} eventName Decoder{..} toAction = \sink -> do-  windowAddEventListener eventName $-    \e -> do-      decodeAtVal <- toJSVal decodeAt-      Just v <- fromJSVal =<< objectToJSON decodeAtVal e-      case parseEither decoder v of-        Left s -> error $ "Parse error on " <> unpack eventName <> ": " <> s-        Right r -> do-          when stopPropagation $ eventStopPropagation e-          when preventDefault $ eventPreventDefault e-          liftIO (sink (toAction r))
− frontend-src/Miso/Types.hs 
@@ -1,149 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Miso.Types--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Types-  ( App (..)-  , LogLevel (..)-  , Effect-  , Sub--    -- * The Transition Monad-  , Transition-  , mapAction-  , fromTransition-  , toTransition-  , scheduleIO-  , scheduleIO_-  , scheduleIOFor_-  , scheduleSub-  ) where--import           Control.Monad.IO.Class-import           Control.Monad.Trans.Class (lift)-import           Control.Monad.Trans.State.Strict (StateT(StateT), execStateT, mapStateT)-import           Control.Monad.Trans.Writer.Strict (WriterT(WriterT), Writer, runWriter, tell, mapWriter)-import           Data.Bifunctor (second)-import           Data.Foldable (Foldable, for_)-import qualified Data.Map as M-import           Miso.Effect-import           Miso.FFI (JSM)-import           Miso.Html.Internal-import           Miso.String---- | Application entry point-data App model action = App-  { model :: model-  -- ^ initial model-  , update :: action -> model -> Effect action model-  -- ^ Function to update model, optionally providing effects.-  --   See the 'Transition' monad for succinctly expressing model transitions.-  , view :: model -> View action-  -- ^ Function to draw `View`-  , subs :: [ Sub action ]-  -- ^ List of subscriptions to run during application lifetime-  , events :: M.Map MisoString Bool-  -- ^ List of delegated events that the body element will listen for.-  --   You can start with 'Miso.Event.Types.defaultEvents' and modify as needed.-  , initialAction :: action-  -- ^ Initial action that is run after the application has loaded-  , mountPoint :: Maybe MisoString-  -- ^ Id of the root element for DOM diff. If 'Nothing' is provided, the entire document body is used as a mount point.-  , logLevel :: LogLevel-  -- ^ Display warning messages when prerendering if the DOM and VDOM are not in sync.-  }---- | Optional Logging for debugging miso internals (useful to see if prerendering is successful)-data LogLevel-  = Off-  | DebugPrerender-  deriving (Show, Eq)---- | A monad for succinctly expressing model transitions in the 'update' function.------ @Transition@ is a state monad so it abstracts over manually passing the model--- around. It's also a writer monad where the accumulator is a list of scheduled--- IO actions. Multiple actions can be scheduled using--- @Control.Monad.Writer.Class.tell@ from the @mtl@ library and a single action--- can be scheduled using 'scheduleIO'.------ Tip: use the @Transition@ monad in combination with the stateful--- <http://hackage.haskell.org/package/lens-4.15.4/docs/Control-Lens-Operators.html lens>--- operators (all operators ending in "@=@"). The following example assumes--- the lenses @field1@, @counter@ and @field2@ are in scope and that the--- @LambdaCase@ language extension is enabled:------ @--- myApp = App---   { update = 'fromTransition' . \\case---       MyAction1 -> do---         field1 .= value1---         counter += 1---       MyAction2 -> do---         field2 %= f---         scheduleIO $ do---           putStrLn \"Hello\"---           putStrLn \"World!\"---   , ...---   }--- @-type Transition action model = StateT model (Writer [Sub action])---- | Turn a transition that schedules subscriptions that consume--- actions of type @a@ into a transition that schedules subscriptions--- that consume actions of type @b@ using the supplied function of--- type @a -> b@.-mapAction :: (actionA -> actionB) -> Transition actionA model r -> Transition actionB model r-mapAction = mapStateT . mapWriter . second . fmap . mapSub---- | Convert a @Transition@ computation to a function that can be given to 'update'.-fromTransition-    :: Transition action model ()-    -> (model -> Effect action model) -- ^ model 'update' function.-fromTransition act = uncurry Effect . runWriter . execStateT act---- | Convert an 'update' function to a @Transition@ computation.-toTransition-    :: (model -> Effect action model) -- ^ model 'update' function-    -> Transition action model ()-toTransition f = StateT $ \s ->-                   let Effect s' ios = f s-                   in WriterT $ pure (((), s'), ios)---- | Schedule a single IO action for later execution.------ Note that multiple IO action can be scheduled using--- @Control.Monad.Writer.Class.tell@ from the @mtl@ library.-scheduleIO :: JSM action -> Transition action model ()-scheduleIO ioAction = scheduleSub $ \sink -> ioAction >>= liftIO . sink---- | Like 'scheduleIO' but doesn't cause an action to be dispatched to--- the 'update' function.------ This is handy for scheduling IO computations where you don't care--- about their results or when they complete.-scheduleIO_ :: JSM () -> Transition action model ()-scheduleIO_ ioAction = scheduleSub $ \_sink -> ioAction---- | Like `scheduleIO_` but generalized to any instance of `Foldable`------ This is handy for scheduling IO computations that return a `Maybe` value-scheduleIOFor_ :: Foldable f => JSM (f action) -> Transition action model ()-scheduleIOFor_ io = scheduleSub $ \sink -> io >>= \m -> liftIO (for_ m sink)---- | Like 'scheduleIO' but schedules a subscription which is an IO--- computation that has access to a 'Sink' which can be used to--- asynchronously dispatch actions to the 'update' function.------ A use-case is scheduling an IO computation which creates a--- 3rd-party JS widget which has an associated callback. The callback--- can then call the sink to turn events into actions. To do this--- without accessing a sink requires going via a @'Sub'scription@--- which introduces a leaky-abstraction.-scheduleSub :: Sub action -> Transition action model ()-scheduleSub sub = lift $ tell [ sub ]
− ghc-src/Miso.hs 
@@ -1,29 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE LambdaCase          #-}-{-# LANGUAGE RecordWildCards     #-}-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE KindSignatures      #-}--------------------------------------------------------------------------------- |--- Module      :  Miso--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso-  ( module Miso.Event-  , module Miso.Html-  , module Miso.Router-  , module Miso.TypeLevel-  , module Miso.Util-  , module Miso.WebSocket-  ) where--import           Miso.Event-import           Miso.Html-import           Miso.Router-import           Miso.TypeLevel-import           Miso.Util-import           Miso.WebSocket
− ghc-src/Miso/Html/Internal.hs 
@@ -1,303 +0,0 @@-{-# LANGUAGE CPP                  #-}-{-# LANGUAGE DeriveFunctor        #-}-{-# LANGUAGE KindSignatures       #-}-{-# LANGUAGE DataKinds            #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE RankNTypes           #-}-{-# LANGUAGE GADTs                #-}-{-# LANGUAGE RecordWildCards      #-}-{-# LANGUAGE ConstraintKinds      #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE OverloadedStrings    #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE UndecidableInstances #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.Html.Internal--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Html.Internal (-  -- * Core types and interface-    VTree  (..)-  , View   (..)-  , ToView (..)-  , Attribute (..)-  -- * Smart `View` constructors-  , node-  , text-  , textRaw-  -- * Key patch internals-  , Key    (..)-  , ToKey  (..)-  -- * Namespace-  , NS     (..)-  -- * Setting properties on virtual DOM nodes-  , prop-  -- * Setting CSS-  , style_-  -- * Handling events-  , on-  , onWithOptions-  -- * Life cycle events-  , onCreated-  , onDestroyed-  , onBeforeDestroyed-  ) where--import           Data.Aeson  (Value(..), ToJSON(..))-import qualified Data.Map    as M-import           Data.Proxy-import           Data.String (IsString(..))-import qualified Data.Text   as T-import qualified Data.Vector as V-import qualified Lucid       as L-import qualified Lucid.Base  as L-import           Prelude     hiding (null)-import           Servant.API--import           Miso.Event-import           Miso.String hiding (map)---- | Virtual DOM implemented as a Rose `Vector`.---   Used for diffing, patching and event delegation.---   Not meant to be constructed directly, see `View` instead.-data VTree action where-  VNode :: { vType :: Text -- ^ Element type (i.e. "div", "a", "p")-           , vNs :: NS -- ^ HTML or SVG-           , vProps :: Props -- ^ Fields present on DOM Node-           , vKey :: Maybe Key -- ^ Key used for child swap patch-           , vChildren :: V.Vector (VTree action) -- ^ Child nodes-           } -> VTree action-  VText :: { vText :: Text -- ^ TextNode content-           } -> VTree action-  -- Invariant: To avoid complexity with collapsing mixed VText and-  -- VTextRaw nodes, VTextRaw node is always the only child.-  -- That's not a big limitation, since the intended purpose is to be able-  -- to use <style> and <script> tags. That means we can't support HTML-  -- entities like &nbsp; with VTextRaw, but the same can be achieved with-  -- Unicode.-  VTextRaw :: { vText :: Text -- ^ Raw TextNode content-              } -> VTree action-  deriving Functor--instance Show (VTree action) where-  show = show . L.toHtml---- | Converting `VTree` to Lucid's `L.Html`-instance L.ToHtml (VTree action) where-  toHtmlRaw = L.toHtml-  toHtml (VText x) | T.null x = L.toHtml (" " :: MisoString)-                   | otherwise = L.toHtml x-  toHtml (VTextRaw x) | T.null x = L.toHtml (" " :: MisoString)-                      | otherwise = L.toHtmlRaw x-  toHtml VNode{..} =-    let-      noEnd = ["img", "input", "br", "hr", "meta"]-      tag = toTag vType-      ele =-          if tag `elem` noEnd-            then L.makeElementNoEnd tag-            else L.makeElement tag kids-    in L.with ele as-      where-        Props xs = vProps-        as = [ L.makeAttribute k (if k `elem` exceptions && v == Bool True then k else v')-             | (k,v) <- M.toList xs-             , let v' = toHtmlFromJSON v-             , not (k `elem` exceptions && v == Bool False)-             ]-        exceptions = [ "checked"-                     , "disabled"-                     , "selected"-                     , "hidden"-                     , "readOnly"-                     , "autoplay"-                     , "required"-                     , "default"-                     , "autofocus"-                     , "multiple"-                     , "noValidate"-                     , "autocomplete"-                     ]-        toTag = T.toLower-        kids-          = foldMap L.toHtml-          . V.fromList-          . collapseSiblingTextNodes-          . V.toList-          $ vChildren--collapseSiblingTextNodes :: [VTree a] -> [VTree a]-collapseSiblingTextNodes [] = []-collapseSiblingTextNodes (VText x : VText y : xs) =-  collapseSiblingTextNodes (VText (x <> y) : xs)--- VTextRaw is the only child, so no need to collapse.-collapseSiblingTextNodes (x:xs) =-  x : collapseSiblingTextNodes xs---- | Helper for turning JSON into Text--- Object, Array and Null are kind of non-sensical here-toHtmlFromJSON :: Value -> Text-toHtmlFromJSON (String t) = t-toHtmlFromJSON (Number t) = pack (show t)-toHtmlFromJSON (Bool b) = if b then "true" else "false"-toHtmlFromJSON Null = "null"-toHtmlFromJSON (Object o) = pack (show o)-toHtmlFromJSON (Array a) = pack (show a)---- | Core type for constructing a `VTree`, use this instead of `VTree` directly.-newtype View action = View { runView :: VTree action }-  deriving Functor---- | For constructing type-safe links-instance HasLink (View a) where-#if MIN_VERSION_servant(0,14,0)-  type MkLink (View a) b = MkLink (Get '[] ()) b-  toLink toA Proxy = toLink toA (Proxy :: Proxy (Get '[] ()))-#else-  type MkLink (View a) = MkLink (Get '[] ())-  toLink Proxy = toLink (Proxy :: Proxy (Get '[] ()))-#endif----- | Convenience class for using View-class ToView v where toView :: v -> View action---- | Show `View`-instance Show (View action) where-  show (View xs) = show xs---- | Converting `View` to Lucid's `L.Html`-instance L.ToHtml (View action) where-  toHtmlRaw = L.toHtml-  toHtml (View xs) = L.toHtml xs---- | Namespace for element creation-data NS-  = HTML -- ^ HTML Namespace-  | SVG  -- ^ SVG Namespace-  | MATHML  -- ^ MATHML Namespace-  deriving (Show, Eq)---- | `VNode` creation-node :: NS -> MisoString -> Maybe Key -> [Attribute action] -> [View action] -> View action-node vNs vType vKey as xs =-  let classes = intercalate " " [ v | P "class" (String v) <- as ]-      vProps  = Props $ do-        let propClass = M.fromList [ (k,v) | P k v <- as ]-        if not (null classes)-          then M.insert "class" (String classes) propClass-          else propClass-      vChildren = V.fromList $ map runView xs-  in View VNode {..}---- | `VText` creation-text :: MisoString -> View action-text = View . VText---- | `VTextRaw` creation. Don't use directly-textRaw :: MisoString -> View action-textRaw = View . VTextRaw---- | `IsString` instance-instance IsString (View a) where-  fromString = text . fromString---- | Key for specific children patch-newtype Key = Key MisoString-  deriving (Show, Eq, Ord, IsString)---- | Convert type into Key, ensure `Key` is unique-class ToKey key where toKey :: key -> Key--- | Identity instance-instance ToKey Key    where toKey = id--- | Convert `Text` to `Key`-instance ToKey MisoString where toKey = Key--- | Convert `String` to `Key`-instance ToKey String where toKey = Key . T.pack--- | Convert `Int` to `Key`-instance ToKey Int    where toKey = Key . T.pack . show--- | Convert `Double` to `Key`-instance ToKey Double where toKey = Key . T.pack . show--- | Convert `Float` to `Key`-instance ToKey Float  where toKey = Key . T.pack . show--- | Convert `Word` to `Key`-instance ToKey Word   where toKey = Key . T.pack . show---- | Properties-newtype Props = Props (M.Map MisoString Value)-  deriving (Show, Eq)---- | `View` Attributes to annotate DOM, converted into Events, Props, Attrs and CSS-data Attribute action-  = P MisoString Value-  | E ()-  deriving (Show, Eq)---- | DMJ: this used to get set on preventDefault on Options... if options are dynamic now what--- | Useful for `drop` events-newtype AllowDrop = AllowDrop Bool-  deriving (Show, Eq)---- | Constructs a property on a `VNode`, used to set fields on a DOM Node-prop :: ToJSON a => MisoString -> a -> Attribute action-prop k v = P k (toJSON v)---- | For defining delegated events------ > let clickHandler = on "click" emptyDecoder $ \() -> Action--- > in button_ [ clickHandler, class_ "add" ] [ text_ "+" ]----on :: MisoString-   -> Decoder r-   -> (r -> action)-   -> Attribute action-on _ _ _ = E ()---- | For defining delegated events with options------ > let clickHandler = onWithOptions defaultOptions "click" emptyDecoder $ \() -> Action--- > in button_ [ clickHandler, class_ "add" ] [ text_ "+" ]----onWithOptions-   :: Options-   -> MisoString-   -> Decoder r-   -> (r -> action)-   -> Attribute action-onWithOptions _ _ _ _ = E ()---- | @onCreated action@ is an event that gets called after the actual DOM--- element is created.-onCreated :: action -> Attribute action-onCreated _ = E ()---- | @onDestroyed action@ is an event that gets called after the DOM element--- is removed from the DOM. The @action@ is given the DOM element that was--- removed from the DOM tree.-onDestroyed :: action -> Attribute action-onDestroyed _ = E ()---- | @onBeforeDestroyed action@ is an event that gets called before the DOM element--- is removed from the DOM. The @action@ is given the DOM element that was--- removed from the DOM tree.-onBeforeDestroyed :: action -> Attribute action-onBeforeDestroyed _ = E ()---- | Constructs CSS for a DOM Element------ > import qualified Data.Map as M--- > div_ [ style_  $ M.singleton "background" "red" ] [ ]------ <https://developer.mozilla.org/en-US/docs/Web/CSS>----style_ :: M.Map MisoString MisoString -> Attribute action-style_ map' = P "style" $ String (M.foldrWithKey go mempty map')-  where-    go :: MisoString -> MisoString -> MisoString -> MisoString-    go k v xs = mconcat [ k, ":", v, ";" ] <> xs
− ghc-src/Miso/String.hs 
@@ -1,92 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE OverloadedStrings #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.String--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.String-  ( ToMisoString (..)-  , FromMisoString (..)-  , fromMisoString-  , MisoString-  , module Data.Monoid-  , module Data.Text-  , ms-  ) where--import qualified Data.ByteString         as B-import qualified Data.ByteString.Lazy    as BL-import           Data.Monoid-import           Data.Text-import qualified Data.Text               as T-import qualified Data.Text.Encoding      as T-import qualified Data.Text.Lazy          as LT-import qualified Data.Text.Lazy.Encoding as LT-import           Text.Read(readEither)----- | String type swappable based on compiler-type MisoString = Text---- | Convenience class for creating `MisoString` from other string-like types-class ToMisoString str where-  toMisoString :: str -> MisoString--class FromMisoString t where-  -- -- | Reads a `MisoString` into an 'a', throws an error when-  fromMisoStringEither :: MisoString -> Either String t---- | Reads a `MisoString` into an 'a', throws an error when decoding--- fails. Use `fromMisoStringEither` for as a safe alternative.-fromMisoString :: FromMisoString a => MisoString -> a-fromMisoString s = case fromMisoStringEither s of-                     Left err -> error err-                     Right x  -> x---- | Convenience function, shorthand for `toMisoString`-ms :: ToMisoString str => str -> MisoString-ms = toMisoString--instance ToMisoString MisoString where-  toMisoString = id-instance ToMisoString String where-  toMisoString = T.pack-instance ToMisoString LT.Text where-  toMisoString = LT.toStrict-instance ToMisoString B.ByteString where-  toMisoString = toMisoString . T.decodeUtf8-instance ToMisoString BL.ByteString where-  toMisoString = toMisoString . LT.decodeUtf8-instance ToMisoString Float where-  toMisoString = T.pack . show-instance ToMisoString Double where-  toMisoString = T.pack . show-instance ToMisoString Int where-  toMisoString = T.pack . show-instance ToMisoString Word where-  toMisoString = T.pack . show--instance FromMisoString MisoString where-  fromMisoStringEither = Right-instance FromMisoString String where-  fromMisoStringEither = Right . T.unpack-instance FromMisoString LT.Text where-  fromMisoStringEither = Right . LT.fromStrict-instance FromMisoString B.ByteString where-  fromMisoStringEither = fmap T.encodeUtf8 . fromMisoStringEither-instance FromMisoString BL.ByteString where-  fromMisoStringEither = fmap LT.encodeUtf8 . fromMisoStringEither-instance FromMisoString Float where-  fromMisoStringEither = readEither . T.unpack-instance FromMisoString Double where-  fromMisoStringEither = readEither . T.unpack-instance FromMisoString Int where-  fromMisoStringEither = readEither . T.unpack-instance FromMisoString Word where-  fromMisoStringEither = readEither . T.unpack
− ghc-src/Miso/TypeLevel.hs 
@@ -1,19 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-module Miso.TypeLevel ( ToServerRoutes ) where--import Miso.Html-import Servant.API-import Servant.HTML.Lucid---- | Convert client route type to a server web handler type-type family ToServerRoutes (layout :: k) (wrapper :: * -> *) (action :: *) :: k where-  ToServerRoutes (a :<|> b) wrapper action =-    ToServerRoutes a wrapper action :<|>-      ToServerRoutes b wrapper action-  ToServerRoutes (a :> b) wrapper action =-    a :> ToServerRoutes b wrapper action-  ToServerRoutes (View a) wrapper action =-    Get '[HTML] (wrapper (View action))
− ghcjs-ffi/Miso/FFI.hs 
@@ -1,286 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE LambdaCase #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.FFI--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.FFI-   ( JSM-   , forkJSM-   , asyncCallback-   , asyncCallback1-   , callbackToJSVal-   , objectToJSVal-   , ghcjsPure-   , syncPoint--   , addEventListener-   , windowAddEventListener--   , windowInnerHeight-   , windowInnerWidth--   , eventPreventDefault-   , eventStopPropagation--   , now-   , consoleLog-   , consoleLogJSVal-   , stringify-   , parse-   , clearBody-   , objectToJSON-   , set-   , getBody-   , getDoc-   , getElementById-   , diff'--   , integralToJSString-   , realFloatToJSString-   , jsStringToDouble--   , delegateEvent--   , copyDOMIntoVTree--   , swapCallbacks-   , releaseCallbacks-   , registerCallback--   , focus-   , blur-   , scrollIntoView-   , alert-   ) where--import           Control.Concurrent-import           Data.Aeson                 hiding (Object)-import           Data.JSString-import           Data.JSString.Int-import           Data.JSString.RealFloat-import           GHCJS.Foreign.Callback-import           GHCJS.Marshal-import           GHCJS.Types-import qualified JavaScript.Object.Internal as OI---- | When compiled without the `jsaddle` Cabal flag, this is just a--- type synonym for `IO`. When the `jsaddle` flag is enabled, this--- resolves to the `JSM` type defined in `jsaddle`.-type JSM = IO---- | Run given `JSM` action asynchronously, in a separate thread.-forkJSM :: JSM () -> JSM ()-forkJSM a = () <$ forkIO a--callbackToJSVal :: Callback a -> JSM JSVal-callbackToJSVal = pure . jsval--objectToJSVal :: OI.Object -> JSM JSVal-objectToJSVal = pure . jsval--ghcjsPure :: a -> JSM a-ghcjsPure = pure---- | Forces execution of pending asyncronous code-syncPoint :: JSM ()-syncPoint = pure ()---- | Set property on object-set :: ToJSVal v => JSString -> v -> OI.Object -> IO ()-set "class" v obj = toJSVal v >>= appendClass obj-set k v obj = toJSVal v >>= \x -> OI.setProp k x obj---- | Only used for 'class', guaranteed to be a MisoString-foreign import javascript unsafe "if ('class' in $1) { $1['class'] += ' ' + $2; } else { $1['class'] = $2; }"-  appendClass :: OI.Object -> JSVal -> IO ()--foreign import javascript unsafe "$1.addEventListener($2, $3);"-  addEventListener' :: JSVal -> JSString -> Callback (JSVal -> IO ()) -> IO ()---- | Register an event listener on given target.-addEventListener :: JSVal            -- ^ Event target on which we want to register event listener-                 -> JSString         -- ^ Type of event to listen to (e.g. "click")-                 -> (JSVal -> IO ()) -- ^ Callback which will be called when the event occurs. The event is passed as a parameter to it.-                 -> IO ()-addEventListener self name cb = addEventListener' self name =<< asyncCallback1 cb---- | Registers an event listener on window-windowAddEventListener :: JSString           -- ^ Type of event to listen to (e.g. "click")-                       -> (JSVal -> IO ())  -- ^ Callback which will be called when the event occurs, the event will be passed to it as a parameter.-                       -> IO ()-windowAddEventListener name cb = do-  win <- getWindow-  addEventListener win name cb--foreign import javascript unsafe "$1.stopPropagation();"-    eventStopPropagation :: JSVal -> IO ()--foreign import javascript unsafe "$1.preventDefault();"-    eventPreventDefault :: JSVal -> IO ()---- | Window object-foreign import javascript unsafe "$r = window;"-  getWindow :: IO JSVal----- | Retrieves the height (in pixels) of the browser window viewport including, if rendered, the horizontal scrollbar.------ See <https://developer.mozilla.org/en-US/docs/Web/API/Window/innerHeight>-foreign import javascript unsafe "$r = window['innerHeight'];"-  windowInnerHeight :: IO Int---- | Retrieves the width (in pixels) of the browser window viewport including, if rendered, the vertical scrollbar.------ See <https://developer.mozilla.org/en-US/docs/Web/API/Window/innerWidth>-foreign import javascript unsafe "$r = window['innerWidth'];"-  windowInnerWidth :: IO Int---- | Retrieve high resolution time stamp------ See <https://developer.mozilla.org/en-US/docs/Web/API/Performance/now>-foreign import javascript unsafe "$r = performance.now();"-  now :: IO Double---- | Outputs a message to the web console------ See <https://developer.mozilla.org/en-US/docs/Web/API/Console/log>-foreign import javascript unsafe "console.log($1);"-  consoleLog :: JSString -> IO ()--foreign import javascript unsafe "console.log($1);"-  consoleLogJSVal :: JSVal -> IO ()---- | Converts a JS object into a JSON string-foreign import javascript unsafe "$r = JSON.stringify($1);"-  stringify' :: JSVal -> IO JSString--foreign import javascript unsafe "$r = JSON.parse($1);"-  parse' :: JSVal -> IO JSVal---- | Converts a JS object into a JSON string-stringify :: ToJSON json => json -> IO JSString-{-# INLINE stringify #-}-stringify j = stringify' =<< toJSVal (toJSON j)---- | Parses a JSString-parse :: FromJSON json => JSVal -> IO json-{-# INLINE parse #-}-parse jval = do-  k <- parse' jval-  Just val <- fromJSVal k-  case fromJSON val of-    Success x -> pure x-    Error y -> error y---- | Clear the document body. This is particularly useful to avoid--- creating multiple copies of your app when running in GHCJSi.-foreign import javascript unsafe "document.body.innerHTML = '';"-  clearBody :: IO ()---foreign import javascript unsafe "$r = window['objectToJSON']($1,$2);"-  objectToJSON-    :: JSVal -- ^ decodeAt :: [JSString]-    -> JSVal -- ^ object with impure references to the DOM-    -> IO JSVal---- | Retrieves a reference to the document body.------ See <https://developer.mozilla.org/en-US/docs/Web/API/Document/body>-foreign import javascript unsafe "$r = document.body;"-  getBody :: IO JSVal---- | Retrieves a reference to the document.------ See <https://developer.mozilla.org/en-US/docs/Web/API/Document>-foreign import javascript unsafe "$r = document;"-  getDoc :: IO JSVal---- | Returns an Element object representing the element whose id property matches the specified string.------ See <https://developer.mozilla.org/en-US/docs/Web/API/Document/getElementById>-foreign import javascript unsafe "$r = document.getElementById($1);"-  getElementById :: JSString -> IO JSVal--foreign import javascript unsafe "diff($1, $2, $3, $4);"-  diff'-    :: OI.Object -- ^ current object-    -> OI.Object -- ^ new object-    -> JSVal  -- ^ parent node-    -> JSVal  -- ^ document-    -> IO ()--integralToJSString :: Integral a => a -> JSString-integralToJSString = decimal--realFloatToJSString :: RealFloat a => a -> JSString-realFloatToJSString = realFloat--foreign import javascript unsafe "$r = Number($1);"-  jsStringToDouble :: JSString -> Double--delegateEvent :: JSVal -> JSVal -> IO JSVal -> IO ()-delegateEvent mountPoint events getVTree = do-  cb' <- syncCallback1 ThrowWouldBlock $ \continuation -> do-    res <- getVTree-    callFunction continuation res-  delegateEvent' mountPoint events cb'--foreign import javascript unsafe "window['delegate']($1, $2, $3);"-  delegateEvent'-     :: JSVal               -- ^ mountPoint element-     -> JSVal               -- ^ Events-     -> Callback (JSVal -> IO ()) -- ^ Virtual DOM callback-     -> IO ()--foreign import javascript unsafe "$1($2);"-  callFunction :: JSVal -> JSVal -> IO ()---- | Copies DOM pointers into virtual dom--- entry point into isomorphic javascript-foreign import javascript unsafe "window['copyDOMIntoVTree']($1, $2, $3);"-  copyDOMIntoVTree-    :: Bool  -- ^ Display debugging information when pre-rendering-    -> JSVal -- ^ mountPoint element of the isomorphic app-    -> JSVal -- ^ VDom object-    -> IO ()---- | Pins down the current callbacks for clearing later-foreign import javascript unsafe "window['swapCallbacks']();"-  swapCallbacks :: IO ()---- | Releases callbacks registered by the virtual DOM.-foreign import javascript unsafe "window['releaseCallbacks']();"-  releaseCallbacks :: IO ()--foreign import javascript unsafe "window['registerCallback']($1);"-  registerCallback :: JSVal -> IO ()---- | Fails silently if the element is not found.------ Analogous to @document.getElementById(id).focus()@.-foreign import javascript unsafe "window['callFocus']($1);"-  focus :: JSString -> JSM ()---- | Fails silently if the element is not found.------ Analogous to @document.getElementById(id).blur()@-foreign import javascript unsafe "window['callBlur']($1);"-  blur :: JSString -> JSM ()---- | Calls @document.getElementById(id).scrollIntoView()@-foreign import javascript unsafe-  "document.getElementById($1)['scrollIntoView']();"-  scrollIntoView :: JSString -> IO ()---- | Calls the @alert()@ function.-foreign import javascript unsafe "alert($1);"-  alert :: JSString -> JSM ()
− ghcjs-ffi/Miso/FFI/History.hs 
@@ -1,37 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Miso.FFI.History--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.FFI.History-  ( getWindowLocationHref-  , go-  , back-  , forward-  , pushState-  , replaceState-  ) where--import GHCJS.Types--foreign import javascript safe "$r = window.location.href || '';"-  getWindowLocationHref :: IO JSString--foreign import javascript unsafe "window.history.go($1);"-  go :: Int -> IO ()--foreign import javascript unsafe "window.history.back();"-  back :: IO ()--foreign import javascript unsafe "window.history.forward();"-  forward :: IO ()--foreign import javascript unsafe "window.history.pushState(null, null, $1);"-  pushState :: JSString -> IO ()--foreign import javascript unsafe "window.history.replaceState(null, null, $1);"-  replaceState :: JSString -> IO ()
− ghcjs-ffi/Miso/FFI/SSE.hs 
@@ -1,34 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE LambdaCase #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.FFI.SSE--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.FFI.SSE-  ( EventSource(..)-  , data'-  , new-  , addEventListener-  ) where--import           GHCJS.Types--import qualified Miso.FFI as FFI--newtype EventSource = EventSource JSVal--foreign import javascript unsafe "$r = $1.data;"-  data' :: JSVal -> IO JSVal--foreign import javascript unsafe "$r = new EventSource($1);"-  new :: JSString -> IO EventSource--addEventListener :: EventSource -> JSString -> (JSVal -> IO ()) -> IO ()-addEventListener (EventSource s) = FFI.addEventListener s
− ghcjs-ffi/Miso/FFI/Storage.hs 
@@ -1,45 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Miso.FFI.Storage--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.FFI.Storage-  ( Storage-  , localStorage-  , sessionStorage-  , getItem-  , removeItem-  , setItem-  , length-  , clear-  ) where--import GHCJS.Types-import Prelude hiding (length)--newtype Storage = Storage JSVal--foreign import javascript unsafe "$r = window.localStorage"-  localStorage :: IO Storage--foreign import javascript unsafe "$r = window.sessionStorage"-  sessionStorage :: IO Storage--foreign import javascript unsafe "$r = $1.getItem($2);"-  getItem :: Storage -> JSString -> IO JSVal--foreign import javascript unsafe "$1.removeItem($2);"-  removeItem :: Storage -> JSString -> IO ()--foreign import javascript unsafe "$1.setItem($2, $3);"-  setItem :: Storage -> JSString -> JSString -> IO ()--foreign import javascript unsafe "$r = $1.length;"-  length :: Storage -> IO Int--foreign import javascript unsafe "$1.clear();"-  clear :: Storage -> IO ()
− ghcjs-ffi/Miso/FFI/WebSocket.hs 
@@ -1,59 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE LambdaCase #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.FFI.WebSocket--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.FFI.WebSocket-  ( Socket(..)-  , create-  , socketState-  , send-  , close-  , addEventListener-  , data'-  , wasClean-  , code-  , reason-  ) where--import           GHCJS.Types--import qualified Miso.FFI as FFI-import           Miso.WebSocket--newtype Socket = Socket JSVal--foreign import javascript unsafe "$r = new WebSocket($1, $2);"-  create :: JSString -> JSVal -> IO Socket--foreign import javascript unsafe "$1.close()"-  close :: Socket -> IO ()--foreign import javascript unsafe "$r = $1.readyState;"-  socketState :: Socket -> IO Int--foreign import javascript unsafe "$1.send($2);"-  send :: Socket -> JSString -> IO ()--addEventListener :: Socket -> JSString -> (JSVal -> IO ()) -> IO ()-addEventListener (Socket s) = FFI.addEventListener s--foreign import javascript unsafe "$r = $1.data"-  data' :: JSVal -> IO JSVal--foreign import javascript unsafe "$r = $1.wasClean"-  wasClean :: JSVal -> IO WasClean--foreign import javascript unsafe "$r = $1.code"-  code :: JSVal -> IO Int--foreign import javascript unsafe "$r = $1.reason"-  reason :: JSVal -> IO Reason
+ js/miso.js view
@@ -0,0 +1,1296 @@+// ts/miso/util.ts+var version = "1.9.0.0";+function callFocus(id, delay) {+  var setFocus = function() {+    var e = document.getElementById(id);+    if (e && e.focus)+      e.focus();+  };+  delay > 0 ? setTimeout(setFocus, delay) : setFocus();+}+function callBlur(id, delay) {+  var setBlur = function() {+    var e = document.getElementById(id);+    if (e && e.blur)+      e.blur();+  };+  delay > 0 ? setTimeout(setBlur, delay) : setBlur();+}+function callSelect(id, delay) {+  var setSelect = function() {+    var e = document.getElementById(id);+    if (e && typeof e["select"] === "function")+      e.select();+  };+  delay > 0 ? setTimeout(setSelect, delay) : setSelect();+}+function callSetSelectionRange(id, start, end, delay) {+  var setSetSelectionRange = function() {+    var e = document.getElementById(id);+    if (e && typeof e["setSelectionRange"] === "function")+      e.setSelectionRange(start, end, "none");+  };+  delay > 0 ? setTimeout(setSetSelectionRange, delay) : setSetSelectionRange();+}+function fetchCore(url, method, body, requestHeaders, successful, errorful, responseType) {+  var options = { method, headers: requestHeaders };+  if (body) {+    options["body"] = body;+  }+  let headers = {};+  let status = null;+  try {+    fetch(url, options).then((response) => {+      status = response.status;+      for (const [key, value] of response.headers) {+        headers[key] = value;+      }+      if (!response.ok) {+        throw new Error(response.statusText);+      }+      if (responseType == "json") {+        return response.json();+      } else if (responseType == "text") {+        return response.text();+      } else if (responseType === "arrayBuffer") {+        return response.arrayBuffer();+      } else if (responseType === "blob") {+        return response.blob();+      } else if (responseType === "bytes") {+        return response.bytes();+      } else if (responseType === "formData") {+        return response.formData();+      } else if (responseType === "none") {+        return successful({ error: null, body: null, headers, status });+      }+    }).then((body2) => successful({ error: null, body: body2, headers, status })).catch((body2) => errorful({ error: null, body: body2, headers, status }));+  } catch (err) {+    errorful({ body: null, error: err.message, headers, status });+  }+}+function websocketConnect(url, onOpen, onClose, onMessageText, onMessageJSON, onMessageBLOB, onMessageArrayBuffer, onError, textOnly) {+  try {+    let socket = new WebSocket(url);+    socket.onopen = function() {+      onOpen();+    };+    socket.onclose = function(e) {+      onClose(e);+    };+    socket.onerror = function(error) {+      console.error(error);+      onError("WebSocket error received");+    };+    socket.onmessage = function(msg) {+      if (typeof msg.data === "string") {+        try {+          if (textOnly) {+            if (onMessageText)+              onMessageText(msg.data);+            return;+          }+          const json = JSON.parse(msg.data);+          if (onMessageJSON)+            onMessageJSON(json);+        } catch (err) {+          if (textOnly && onMessageText) {+            onMessageText(msg.data);+          } else {+            onError(err.message);+          }+        }+      } else if (msg.data instanceof Blob) {+        if (onMessageBLOB)+          onMessageBLOB(msg.data);+      } else if (msg.data instanceof ArrayBuffer) {+        if (onMessageArrayBuffer)+          onMessageArrayBuffer(msg.data);+      } else {+        console.error("Received unknown message type from WebSocket", msg);+        onError("Unknown message received from WebSocket");+      }+    };+    return socket;+  } catch (err) {+    onError(err.message);+  }+}+function websocketClose(socket) {+  if (socket) {+    socket.close();+    socket = null;+  }+}+function websocketSend(socket, message) {+  if (message && socket && socket.readyState === WebSocket.OPEN) {+    socket.send(message);+  }+}+function eventSourceConnect(url, onOpen, onMessageText, onMessageJSON, onError, textOnly) {+  try {+    let eventSource = new EventSource(url);+    eventSource.onopen = function() {+      onOpen();+    };+    eventSource.onerror = function() {+      onError("EventSource error received");+    };+    eventSource.onmessage = function(msg) {+      try {+        if (textOnly) {+          if (onMessageText)+            onMessageText(msg.data);+          return;+        }+        const json = JSON.parse(msg.data);+        if (onMessageJSON)+          onMessageJSON(json);+      } catch (err) {+        if (textOnly && onMessageText) {+          onMessageText(msg.data);+        } else {+          onError(err.message);+        }+      }+    };+    return eventSource;+  } catch (err) {+    onError(err.message);+  }+}+function eventSourceClose(eventSource) {+  if (eventSource) {+    eventSource.close();+    eventSource = null;+  }+}+function populateClass(vnode, classes) {+  if (!vnode.classList) {+    vnode.classList = new Set;+  }+  for (const str of classes) {+    for (const c of str.trim().split(" ")) {+      if (c)+        vnode.classList.add(c);+    }+  }+}+function updateRef(current, latest) {+  if (!current.parent) {+    return;+  }+  latest.nextSibling = current.nextSibling;+  latest.parent = current.parent;+  current.parent.child = latest;+}+function inline(code, context = {}) {+  const keys = Object.keys(context);+  const values = Object.values(context);+  const func = new Function(...keys, code);+  return func(...values);+}+function typeOf(x) {+  if (x === null || x === undefined)+    return 0;+  if (typeof x === "number")+    return 1;+  if (typeof x === "string")+    return 2;+  if (typeof x === "boolean")+    return 3;+  if (Array.isArray(x))+    return 4;+  return 5;+}+function splitmix32(a) {+  return function() {+    a |= 0;+    a = a + 2654435769 | 0;+    var t = a ^ a >>> 15;+    t = Math.imul(t, 2246822507);+    t = t ^ t >>> 13;+    t = Math.imul(t, 3266489909);+    return ((t ^ t >>> 16) >>> 0) / 4294967296;+  };+}+function getRandomValues() {+  const array = new Uint32Array(1);+  return crypto.getRandomValues(array)[0];+}+function mathRandom() {+  return Math.random();+}+function forEachDOMRef(tree, cb) {+  switch (tree.type) {+    case 3 /* VFrag */:+      for (const child of tree.children)+        forEachDOMRef(child, cb);+      break;+    case 0 /* VComp */:+      if (tree.child)+        forEachDOMRef(tree.child, cb);+      break;+    default:+      cb(tree.domRef);+      break;+  }+}+function getFirstDOMRef(tree) {+  switch (tree.type) {+    case 3 /* VFrag */: {+      if (!tree.children || tree.children.length === 0)+        return null;+      return getFirstDOMRef(tree.children[0]);+    }+    case 0 /* VComp */:+      if (!tree.child)+        return null;+      return getFirstDOMRef(tree.child);+    default:+      return tree.domRef;+  }+}+function getLastDOMRef(tree) {+  switch (tree.type) {+    case 3 /* VFrag */: {+      if (!tree.children || tree.children.length === 0)+        return null;+      return getLastDOMRef(tree.children[tree.children.length - 1]);+    }+    case 0 /* VComp */:+      if (!tree.child)+        return null;+      return getLastDOMRef(tree.child);+    default:+      return tree.domRef;+  }+}++// ts/miso/dom.ts+function diff(c, n, parent, context) {+  if (!c && !n)+    return;+  else if (!c)+    create(n, parent, context);+  else if (!n)+    destroy(c, parent, context);+  else if (c.type === 2 /* VText */ && n.type === 2 /* VText */) {+    diffVText(c, n, context);+  } else if (c.type === 0 /* VComp */ && n.type === 0 /* VComp */) {+    if (n.key === c.key) {+      n.child = c.child;+      n.componentId = c.componentId;+      if (c.child)+        c.child.parent = n;+      if (n.diffProps)+        n.diffProps();+      return;+    }+    replace(c, n, parent, context);+  } else if (c.type === 3 /* VFrag */ && n.type === 3 /* VFrag */) {+    if (n.key === c.key) {+      const lastRef = getLastDOMRef(c);+      const endAnchor = lastRef ? lastRef.nextSibling : context.nextSibling(c);+      diffChildren(c.children, n.children, parent, context, endAnchor);+    } else {+      replace(c, n, parent, context);+    }+  } else if (c.type === 1 /* VNode */ && n.type === 1 /* VNode */) {+    if (n.tag === c.tag && n.key === c.key) {+      n.domRef = c.domRef;+      diffAttrs(c, n, context);+    } else {+      replace(c, n, parent, context);+    }+  } else+    replace(c, n, parent, context);+}+function diffVText(c, n, context) {+  if (c.text !== n.text)+    context.setTextContent(c.domRef, n.text);+  n.domRef = c.domRef;+  return;+}+function replace(c, n, parent, context) {+  if (c.type === 3 /* VFrag */) {+    const lastRef2 = getLastDOMRef(c);+    const anchor = lastRef2 ? lastRef2.nextSibling : context.nextSibling(c);+    destroy(c, parent, context);+    if (anchor) {+      createElement(parent, 2 /* INSERT_BEFORE */, anchor, n, context);+    } else {+      create(n, parent, context);+    }+    return;+  }+  switch (c.type) {+    case 2 /* VText */:+      break;+    default:+      callBeforeDestroyedRecursive(c);+      break;+  }+  const firstRef = getFirstDOMRef(c);+  const lastRef = getLastDOMRef(c);+  if (!firstRef || !lastRef) {+    const anchor = context.nextSibling(c);+    if (anchor) {+      createElement(parent, 2 /* INSERT_BEFORE */, anchor, n, context);+    } else {+      create(n, parent, context);+    }+  } else if (firstRef !== lastRef) {+    const anchor = lastRef.nextSibling;+    forEachDOMRef(c, (ref) => context.removeChild(parent, ref));+    if (anchor) {+      createElement(parent, 2 /* INSERT_BEFORE */, anchor, n, context);+    } else {+      create(n, parent, context);+    }+  } else {+    createElement(parent, 1 /* REPLACE */, firstRef, n, context);+  }+  switch (c.type) {+    case 2 /* VText */:+      break;+    default:+      callDestroyedRecursive(c);+      break;+  }+}+function destroy(c, parent, context) {+  switch (c.type) {+    case 2 /* VText */:+      break;+    case 3 /* VFrag */:+      for (const child of c.children)+        destroy(child, parent, context);+      return;+    default:+      callBeforeDestroyedRecursive(c);+      break;+  }+  forEachDOMRef(c, (ref) => context.removeChild(parent, ref));+  switch (c.type) {+    case 2 /* VText */:+      break;+    default:+      callDestroyedRecursive(c);+      break;+  }+}+function callDestroyedRecursive(c) {+  if (c.type === 3 /* VFrag */) {+    for (const child of c.children)+      if (child.type !== 2 /* VText */)+        callDestroyedRecursive(child);+    return;+  }+  callDestroyed(c);+  switch (c.type) {+    case 1 /* VNode */:+      for (const child of c.children)+        if (child.type !== 2 /* VText */)+          callDestroyedRecursive(child);+      break;+    case 0 /* VComp */:+      if (c.child && c.child.type !== 2 /* VText */)+        callDestroyedRecursive(c.child);+      break;+  }+}+function callDestroyed(c) {+  if (c.type === 1 /* VNode */ && c.onDestroyed)+    c.onDestroyed();+  if (c.type === 0 /* VComp */)+    unmountComponent(c);+}+function callBeforeDestroyed(c) {+  switch (c.type) {+    case 0 /* VComp */:+      break;+    case 1 /* VNode */:+      if (c.onBeforeDestroyed)+        c.onBeforeDestroyed();+      break;+    default:+      break;+  }+}+function callBeforeDestroyedRecursive(c) {+  if (c.type === 3 /* VFrag */) {+    for (const child of c.children)+      if (child.type !== 2 /* VText */)+        callBeforeDestroyedRecursive(child);+    return;+  }+  callBeforeDestroyed(c);+  switch (c.type) {+    case 1 /* VNode */:+      for (const child of c.children) {+        if (child.type === 2 /* VText */)+          continue;+        callBeforeDestroyedRecursive(child);+      }+      break;+    case 0 /* VComp */:+      if (c.child && c.child.type !== 2 /* VText */)+        callBeforeDestroyedRecursive(c.child);+      break;+  }+}+function diffAttrs(c, n, context) {+  diffProps(c ? c.props : {}, n.props, n.domRef, n.ns === "svg", context);+  diffClass(c ? c.classList : null, n.classList, n.domRef, context);+  diffCss(c ? c.css : {}, n.css, n.domRef, context);+  diffChildren(c ? c.children : [], n.children, n.domRef, context);+  drawCanvas(n);+}+function diffClass(c, n, domRef, context) {+  if (!c && !n) {+    return;+  }+  if (!c) {+    for (const className of n) {+      context.addClass(className, domRef);+    }+    return;+  }+  if (!n) {+    for (const className of c) {+      context.removeClass(className, domRef);+    }+    return;+  }+  for (const className of c) {+    if (!n.has(className)) {+      context.removeClass(className, domRef);+    }+  }+  for (const className of n) {+    if (!c.has(className)) {+      context.addClass(className, domRef);+    }+  }+  return;+}+function diffProps(cProps, nProps, node, isSvg, context) {+  var newProp;+  for (const c in cProps) {+    newProp = nProps[c];+    if (newProp === undefined) {+      if (isSvg || !(c in node) || c === "disabled") {+        context.removeAttribute(node, c);+      } else {+        context.setAttribute(node, c, "");+      }+    } else {+      if (newProp === cProps[c] && c !== "checked" && c !== "value")+        continue;+      if (isSvg) {+        if (c === "href") {+          context.setAttributeNS(node, "http://www.w3.org/1999/xlink", "href", newProp);+        } else {+          context.setAttribute(node, c, newProp);+        }+      } else if (c in node && !(c === "list" || c === "form")) {+        node[c] = newProp;+      } else {+        context.setAttribute(node, c, newProp);+      }+    }+  }+  for (const n in nProps) {+    if (cProps && n in cProps)+      continue;+    newProp = nProps[n];+    if (isSvg) {+      if (n === "href") {+        context.setAttributeNS(node, "http://www.w3.org/1999/xlink", "href", newProp);+      } else {+        context.setAttribute(node, n, newProp);+      }+    } else if (n in node && !(n === "list" || n === "form")) {+      node[n] = nProps[n];+    } else {+      context.setAttribute(node, n, newProp);+    }+  }+}+function diffCss(cCss, nCss, node, context) {+  context.setInlineStyle(cCss, nCss, node);+}+function shouldSync(cs, ns) {+  if (cs.length === 0 || ns.length === 0)+    return false;+  for (var i = 0;i < cs.length; i++) {+    if (cs[i].key === null || cs[i].key === undefined) {+      return false;+    }+  }+  for (var i = 0;i < ns.length; i++) {+    if (ns[i].key === null || ns[i].key === undefined) {+      return false;+    }+  }+  return true;+}+function diffChildren(cs, ns, parent, context, endAnchor = null) {+  if (shouldSync(cs, ns)) {+    syncChildren(cs, ns, parent, context, endAnchor);+  } else {+    for (let i = 0;i < Math.max(ns.length, cs.length); i++) {+      const c = cs[i], n = ns[i];+      if (!c && n) {+        if (endAnchor) {+          createElement(parent, 2 /* INSERT_BEFORE */, endAnchor, n, context);+        } else {+          create(n, parent, context);+        }+      } else {+        diff(c, n, parent, context);+      }+    }+  }+}+function populateDomRef(c, context) {+  if (c.ns === "svg") {+    c.domRef = context.createElementNS("http://www.w3.org/2000/svg", c.tag);+  } else if (c.ns === "mathml") {+    c.domRef = context.createElementNS("http://www.w3.org/1998/Math/MathML", c.tag);+  } else {+    c.domRef = context.createElement(c.tag);+  }+}+function callCreated(parent, n, context) {+  if (n.onCreated)+    n.onCreated(n.domRef);+}+function createElement(parent, op, replacing, n, context) {+  switch (n.type) {+    case 2 /* VText */:+      n.domRef = context.createTextNode(n.text);+      switch (op) {+        case 2 /* INSERT_BEFORE */:+          context.insertBefore(parent, n.domRef, replacing);+          break;+        case 0 /* APPEND */:+          context.appendChild(parent, n.domRef);+          break;+        case 1 /* REPLACE */:+          context.replaceChild(parent, n.domRef, replacing);+          break;+      }+      break;+    case 3 /* VFrag */:+      for (const child of n.children) {+        createElement(parent, 2 /* INSERT_BEFORE */, replacing, child, context);+      }+      if (op === 1 /* REPLACE */ && replacing) {+        context.removeChild(parent, replacing);+      }+      break;+    case 0 /* VComp */:+      mountComponent(parent, op, replacing, n, context);+      break;+    case 1 /* VNode */:+      if (n.onBeforeCreated)+        n.onBeforeCreated();+      populateDomRef(n, context);+      if (n.onCreated)+        n.onCreated(n.domRef);+      diffAttrs(null, n, context);+      switch (op) {+        case 2 /* INSERT_BEFORE */:+          context.insertBefore(parent, n.domRef, replacing);+          break;+        case 0 /* APPEND */:+          context.appendChild(parent, n.domRef);+          break;+        case 1 /* REPLACE */:+          context.replaceChild(parent, n.domRef, replacing);+          break;+      }+      break;+  }+}+function drawCanvas(c) {+  if (c.tag === "canvas" && c.draw)+    c.draw(c.domRef);+}+function unmountComponent(c) {+  c.unmount(c.componentId);+}+function mountComponent(parent, op, replacing, n, context) {+  let mounted = n.mount(parent);+  n.componentId = mounted.componentId;+  n.child = mounted.componentTree;+  mounted.componentTree.parent = n;+  const componentDOMRef = getFirstDOMRef(mounted.componentTree);+  if (mounted.componentTree.type !== 0 /* VComp */) {+    if (op === 1 /* REPLACE */ && replacing) {+      if (!componentDOMRef) {+        context.removeChild(parent, replacing);+      } else if (mounted.componentTree.type === 3 /* VFrag */) {+        forEachDOMRef(mounted.componentTree, (ref) => context.insertBefore(parent, ref, replacing));+        context.removeChild(parent, replacing);+      } else {+        context.replaceChild(parent, componentDOMRef, replacing);+      }+    } else if (op === 2 /* INSERT_BEFORE */) {+      if (replacing) {+        forEachDOMRef(mounted.componentTree, (ref) => context.insertBefore(parent, ref, replacing));+      } else {+        forEachDOMRef(mounted.componentTree, (ref) => context.appendChild(parent, ref));+      }+    }+  }+}+function create(n, parent, context) {+  createElement(parent, 0 /* APPEND */, null, n, context);+}+function insertBefore(parent, n, o, context) {+  const anchor = o ? getFirstDOMRef(o) ?? context.nextSibling(o) : null;+  if (anchor) {+    forEachDOMRef(n, (ref) => context.insertBefore(parent, ref, anchor));+  } else {+    forEachDOMRef(n, (ref) => context.appendChild(parent, ref));+  }+}+function swapDOMRef(oLast, oFirst, parent, context) {+  const oLastRef = getFirstDOMRef(oLast);+  const oFirstRef = getFirstDOMRef(oFirst);+  if (oLastRef && oFirstRef && (oLast.type === 1 /* VNode */ || oLast.type === 2 /* VText */) && (oFirst.type === 1 /* VNode */ || oFirst.type === 2 /* VText */)) {+    context.swapDOMRefs(oLastRef, oFirstRef, parent);+    return;+  }+  const lastRef = getLastDOMRef(oLast);+  const tmp = lastRef ? lastRef.nextSibling : context.nextSibling(oLast);+  const anchor = getFirstDOMRef(oFirst) ?? context.nextSibling(oFirst);+  if (anchor) {+    forEachDOMRef(oLast, (ref) => context.insertBefore(parent, ref, anchor));+  } else {+    forEachDOMRef(oLast, (ref) => context.appendChild(parent, ref));+  }+  if (tmp) {+    forEachDOMRef(oFirst, (ref) => context.insertBefore(parent, ref, tmp));+  } else {+    forEachDOMRef(oFirst, (ref) => context.appendChild(parent, ref));+  }+}+function syncChildren(os, ns, parent, context, endAnchor = null) {+  var oldFirstIndex = 0, newFirstIndex = 0, oldLastIndex = os.length - 1, newLastIndex = ns.length - 1, tmp, nFirst, nLast, oLast, oFirst, found, node;+  for (;; ) {+    if (newFirstIndex > newLastIndex && oldFirstIndex > oldLastIndex) {+      break;+    }+    nFirst = ns[newFirstIndex];+    nLast = ns[newLastIndex];+    oFirst = os[oldFirstIndex];+    oLast = os[oldLastIndex];+    if (oldFirstIndex > oldLastIndex) {+      const oFirstRef = oFirst ? getFirstDOMRef(oFirst) ?? context.nextSibling(oFirst) : null;+      const anchor = oFirstRef ?? endAnchor;+      if (anchor) {+        createElement(parent, 2 /* INSERT_BEFORE */, anchor, nFirst, context);+      } else {+        create(nFirst, parent, context);+      }+      os.splice(newFirstIndex, 0, nFirst);+      newFirstIndex++;+    } else if (newFirstIndex > newLastIndex) {+      tmp = oldLastIndex;+      while (oldLastIndex >= oldFirstIndex) {+        destroy(os[oldLastIndex--], parent, context);+      }+      os.splice(oldFirstIndex, tmp - oldFirstIndex + 1);+      break;+    } else if (oFirst.key === nFirst.key) {+      diff(os[oldFirstIndex++], ns[newFirstIndex++], parent, context);+    } else if (oLast.key === nLast.key) {+      diff(os[oldLastIndex--], ns[newLastIndex--], parent, context);+    } else if (oFirst.key === nLast.key && nFirst.key === oLast.key) {+      swapDOMRef(oLast, oFirst, parent, context);+      swap(os, oldFirstIndex, oldLastIndex);+      diff(os[oldFirstIndex++], ns[newFirstIndex++], parent, context);+      diff(os[oldLastIndex--], ns[newLastIndex--], parent, context);+    } else if (oFirst.key === nLast.key) {+      const lastRef = getLastDOMRef(oLast);+      const afterOLast = lastRef ? lastRef.nextSibling : context.nextSibling(oLast);+      if (afterOLast) {+        forEachDOMRef(oFirst, (ref) => context.insertBefore(parent, ref, afterOLast));+      } else {+        forEachDOMRef(oFirst, (ref) => context.appendChild(parent, ref));+      }+      os.splice(oldLastIndex, 0, os.splice(oldFirstIndex, 1)[0]);+      diff(os[oldLastIndex--], ns[newLastIndex--], parent, context);+    } else if (oLast.key === nFirst.key) {+      insertBefore(parent, oLast, oFirst, context);+      os.splice(oldFirstIndex, 0, os.splice(oldLastIndex, 1)[0]);+      diff(os[oldFirstIndex++], nFirst, parent, context);+      newFirstIndex++;+    } else {+      found = false;+      tmp = oldFirstIndex;+      while (tmp <= oldLastIndex) {+        if (os[tmp].key === nFirst.key) {+          found = true;+          node = os[tmp];+          break;+        }+        tmp++;+      }+      if (found) {+        os.splice(oldFirstIndex, 0, os.splice(tmp, 1)[0]);+        diff(os[oldFirstIndex++], nFirst, parent, context);+        insertBefore(parent, node, os[oldFirstIndex], context);+        newFirstIndex++;+      } else {+        const anchor = getFirstDOMRef(oFirst) ?? context.nextSibling(oFirst);+        if (anchor) {+          createElement(parent, 2 /* INSERT_BEFORE */, anchor, nFirst, context);+        } else {+          create(nFirst, parent, context);+        }+        os.splice(oldFirstIndex++, 0, nFirst);+        newFirstIndex++;+        oldLastIndex++;+      }+    }+  }+}+function swap(os, l, r) {+  const k = os[l];+  os[l] = os[r];+  os[r] = k;+}++// 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, controller.signal);+  }+}+function listener(e, mount, getVTree, debug, context) {+  getVTree(function(vtree) {+    if (Array.isArray(e)) {+      for (const key of e) {+        dispatch(key, vtree, mount, debug, context);+      }+    } else {+      dispatch(e, vtree, mount, debug, context);+    }+  });+}+function dispatch(ev, vtree, mount, debug, context) {+  var target = context.getTarget(ev);+  if (target) {+    let stack = buildTargetToElement(mount, target, context);+    delegateEvent(ev, vtree, stack, debug, context);+  }+}+function buildTargetToElement(element, target, context) {+  var stack = [];+  while (!context.isEqual(element, target)) {+    stack.unshift(target);+    if (target && context.parentNode(target)) {+      target = context.parentNode(target);+    } else {+      return stack;+    }+  }+  return stack;+}+function delegateEvent(event, obj, stack, debug, context) {+  if (!stack.length) {+    if (debug) {+      console.warn('Event "' + event.type + '" did not find an event handler to dispatch on', obj, event);+    }+    return;+  } else if (stack.length > 1) {+    if (obj.type === 2 /* VText */) {+      return;+    } else if (obj.type === 3 /* VFrag */) {+      for (const child of obj.children) {+        if (containsDOMRef(child, stack[0], context)) {+          delegateEvent(event, child, stack, debug, context);+          return;+        }+      }+      return;+    } else if (obj.type === 0 /* VComp */) {+      if (!obj.child) {+        if (debug) {+          console.error("VComp has no child property set during event delegation", obj);+          console.error("This means the Component has not been fully mounted, this should never happen");+          throw new Error("VComp has no .child property set during event delegation");+        }+        return;+      }+      return delegateEvent(event, obj.child, stack, debug, context);+    } else if (obj.type === 1 /* VNode */) {+      if (context.isEqual(obj.domRef, stack[0])) {+        const eventObj = obj.events.captures[event.type];+        if (eventObj) {+          const options = eventObj.options;+          if (options.preventDefault)+            event.preventDefault();+          if (!event["captureStopped"]) {+            eventObj.runEvent(event, obj.domRef);+          }+          if (options.stopPropagation) {+            event["captureStopped"] = true;+          }+        }+        stack.splice(0, 1);+        for (const child of obj.children) {+          if (containsDOMRef(child, stack[0], context)) {+            delegateEvent(event, child, stack, debug, context);+            return;+          }+        }+      }+      return;+    }+  } else {+    if (obj.type === 0 /* VComp */) {+      if (obj.child) {+        delegateEvent(event, obj.child, stack, debug, context);+      }+    } else if (obj.type === 3 /* VFrag */) {+      for (const child of obj.children) {+        if (containsDOMRef(child, stack[0], context)) {+          delegateEvent(event, child, stack, debug, context);+          return;+        }+      }+    } else if (obj.type === 1 /* VNode */) {+      const eventCaptureObj = obj.events.captures[event.type];+      if (eventCaptureObj && !event["captureStopped"]) {+        const options = eventCaptureObj.options;+        if (context.isEqual(stack[0], obj.domRef)) {+          if (options.preventDefault)+            event.preventDefault();+          eventCaptureObj.runEvent(event, stack[0]);+          if (options.stopPropagation)+            event["captureStopped"] = true;+        }+      }+      const eventObj = obj.events.bubbles[event.type];+      if (eventObj && !event["captureStopped"]) {+        const options = eventObj.options;+        if (context.isEqual(stack[0], obj.domRef)) {+          if (options.preventDefault)+            event.preventDefault();+          eventObj.runEvent(event, stack[0]);+          if (!options.stopPropagation) {+            propagateWhileAble(obj.parent, event);+          }+        }+      } else {+        if (!event["captureStopped"]) {+          propagateWhileAble(obj.parent, event);+        }+      }+    }+  }+}+function propagateWhileAble(vtree, event) {+  while (vtree) {+    switch (vtree.type) {+      case 2 /* VText */:+        break;+      case 3 /* VFrag */:+        vtree = vtree.parent;+        break;+      case 1 /* VNode */:+        const eventObj = vtree.events.bubbles[event.type];+        if (eventObj) {+          const options = eventObj.options;+          if (options.preventDefault)+            event.preventDefault();+          eventObj.runEvent(event, vtree.domRef);+          if (options.stopPropagation) {+            return;+          }+        }+        vtree = vtree.parent;+        break;+      case 0 /* VComp */:+        if (!vtree.eventPropagation)+          return;+        vtree = vtree.parent;+        break;+    }+  }+}+function eventJSON(at, obj) {+  if (typeof at[0] === "object") {+    var ret = [];+    for (var i = 0;i < at.length; i++) {+      ret.push(eventJSON(at[i], obj));+    }+    return ret;+  }+  for (const a of at)+    obj = obj[a];+  var newObj;+  if (obj instanceof Array || "length" in obj && obj["localName"] !== "select") {+    newObj = [];+    for (var j = 0;j < obj.length; j++) {+      newObj.push(eventJSON([], obj[j]));+    }+    return newObj;+  }+  newObj = {};+  for (var key in getAllPropertyNames(obj)) {+    if (obj["localName"] === "input" && (key === "selectionDirection" || key === "selectionStart" || key === "selectionEnd")) {+      continue;+    }+    if (typeof obj[key] == "string" || typeof obj[key] == "number" || typeof obj[key] == "boolean") {+      newObj[key] = obj[key];+    }+  }+  return newObj;+}+function containsDOMRef(vtree, target, context) {+  switch (vtree.type) {+    case 3 /* VFrag */:+      for (const child of vtree.children)+        if (containsDOMRef(child, target, context))+          return true;+      return false;+    case 0 /* VComp */:+      return vtree.child ? containsDOMRef(vtree.child, target, context) : false;+    default:+      return context.isEqual(vtree.domRef, target);+  }+}+function getAllPropertyNames(obj) {+  var props = {}, i = 0;+  do {+    var names = Object.getOwnPropertyNames(obj);+    for (i = 0;i < names.length; i++) {+      props[names[i]] = null;+    }+  } while (obj = Object.getPrototypeOf(obj));+  return props;+}++// ts/miso/context/dom.ts+var eventContext = {+  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);+  },+  isEqual: (x, y) => {+    return x === y;+  },+  getTarget: (e) => {+    return e.target;+  },+  parentNode: (node) => {+    return node.parentNode;+  }+};+var hydrationContext = {+  getInlineStyle: (node, key) => {+    return node.style[key];+  },+  firstChild: (node) => {+    return node.firstChild;+  },+  lastChild: (node) => {+    return node.lastChild;+  },+  getAttribute: (node, key) => {+    if (key === "class")+      return node.className;+    if (key in node)+      return node[key];+    return node.getAttribute(key);+  },+  getTag: (node) => {+    return node.nodeName;+  },+  getTextContent: (node) => {+    return node.textContent;+  },+  children: (node) => {+    return node.childNodes;+  }+};+var componentContext = {+  mountComponent: function(componentId, model) {+    return;+  },+  unmountComponent: function(componentId) {+    return;+  },+  modelHydration: function(componentId, model) {+    return;+  }+};+var drawingContext = {+  nextSibling: (node) => {+    let sibling = node.nextSibling;+    while (sibling) {+      switch (sibling.type) {+        case 0 /* VComp */:+        case 3 /* VFrag */: {+          const ref = getFirstDOMRef(sibling);+          if (ref)+            return ref;+          sibling = sibling.nextSibling;+          break;+        }+        default:+          return sibling.domRef;+      }+    }+    return null;+  },+  createTextNode: (s) => {+    return document.createTextNode(s);+  },+  createElementNS: (ns, tag) => {+    return document.createElementNS(ns, tag);+  },+  appendChild: (parent, child) => {+    return parent.appendChild(child);+  },+  replaceChild: (parent, n, old) => {+    return parent.replaceChild(n, old);+  },+  removeChild: (parent, child) => {+    return parent.removeChild(child);+  },+  createElement: (tag) => {+    return document.createElement(tag);+  },+  addClass: (className, domRef) => {+    if (className)+      domRef.classList.add(className);+  },+  removeClass: (className, domRef) => {+    if (className)+      domRef.classList.remove(className);+  },+  insertBefore: (parent, child, node) => {+    return parent.insertBefore(child, node);+  },+  swapDOMRefs: (oLast, oFirst, p) => {+    const tmp = oLast.nextSibling;+    p.insertBefore(oLast, oFirst);+    p.insertBefore(oFirst, tmp);+    return;+  },+  setInlineStyle: (cCss, nCss, node) => {+    var result;+    for (const key in cCss) {+      result = nCss[key];+      if (!result) {+        if (key in node.style) {+          node.style[key] = "";+        } else {+          node.style.setProperty(key, "");+        }+      } else if (result !== cCss[key]) {+        if (key in node.style) {+          node.style[key] = result;+        } else {+          node.style.setProperty(key, result);+        }+      }+    }+    for (const n in nCss) {+      if (cCss && cCss[n])+        continue;+      if (n in node.style) {+        node.style[n] = nCss[n];+      } else {+        node.style.setProperty(n, nCss[n]);+      }+    }+    return;+  },+  setAttribute: (node, key, value) => {+    return node.setAttribute(key, value);+  },+  setAttributeNS: (node, ns, key, value) => {+    return node.setAttributeNS(ns, key, value);+  },+  removeAttribute: (node, key) => {+    return node.removeAttribute(key);+  },+  setTextContent: (node, text) => {+    node.textContent = text;+    return;+  },+  flush: () => {+    return;+  },+  getHead: function() {+    return document.head;+  },+  getRoot: function() {+    return document.body;+  }+};++// ts/miso/hydrate.ts+function collapseSiblingTextNodes(vs) {+  var ax = 0, adjusted = vs.length > 0 ? [vs[0]] : [];+  for (var ix = 1;ix < vs.length; ix++) {+    if (adjusted[ax].type === 2 /* VText */ && vs[ix].type === 2 /* VText */) {+      adjusted[ax].text += vs[ix].text;+      continue;+    }+    adjusted[++ax] = vs[ix];+  }+  for (const v of adjusted) {+    if (v.type === 3 /* VFrag */) {+      v.children = collapseSiblingTextNodes(v.children);+    }+  }+  return adjusted;+}+function hydrate(logLevel, mountPoint, vtree, context, drawingContext2) {+  if (!vtree || !mountPoint)+    return false;+  if (mountPoint.nodeType === 3)+    return false;+  if (!walk(logLevel, vtree, context.firstChild(mountPoint), context, drawingContext2)) {+    if (logLevel) {+      console.warn("[DEBUG_HYDRATE] Could not copy DOM into virtual DOM, falling back to diff");+    }+    while (context.firstChild(mountPoint))+      drawingContext2.removeChild(mountPoint, context.lastChild(mountPoint));+    return false;+  } else {+    if (logLevel) {+      console.info("[DEBUG_HYDRATE] Successfully prerendered page");+    }+  }+  return true;+}+function diagnoseError(logLevel, vtree, node) {+  if (logLevel)+    console.warn("[DEBUG_HYDRATE] VTree differed from node", vtree, node);+}+function nextAfter(tree, current) {+  const lastRef = getLastDOMRef(tree);+  return lastRef ? lastRef.nextSibling : current;+}+function walk(logLevel, vtree, node, context, drawingContext2) {+  switch (vtree.type) {+    case 0 /* VComp */:+      let mounted = vtree.mount(node.parentNode);+      vtree.componentId = mounted.componentId;+      vtree.child = mounted.componentTree;+      mounted.componentTree.parent = vtree;+      if (!walk(logLevel, vtree.child, node, context, drawingContext2)) {+        return false;+      }+      break;+    case 3 /* VFrag */:+      vtree.children = collapseSiblingTextNodes(vtree.children);+      for (const child of vtree.children) {+        if (!node) {+          diagnoseError(logLevel, child, null);+          return false;+        }+        if (!walk(logLevel, child, node, context, drawingContext2))+          return false;+        node = nextAfter(child, node);+      }+      break;+    case 2 /* VText */:+      if (node.nodeType !== 3 || vtree.text.trim() !== node.textContent.trim()) {+        diagnoseError(logLevel, vtree, node);+        return false;+      }+      vtree.domRef = node;+      break;+    case 1 /* VNode */:+      if (node.nodeType !== 1) {+        diagnoseError(logLevel, vtree, node);+        return false;+      }+      vtree.domRef = node;+      vtree.children = collapseSiblingTextNodes(vtree.children);+      callCreated(node, vtree, drawingContext2);+      let domCursor = node.firstChild;+      for (var i = 0;i < vtree.children.length; i++) {+        const vdomChild = vtree.children[i];+        if (!domCursor) {+          diagnoseError(logLevel, vdomChild, null);+          return false;+        }+        if (!walk(logLevel, vdomChild, domCursor, context, drawingContext2)) {+          return false;+        }+        domCursor = nextAfter(vdomChild, domCursor);+      }+      break;+  }+  return true;+}++// ts/index.ts+globalThis["miso"] = {+  hydrationContext,+  eventContext,+  drawingContext,+  componentContext,+  diff,+  hydrate,+  version,+  callBlur,+  callFocus,+  callSelect,+  callSetSelectionRange,+  eventJSON,+  fetchCore,+  eventSourceConnect,+  eventSourceClose,+  websocketConnect,+  websocketClose,+  websocketSend,+  updateRef,+  inline,+  typeOf,+  mathRandom,+  getRandomValues,+  splitmix32,+  populateClass,+  delegateEvent,+  delegator: eventContext.delegator,+  setDrawingContext: function(name) {+    const drawing = globalThis[name]["drawingContext"];+    const events = globalThis[name]["eventContext"];+    const components = globalThis[name]["componentContext"];+    if (!drawing) {+      console.error('Custom rendering engine ("drawingContext") is not defined at globalThis[name].drawingContext', name);+    }+    if (!events) {+      console.error('Custom event delegation ("eventContext") is not defined at globalThis[name].eventContext', name);+    }+    if (!components) {+      console.error('Custom component context ("componentContext") is not defined at globalThis[name].componentContext', name);+    }+    globalThis["miso"]["drawingContext"] = drawing;+    globalThis["miso"]["eventContext"] = events;+    globalThis["miso"]["componentContext"] = components;+  }+};
+ js/miso.prod.js view
@@ -0,0 +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 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;G<U.length;G++)if(U[G].key===null||U[G].key===void 0)return!1;for(var G=0;G<z.length;G++)if(z[G].key===null||z[G].key===void 0)return!1;return!0}function XU(U,z,G,H,K=null){if(EU(U,z))PU(U,z,G,H,K);else for(let Q=0;Q<Math.max(z.length,U.length);Q++){let X=U[Q],Y=z[Q];if(!X&&Y)if(K)C(G,2,K,Y,H);else D(Y,G,H);else A(X,Y,G,H)}}function DU(U,z){if(U.ns==="svg")U.domRef=z.createElementNS("http://www.w3.org/2000/svg",U.tag);else if(U.ns==="mathml")U.domRef=z.createElementNS("http://www.w3.org/1998/Math/MathML",U.tag);else U.domRef=z.createElement(U.tag)}function YU(U,z,G){if(z.onCreated)z.onCreated(z.domRef)}function C(U,z,G,H,K){switch(H.type){case 2:switch(H.domRef=K.createTextNode(H.text),z){case 2:K.insertBefore(U,H.domRef,G);break;case 0:K.appendChild(U,H.domRef);break;case 1:K.replaceChild(U,H.domRef,G);break}break;case 3:for(let Q of H.children)C(U,2,G,Q,K);if(z===1&&G)K.removeChild(U,G);break;case 0:MU(U,z,G,H,K);break;case 1:if(H.onBeforeCreated)H.onBeforeCreated();if(DU(H,K),H.onCreated)H.onCreated(H.domRef);switch(QU(null,H,K),z){case 2:K.insertBefore(U,H.domRef,G);break;case 0:K.appendChild(U,H.domRef);break;case 1:K.replaceChild(U,H.domRef,G);break}break}}function IU(U){if(U.tag==="canvas"&&U.draw)U.draw(U.domRef)}function wU(U){U.unmount(U.componentId)}function MU(U,z,G,H,K){let Q=H.mount(U);H.componentId=Q.componentId,H.child=Q.componentTree,Q.componentTree.parent=H;let X=q(Q.componentTree);if(Q.componentTree.type!==0){if(z===1&&G)if(!X)K.removeChild(U,G);else if(Q.componentTree.type===3)W(Q.componentTree,(Y)=>K.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<U.length;H++)G.push(L(U[H],z));return G}for(let Y of U)z=z[Y];var K;if(z instanceof Array||"length"in z&&z.localName!=="select"){K=[];for(var Q=0;Q<z.length;Q++)K.push(L([],z[Q]));return K}K={};for(var X in OU(z)){if(z.localName==="input"&&(X==="selectionDirection"||X==="selectionStart"||X==="selectionEnd"))continue;if(typeof z[X]=="string"||typeof z[X]=="number"||typeof z[X]=="boolean")K[X]=z[X]}return K}function F(U,z,G){switch(U.type){case 3:for(let H of U.children)if(F(H,z,G))return!0;return!1;case 0:return U.child?F(U.child,z,G):!1;default:return G.isEqual(U.domRef,z)}}function OU(U){var z={},G=0;do{var H=Object.getOwnPropertyNames(U);for(G=0;G<H.length;G++)z[H[G]]=null}while(U=Object.getPrototypeOf(U));return z}var j={addEventListener:(U,z,G,H,K)=>{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<U.length;H++){if(G[z].type===2&&U[H].type===2){G[z].text+=U[H].text;continue}G[++z]=U[H]}for(let K of G)if(K.type===3)K.children=zU(K.children);return G}function GU(U,z,G,H,K){if(!G||!z)return!1;if(z.nodeType===3)return!1;if(!b(U,G,H.firstChild(z),H,K)){if(U)console.warn("[DEBUG_HYDRATE] Could not copy DOM into virtual DOM, falling back to diff");while(H.firstChild(z))K.removeChild(z,H.lastChild(z));return!1}else if(U)console.info("[DEBUG_HYDRATE] Successfully prerendered page");return!0}function k(U,z,G){if(U)console.warn("[DEBUG_HYDRATE] VTree differed from node",z,G)}function qU(U,z){let G=N(U);return G?G.nextSibling:z}function b(U,z,G,H,K){switch(z.type){case 0:let X=z.mount(G.parentNode);if(z.componentId=X.componentId,z.child=X.componentTree,X.componentTree.parent=z,!b(U,z.child,G,H,K))return!1;break;case 3:z.children=zU(z.children);for(let $ of z.children){if(!G)return k(U,$,null),!1;if(!b(U,$,G,H,K))return!1;G=qU($,G)}break;case 2:if(G.nodeType!==3||z.text.trim()!==G.textContent.trim())return k(U,z,G),!1;z.domRef=G;break;case 1:if(G.nodeType!==1)return k(U,z,G),!1;z.domRef=G,z.children=zU(z.children),YU(G,z,K);let Y=G.firstChild;for(var Q=0;Q<z.children.length;Q++){let $=z.children[Q];if(!Y)return k(U,$,null),!1;if(!b(U,$,Y,H,K))return!1;Y=qU($,Y)}break}return!0}globalThis.miso={hydrationContext:_U,eventContext:j,drawingContext:UU,componentContext:WU,diff:A,hydrate:GU,version:m,callBlur:h,callFocus:y,callSelect:u,callSetSelectionRange:g,eventJSON:L,fetchCore:v,eventSourceConnect:d,eventSourceClose:p,websocketConnect:l,websocketClose:x,websocketSend:i,updateRef:s,inline:r,typeOf:c,mathRandom:t,getRandomValues:n,splitmix32:o,populateClass:a,delegateEvent:E,delegator:j.delegator,setDrawingContext:function(U){let z=globalThis[U].drawingContext,G=globalThis[U].eventContext,H=globalThis[U].componentContext;if(!z)console.error('Custom rendering engine ("drawingContext") is not defined at globalThis[name].drawingContext',U);if(!G)console.error('Custom event delegation ("eventContext") is not defined at globalThis[name].eventContext',U);if(!H)console.error('Custom component context ("componentContext") is not defined at globalThis[name].componentContext',U);globalThis.miso.drawingContext=z,globalThis.miso.eventContext=G,globalThis.miso.componentContext=H}};
− jsaddle-ffi/Miso/Dev.hs 
@@ -1,14 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Miso.Dev--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.Dev-  ( clearBody-  ) where--import Miso.FFI (clearBody)
− jsaddle-ffi/Miso/FFI.hs 
@@ -1,274 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE LambdaCase #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.FFI--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.FFI-   ( JSM-   , forkJSM-   , asyncCallback-   , asyncCallback1-   , callbackToJSVal-   , objectToJSVal-   , ghcjsPure-   , syncPoint-   , addEventListener-   , windowAddEventListener-   , windowInnerHeight-   , windowInnerWidth-   , eventPreventDefault-   , eventStopPropagation-   , now-   , consoleLog-   , consoleLogJSVal-   , stringify-   , parse-   , clearBody-   , objectToJSON-   , set-   , getBody-   , getDoc-   , getElementById-   , diff'-   , integralToJSString-   , realFloatToJSString-   , jsStringToDouble-   , delegateEvent-   , copyDOMIntoVTree-   , swapCallbacks-   , releaseCallbacks-   , registerCallback-   , focus-   , blur-   , scrollIntoView-   , alert-   ) where--import           Control.Concurrent-import           Control.Monad.IO.Class-import           Data.Aeson hiding (Object)-import           Data.JSString-import           GHCJS.Marshal-import           GHCJS.Types-import qualified JavaScript.Object.Internal as OI-import           Language.Javascript.JSaddle hiding (Success, obj, val)---- | Run given `JSM` action asynchronously, in a separate thread.-forkJSM :: JSM () -> JSM ()-forkJSM a = do-  ctx <- askJSM-  _ <- liftIO (forkIO (runJSM a ctx))-  pure ()--asyncCallback :: JSM () -> JSM Function-asyncCallback a = asyncFunction (\_ _ _ -> a)--asyncCallback1 :: (JSVal -> JSM ()) -> JSM Function-asyncCallback1 f = asyncFunction (\_ _ [x] -> f x)--callbackToJSVal :: Function -> JSM JSVal-callbackToJSVal = toJSVal--objectToJSVal :: Object -> JSM JSVal-objectToJSVal = toJSVal---- | Set property on object-set :: ToJSVal v => JSString -> v -> OI.Object -> JSM ()-set (unpack -> "class") v obj = do-  classSet <- ((pack "class") `elem`) <$> listProps obj-  if classSet-    then do-      classStr <- fromJSValUnchecked =<< getProp (pack "class") obj-      vStr <- fromJSValUnchecked =<< toJSVal v-      v' <- toJSVal (classStr <> pack " " <> vStr)-      setProp (pack "class") v' obj-    else do-      v' <- toJSVal v-      setProp (pack "class") v' obj-set k v obj = do-  v' <- toJSVal v-  setProp k v' obj---- | Register an event listener on given target.-addEventListener :: JSVal             -- ^ Event target on which we want to register event listener-                 -> JSString          -- ^ Type of event to listen to (e.g. "click")-                 -> (JSVal -> JSM ()) -- ^ Callback which will be called when the event occurs, the event will be passed to it as a parameter.-                 -> JSM ()-addEventListener self name cb = do-  _ <- self # "addEventListener" $ (name, asyncFunction (\_ _ [a] -> cb a))-  pure ()---- | Registers an event listener on window-windowAddEventListener :: JSString           -- ^ Type of event to listen to (e.g. "click")-                       -> (JSVal -> JSM ())  -- ^ Callback which will be called when the event occurs, the event will be passed to it as a parameter.-                       -> JSM ()-windowAddEventListener name cb = do-  win <- jsg "window"-  addEventListener win name cb--eventStopPropagation :: JSVal -> JSM ()-eventStopPropagation e = do-  _ <- e # "stopPropagation" $ ()-  pure ()--eventPreventDefault :: JSVal -> JSM ()-eventPreventDefault e = do-  _ <- e # "preventDefault" $ ()-  pure ()---- | Retrieves the height (in pixels) of the browser window viewport including, if rendered, the horizontal scrollbar.------ See <https://developer.mozilla.org/en-US/docs/Web/API/Window/innerHeight>-windowInnerHeight :: JSM Int-windowInnerHeight =-  fromJSValUnchecked =<< jsg "window" ! "innerHeight"---- | Retrieves the width (in pixels) of the browser window viewport including, if rendered, the vertical scrollbar.------ See <https://developer.mozilla.org/en-US/docs/Web/API/Window/innerWidth>-windowInnerWidth :: JSM Int-windowInnerWidth =-  fromJSValUnchecked =<< jsg "window" ! "innerWidth"---- | Retrieve high resolution time stamp------ See <https://developer.mozilla.org/en-US/docs/Web/API/Performance/now>-now :: JSM Double-now = fromJSValUnchecked =<< (jsg "performance" # "now" $ ())---- | Outputs a message to the web console------ See <https://developer.mozilla.org/en-US/docs/Web/API/Console/log>-consoleLog :: JSString -> JSM ()-consoleLog v = do-  _ <- jsg "console" # "log" $ [toJSString v]-  pure ()---- | Console-logging-consoleLogJSVal :: JSVal -> JSM ()-consoleLogJSVal v = do-  _ <- jsg "console" # "log" $ [v]-  pure ()---- | Converts a JS object into a JSON string-stringify :: ToJSON json => json -> JSM JSString-{-# INLINE stringify #-}-stringify j = do-  v <- toJSVal (toJSON j)-  fromJSValUnchecked =<< (jsg "JSON" # "stringify" $ [v])---- | Parses a JSString-parse :: FromJSON json => JSVal -> JSM json-{-# INLINE parse #-}-parse jval = do-  val <- fromJSValUnchecked =<< (jsg "JSON" # "parse" $ [jval])-  case fromJSON val of-    Success x -> pure x-    Error y -> error y---- | Clear the document body. This is particularly useful to avoid--- creating multiple copies of your app when running in GHCJSi.-clearBody :: JSM ()-clearBody =-  (jsg "document" ! "body"  <# "innerHtml") [""]--objectToJSON-    :: JSVal -- ^ decodeAt :: [JSString]-    -> JSVal -- ^ object with impure references to the DOM-    -> JSM JSVal-objectToJSON = jsg2 "objectToJSON"---- | Retrieves a reference to document body.------ See <https://developer.mozilla.org/en-US/docs/Web/API/Document/body>-getBody :: JSM JSVal-getBody = jsg "document" ! "body"----- | Retrieves a reference to the document.------ See <https://developer.mozilla.org/en-US/docs/Web/API/Document>-getDoc :: JSM JSVal-getDoc = jsg "document"---- | Returns an Element object representing the element whose id property matches the specified string.------ See <https://developer.mozilla.org/en-US/docs/Web/API/Document/getElementById>-getElementById :: JSString -> JSM JSVal-getElementById e = getDoc # "getElementById" $ [e]--diff'-    :: OI.Object -- ^ current object-    -> OI.Object -- ^ new object-    -> JSVal  -- ^ parent node-    -> JSVal -- ^ document-    -> JSM ()-diff' a b c d = () <$ jsg4 "diff" a b c d--integralToJSString :: Integral a => a -> JSString-integralToJSString = pack . show . toInteger--realFloatToJSString :: RealFloat a => a -> JSString-realFloatToJSString x = (pack . show) (realToFrac x :: Double)--jsStringToDouble :: JSString -> Double-jsStringToDouble = read . unpack--delegateEvent :: JSVal -> JSVal -> JSM JSVal -> JSM ()-delegateEvent mountPoint events getVTree = do-  cb' <- asyncFunction $ \_ _ [continuation] -> do-    res <- getVTree-    _ <- call continuation global res-    pure ()-  delegateEvent' mountPoint events cb'--delegateEvent' :: JSVal -> JSVal -> Function -> JSM ()-delegateEvent' mountPoint events cb = () <$ jsg3 "delegate" mountPoint events cb---- | Copies DOM pointers into virtual dom--- entry point into isomorphic javascript-copyDOMIntoVTree :: Bool -> JSVal -> JSVal -> JSM ()-copyDOMIntoVTree logLevel mountPoint a = () <$ jsg3 "copyDOMIntoVTree" logLevel mountPoint a---- TODO For now, we do not free callbacks when compiling with JSaddle---- | Pins down the current callbacks for clearing later-swapCallbacks :: JSM ()-swapCallbacks = pure ()---- | Releases callbacks registered by the virtual DOM.-releaseCallbacks :: JSM ()-releaseCallbacks = pure ()--registerCallback :: JSVal -> JSM ()-registerCallback _ = pure ()---- | Fails silently if the element is not found.------ Analogous to @document.getElementById(id).focus()@.-focus :: JSString -> JSM ()-focus a = () <$ jsg1 "callFocus" a---- | Fails silently if the element is not found.------ Analogous to @document.getElementById(id).blur()@-blur :: JSString -> JSM ()-blur a = () <$ jsg1 "callBlur" a---- | Calls @document.getElementById(id).scrollIntoView()@-scrollIntoView :: JSString -> JSM ()-scrollIntoView elId = do-  el <- jsg "document" # "getElementById" $ [elId]-  _ <- el # "scollIntoView" $ ()-  pure ()---- | Calls the @alert()@ function.-alert :: JSString -> JSM ()-alert a = () <$ jsg1 "alert" a
− jsaddle-ffi/Miso/FFI/History.hs 
@@ -1,56 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Miso.FFI.History--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.FFI.History-  ( getWindowLocationHref-  , go-  , back-  , forward-  , pushState-  , replaceState-  ) where--import Control.Monad-import GHCJS.Types-import Language.Javascript.JSaddle--getWindowLocationHref :: JSM JSString-getWindowLocationHref = do-  href <- fromJSVal =<< jsg "window" ! "location" ! "href"-  case join href of-    Nothing -> pure mempty-    Just uri -> pure uri--getHistory :: JSM JSVal-getHistory = jsg "window" ! "history"--go :: Int -> JSM ()-go i = do-  _ <- getHistory # "go" $ [i]-  pure ()--back :: JSM ()-back = do-  _ <- getHistory # "back" $ ()-  pure ()--forward :: JSM ()-forward = do-  _ <- getHistory # "forward" $ ()-  pure ()--pushState :: JSString -> JSM ()-pushState url = do-  _ <- getHistory # "pushState" $ (jsNull, jsNull, url)-  pure ()--replaceState :: JSString -> JSM ()-replaceState url = do-  _ <- getHistory # "replaceState" $ (jsNull, jsNull, url)-  pure ()
− jsaddle-ffi/Miso/FFI/SSE.hs 
@@ -1,38 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE LambdaCase #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.FFI.SSE--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.FFI.SSE-  ( EventSource(..)-  , data'-  , new-  , addEventListener-  ) where--import           GHCJS.Types--import           Miso.FFI (JSM)-import qualified Miso.FFI as FFI--import qualified Language.Javascript.JSaddle as JSaddle-import           Language.Javascript.JSaddle hiding (new)--newtype EventSource = EventSource JSVal--data' :: JSVal -> JSM JSVal-data' v = v ! ("data" :: JSString)--new :: JSString -> JSM EventSource-new url = EventSource <$> JSaddle.new (jsg ("EventSource" :: JSString)) [url]--addEventListener :: EventSource -> JSString -> (JSVal -> JSM ()) -> JSM ()-addEventListener (EventSource s) = FFI.addEventListener s
− jsaddle-ffi/Miso/FFI/Storage.hs 
@@ -1,54 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Miso.FFI.Storage--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.FFI.Storage-  ( Storage-  , localStorage-  , sessionStorage-  , getItem-  , removeItem-  , setItem-  , length-  , clear-  ) where--import GHCJS.Types-import Prelude hiding (length)--import Language.Javascript.JSaddle ((!), (#), JSM, fromJSValUnchecked, jsg)--newtype Storage = Storage JSVal--localStorage :: JSM Storage-localStorage = Storage <$> (jsg "window" ! "localStorage")--sessionStorage :: JSM Storage-sessionStorage = Storage <$> (jsg "window" ! "sessionStorage")--getItem :: Storage -> JSString -> JSM JSVal-getItem (Storage s) key =-  s # "getItem" $ [key]--removeItem :: Storage -> JSString -> JSM ()-removeItem (Storage s) key = do-  _ <- s # "removeItem" $ [key]-  pure ()--setItem :: Storage -> JSString -> JSString -> JSM ()-setItem (Storage s) key val = do-  _ <- s # "setItem" $ (key, val)-  pure ()--length :: Storage -> JSM Int-length (Storage s) = fromJSValUnchecked =<< s ! "length"--clear :: Storage -> JSM ()-clear (Storage s) = do-  _ <- s # "clear" $ ()-  pure ()
− jsaddle-ffi/Miso/FFI/WebSocket.hs 
@@ -1,67 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE LambdaCase #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.FFI.WebSocket--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------------------------------------------------------------------------------module Miso.FFI.WebSocket-  ( Socket(..)-  , create-  , socketState-  , send-  , close-  , addEventListener-  , data'-  , wasClean-  , code-  , reason-  ) where--import           GHCJS.Types--import           Language.Javascript.JSaddle hiding (create)--import           Miso.FFI (JSM)-import qualified Miso.FFI as FFI-import           Miso.WebSocket--newtype Socket = Socket JSVal--create :: JSString -> JSVal -> JSM Socket-create url protocols = Socket <$> new (jsg ("WebSocket" :: JSString)) (url, protocols)--socketState :: Socket -> JSM Int-socketState (Socket s) = fromJSValUnchecked =<< s ! ("readyState" :: JSString)--send :: Socket -> JSString -> JSM ()-send (Socket s) msg = do-  _ <- s # ("send" :: JSString) $ [msg]-  pure ()--close :: Socket -> JSM ()-close (Socket s) = do-  _ <- s # ("close" :: JSString) $ ([] :: [JSString])-  pure ()--addEventListener :: Socket -> JSString -> (JSVal -> JSM ()) -> JSM ()-addEventListener (Socket s) name cb = do-  FFI.addEventListener s name cb--data' :: JSVal -> JSM JSVal-data' v = v ! ("data" :: JSString)--wasClean :: JSVal -> JSM WasClean-wasClean v = WasClean <$> (fromJSValUnchecked =<< v ! ("wasClean" :: JSString))--code :: JSVal -> JSM Int-code v = fromJSValUnchecked =<< v ! ("code" :: JSString)--reason :: JSVal -> JSM Reason-reason v = Reason <$> (fromJSValUnchecked =<< v ! ("reason" :: JSString))
− jsbits/delegate.js 
@@ -1,129 +0,0 @@-window = typeof window === 'undefined' ? {} : window;-window['oldCallbacks'] = [];-window['currentCallbacks'] = [];--/* Callbacks in ghcjs need to be released. With this function one can register-   callbacks that should be released right before diffing.-*/-window['registerCallback'] = function registerCallback(cb) {-  window['currentCallbacks'].push(cb);-};--/* Swaps out the new calbacks for old callbacks.-The old callbacks should be cleared once the new callbacks have replaced them.-*/-window['swapCallbacks'] = function swapCallbacks() {-  window['oldCallbacks'] = window['currentCallbacks'];-  window['currentCallbacks'] = [];-};--/* This releases the old callbacks. */-window['releaseCallbacks'] = function releaseCallbacks() {-  for (var i in window['oldCallbacks'])-    h$release(window['oldCallbacks'][i]);--  window['oldCallbacks'] = [];-};--/* event delegation algorithm */-window['delegate'] = function delegate(mountPointElement, events, getVTree) {-  for (var event in events) {-    mountPointElement.addEventListener(events[event][0], function(e) {-      getVTree(function (obj) {-	window['delegateEvent'](e, obj, window['buildTargetToElement'](mountPointElement, e.target), []);-      });-    }, events[event][1]);-  }-};--/* Accumulate parent stack as well for propagation */-window['delegateEvent'] = function delegateEvent (event, obj, stack, parentStack) {--  /* base case, not found */-  if (!stack.length) return;--  /* stack not length 1, recurse */-  else if (stack.length > 1) {-    parentStack.unshift(obj);-    for (var o = 0; o < obj.children.length; o++) {-      if (obj.children[o]['domRef'] === stack[1]) {-        delegateEvent( event, obj.children[o], stack.slice(1), parentStack );-        break;-      }-    }-  }--  /* stack.length == 1 */-  else {-      var eventObj = obj['events'][event.type];-      if (eventObj) {-	var options = eventObj.options;-        if (options['preventDefault'])-  	  event.preventDefault();-        eventObj['runEvent'](event);-        if (!options['stopPropagation'])- 	  window['propogateWhileAble'] (parentStack, event);-      } else {-	/* still propagate to parent handlers even if event not defined */-	window['propogateWhileAble'] (parentStack, event);-      }-   }-};--window['buildTargetToElement'] = function buildTargetToElement (element, target) {-  var stack = [];-  while (element !== target) {-    stack.unshift (target);-    target = target.parentNode;-  }-  return stack;-};--window['propogateWhileAble'] = function propogateWhileAble (parentStack, event) {-  for (var i = 0; i < parentStack.length; i++) {-    if (parentStack[i]['events'][event.type]) {-      var eventObj = parentStack[i]['events'][event.type],-	  options = eventObj['options'];-      if (options['preventDefault']) event.preventDefault();-      eventObj['runEvent'](event);-      if (options['stopPropagation']) break;-    }-  }-};--/* Walks down obj following the path described by `at`, then filters primitive- values (string, numbers and booleans)*/-window['objectToJSON'] = function objectToJSON (at, obj) {-  /* If at is of type [[MisoString]] */-  if (typeof at[0] == 'object') {-    var ret = [];-    for (var i = 0; i < at.length; i++)-      ret.push(window['objectToJSON'](at[i], obj));-    return ret;-  }--  for (var i in at) obj = obj[at[i]];--  /* If obj is a list-like object */-  var newObj;-  if (obj instanceof Array) {-    newObj = [];-    for (var i = 0; i < obj.length; i++)-      newObj.push(window['objectToJSON']([], obj[i]));-    return newObj;-  }--  /* If obj is a non-list-like object */-  newObj = {};-  var isInput = obj['localName'] === 'input';-  for (var i in obj){-    /* bug in safari, throws TypeError if the following fields are referenced on a checkbox */-    /* https://stackoverflow.com/a/25569117/453261 */-    /* https://html.spec.whatwg.org/multipage/input.html#do-not-apply */-    if (isInput && (i === 'selectionDirection' || i === 'selectionStart' || i === 'selectionEnd'))-      continue;-    if (typeof obj[i] == 'string' || typeof obj[i] == 'number' || typeof obj[i] == 'boolean')-      newObj[i] = obj[i];-  }-  return newObj;-};
− jsbits/diff.js 
@@ -1,360 +0,0 @@-/* virtual-dom diffing algorithm, applies patches as detected */-window = typeof window === 'undefined' ? {} : window;-window['diff'] = function diff(currentObj, newObj, parent, doc) {-  if (!currentObj && !newObj) return;-  else if (!currentObj && newObj) window['createNode'](newObj, parent, doc);-  else if (currentObj && !newObj) window['destroyNode'](currentObj, parent);-  else {-    if (currentObj.type === 'vtext') {-      if (newObj.type === 'vnode') window['replaceTextWithElement'](currentObj, newObj, parent, doc);-      else window['diffTextNodes'](currentObj, newObj);-    } else {-      if (newObj.type === 'vnode') window['diffVNodes'](currentObj, newObj, parent, doc);-      else window['replaceElementWithText'](currentObj, newObj, parent, doc);-    }-  }-};--window['destroyNode'] = function destroyNode(obj, parent) {-  window['callBeforeDestroyedRecursive'](obj);-  parent.removeChild(obj['domRef']);-  window['callDestroyedRecursive'](obj);-};--window['callDestroyedRecursive'] = function callDestroyedRecursive(obj) {-  window['callDestroyed'](obj);-  for (var i in obj.children)-    window['callDestroyedRecursive'](obj.children[i]);-};--window['callDestroyed'] = function callDestroyed(obj) {-  if (obj['onDestroyed']) obj['onDestroyed']();-};--window['callBeforeDestroyed'] = function callBeforeDestroyed(obj) {-  if (obj['onBeforeDestroyed']) obj['onBeforeDestroyed']();-};--window['callBeforeDestroyedRecursive'] = function callBeforeDestroyedRecursive(obj) {-  window['callBeforeDestroyed'](obj);-  for (var i in obj.children)-    window['callBeforeDestroyedRecursive'](obj.children[i]);-};--window['diffTextNodes'] = function diffTextNodes(c, n) {-  if (c['text'] !== n['text']) c['domRef'].textContent = n['text'];-  n['domRef'] = c['domRef'];-};--window['replaceElementWithText'] = function replaceElementWithText(c, n, parent, doc) {-  n['domRef'] = doc.createTextNode(n['text']);-  window['callBeforeDestroyedRecursive'](c);-  parent.replaceChild(n['domRef'], c['domRef']);-  window['callDestroyedRecursive'](c);-};--window['replaceTextWithElement'] = function replaceTextWithElement(c, n, parent, doc) {-  window['createElement'](n, doc);-  parent.replaceChild(n['domRef'], c['domRef']);-  window['callCreated'](n);-};--window['callCreated'] = function callCreated(obj) {-  if (obj['onCreated']) obj['onCreated']();-};--window['populate'] = function populate(c, n, doc) {-  if (!c) c = {-              props: null,-              css: null,-              children: []-              }-  window['diffProps'](c['props'], n['props'], n['domRef'], n['ns'] === 'svg');-  window['diffCss'](c['css'], n['css'], n['domRef']);-  window['diffChildren'](c['children'], n['children'], n['domRef'], doc);-};--window['diffVNodes'] = function diffVNodes(c, n, parent, doc) {-  if (c['tag'] === n['tag'] && n['key'] === c['key']) {-    n['domRef'] = c['domRef'];-    window['populate'](c, n, doc);-  } else {-    window['createElement'](n, doc);-    window['callBeforeDestroyedRecursive'](c);-    parent.replaceChild(n['domRef'], c['domRef']);-    window['callDestroyedRecursive'](c);-    window['callCreated'](n);-  }-};--window['diffProps'] = function diffProps(cProps, nProps, node, isSvg) {-  var newProp;-  /* Is current prop in new prop list? */-  for (var c in cProps) {-    newProp = nProps[c];-    /* If current property no longer exists, remove it */-    if (!newProp) {-      /* current key is not in node, remove it from DOM, if SVG, remove attribute */-      if (isSvg || !(c in node))-        node.removeAttribute(c, cProps[c]);-      else-        node[c] = '';-    } else {-      /* Already on DOM from previous diff, continue */-      if (newProp === cProps[c] && c !== 'checked' && c !== 'value') continue;-      if (isSvg) {-        if (c === 'href')-          node.setAttributeNS('http://www.w3.org/1999/xlink', 'href', newProp);-        else-          node.setAttribute(c, newProp);-      } else if (c in node && !(c === 'list' || c === 'form')) {-        node[c] = newProp;-      } else {-        node.setAttribute(c, newProp);-      }-    }-  }-  /* add remaining */-  for (var n in nProps) {-    if (cProps && cProps[n]) continue;-    newProp = nProps[n];-    /* Only add new properties, skip (continue) if they already exist in current property map */-    if (isSvg) {-      if (n === 'href')-        node.setAttributeNS('http://www.w3.org/1999/xlink', 'href', newProp);-      else-        node.setAttribute(n, newProp);-    } else if (n in node && !(n === 'list' || n === 'form')) {-      node[n] = nProps[n];-    } else {-      node.setAttribute(n, newProp);-    }-  }-};--window['diffCss'] = function diffCss(cCss, nCss, node) {-  var result;-  /* is current attribute in new attribute list? */-  for (var c in cCss) {-    result = nCss[c];-    if (!result) {-      /* current key is not in node */-      node.style[c] = null;-    } else if (result !== cCss[c]) {-      node.style[c] = result;-    }-  }-  /* add remaining */-  for (var n in nCss) {-    if (cCss && cCss[n]) continue;-    node.style[n] = nCss[n];-  }-};--window['hasKeys'] = function hasKeys(ns, cs) {-  return ns.length > 0 && cs.length > 0 && ns[0]['key'] != null && cs[0]['key'] != null;-};--window['diffChildren'] = function diffChildren(cs, ns, parent, doc) {-  var longest = ns.length > cs.length ? ns.length : cs.length;-  if (window['hasKeys'](ns, cs)) {-    window['syncChildren'](cs, ns, parent, doc);-  } else {-    for (var i = 0; i < longest; i++)-      window['diff'](cs[i], ns[i], parent, doc);-  }-};--window['createElement'] = function createElement(obj, doc) {-  if (obj['ns'] === 'svg') {-    obj['domRef'] = doc.createElementNS('http://www.w3.org/2000/svg', obj['tag']);-  } else if (obj['ns'] === 'mathml') {-    obj['domRef'] = doc.createElementNS('http://www.w3.org/1998/Math/MathML', obj['tag']);-  } else {-    obj['domRef'] = doc.createElement(obj['tag']);-  }-  window['populate'](null, obj, doc);-};--window['createNode'] = function createNode(obj, parent, doc) {-  if (obj.type === 'vnode') window['createElement'](obj, doc);-  else obj['domRef'] = doc.createTextNode(obj['text']);-  parent.appendChild(obj['domRef']);-  window['callCreated'](obj);-};--/* Child reconciliation algorithm, inspired by kivi and Bobril */-window['syncChildren'] = function syncChildren(os, ns, parent, doc) {-  var oldFirstIndex = 0,-  newFirstIndex = 0,-  oldLastIndex = os.length - 1,-  newLastIndex = ns.length - 1,-  nFirst, nLast, oLast, oFirst, tmp, found, node;-  for (;;) {-    /* check base case, first > last for both new and old-      [ ] -- old children empty (fully-swapped)-      [ ] -- new children empty (fully-swapped)-    */-    if (newFirstIndex > newLastIndex && oldFirstIndex > oldLastIndex) {-      break;-    }--    /* Initialize */-    nFirst = ns[newFirstIndex];-    nLast = ns[newLastIndex];-    oFirst = os[oldFirstIndex];-    oLast = os[oldLastIndex];-    /* No more old nodes, create and insert all remaining nodes-       -> [ ] <- old children-       -> [ a b c ] <- new children-    */-    if (oldFirstIndex > oldLastIndex) {-      window['diff'](null, nFirst, parent, doc);-      /* insertBefore's semantics will append a node if the second argument provided is `null` or `undefined`.-         Otherwise, it will insert node['domRef'] before oLast['domRef']. */-      parent.insertBefore(nFirst['domRef'], oFirst ? oFirst['domRef'] : null);-      os.splice(newFirstIndex, 0, nFirst);-      newFirstIndex++;-    }-    /* No more new nodes, delete all remaining nodes in old list-       -> [ a b c ] <- old children-       -> [ ] <- new children-    */-    else if (newFirstIndex > newLastIndex) {-      tmp = oldLastIndex;-      while (oldLastIndex >= oldFirstIndex) {-        parent.removeChild(os[oldLastIndex--]['domRef']);-      }-      os.splice(oldFirstIndex, tmp - oldFirstIndex + 1);-      break;-    }-    /* happy path, everything aligns, we continue-       -> oldFirstIndex -> [ a b c ] <- oldLastIndex-       -> newFirstIndex -> [ a b c ] <- newLastIndex-       check if nFirst and oFirst align, if so, check nLast and oLast-    */-    else if (oFirst['key'] === nFirst['key']) {-      window['diff'](os[oldFirstIndex++], ns[newFirstIndex++], parent, doc);-    } else if (oLast['key'] === nLast['key']) {-      window['diff'](os[oldLastIndex--], ns[newLastIndex--], parent, doc);-    }-    /* flip-flop case, nodes have been swapped, in some way or another-       both could have been swapped.-       -> [ a b c ] <- old children-       -> [ c b a ] <- new children-    */-    else if (oFirst['key'] === nLast['key'] && nFirst['key'] === oLast['key']) {-      window['swapDomRefs'](node, oLast['domRef'], oFirst['domRef'], parent);-      window['swap'](os, oldFirstIndex, oldLastIndex);-      window['diff'](os[oldFirstIndex++], ns[newFirstIndex++], parent, doc);-      window['diff'](os[oldLastIndex--], ns[newLastIndex--], parent, doc);-    }-    /* Or just one could be swapped (d's align here)-           This is top left and bottom right match case.-           We move d to end of list, mutate old vdom to reflect the change-           We then continue without affecting indexes, hoping to land in a better case-           -> [ d a b ] <- old children-           -> [ a b d ] <- new children-           becomes-           -> [ a b d ] <- old children-           -> [ a b d ] <- new children-           and now we happy path-       */-    else if (oFirst['key'] === nLast['key']) {-      /* insertAfter */-      parent.insertBefore(oFirst['domRef'], oLast['domRef'].nextSibling);-      /* swap positions in old vdom */-      os.splice(oldLastIndex,0,os.splice(oldFirstIndex,1)[0]);-      window['diff'](os[oldLastIndex--], ns[newLastIndex--], parent, doc);-    }-    /* This is top right and bottom lefts match case.-       We move d to end of list, mutate old vdom to reflect the change-       -> [ b a d ] <- old children-       -> [ d b a ] <- new children-       becomes-       -> [ d b a ] <- old children-       -> [ d b a ] <- new children-       and now we happy path-    */-    else if (oLast['key'] === nFirst['key']) {-      /* insertAfter */-      parent.insertBefore(oLast['domRef'], oFirst['domRef']);-      /* swap positions in old vdom */-      os.splice(oldFirstIndex,0, os.splice(oldLastIndex,1)[0]);-      window['diff'](os[oldFirstIndex++], nFirst, parent, doc);-      newFirstIndex++;-    }--    /* The 'you're screwed' case, nothing aligns, pull the ripcord, do something more fancy-       This can happen when the list is sorted, for example.-       -> [ a e c ] <- old children-       -> [ b e d ] <- new children-    */-    else {-      /* final case, perform linear search to check if new key exists in old map, decide what to do from there */-      found = false;-      tmp = oldFirstIndex;-      while (tmp <= oldLastIndex) {-        if (os[tmp]['key'] === nFirst['key']) {-          found = true;-          node = os[tmp];-          break;-        }-        tmp++;-      }-          /* If new key was found in old map this means it was moved, hypothetically as below-         -> [ a e b c ] <- old children-         -> [ b e a j ] <- new children-          ^-         In the above case 'b' has been moved, so we need to insert 'b' before 'a' in both vDOM and DOM-         We also increase oldFirstIndex and newFirstIndex.--         This results in new list below w/ updated index position-         -> [ b a e c ] <- old children-         -> [ b e a j ] <- new children-            ^-      */-      if (found) {-        /* Move item to correct position */-        os.splice(oldFirstIndex,0, os.splice(tmp,1)[0]);-        /* optionally perform `diff` here */-        window['diff'](os[oldFirstIndex++], nFirst, parent, doc);-        /* Swap DOM references */-        parent.insertBefore(node['domRef'], os[oldFirstIndex]['domRef']);-        /* increment counters */-        newFirstIndex++;-      }-        /* If new key was *not* found in the old map this means it must now be created, example below-           -> [ a e d c ] <- old children-           -> [ b e a j ] <- new children-            ^--           In the above case 'b' does not exist in the old map, so we create a new element and DOM reference.-           We then insertBefore in both vDOM and DOM.--           -> [ b a e d c ] <- old children-           -> [ b e a j   ] <- new children-              ^-           */-      else {-        window['createElement'](nFirst, doc);-        parent.insertBefore(nFirst['domRef'], oFirst['domRef']);-        os.splice(oldFirstIndex++, 0, nFirst);-        newFirstIndex++;-        oldLastIndex++;-      }-    }-  }-};--window['swapDomRefs'] = function swapDomRefs(tmp,a,b,p) {-  tmp = a.nextSibling;-  p.insertBefore(a,b);-  p.insertBefore(b,tmp);-};--window['swap']= function swap(os,l,r) {-  var k = os[l];-  os[l] = os[r];-  os[r] = k;-};
− jsbits/isomorphic.js 
@@ -1,97 +0,0 @@-window = typeof window === 'undefined' ? {} : window;-window['collapseSiblingTextNodes'] = function collapseSiblingTextNodes(vs) {-  if (!vs) { return []; }-  var ax = 0, adjusted = vs.length > 0 ? [vs[0]] : [];-  for (var ix = 1; ix < vs.length; ix++) {-    if (adjusted[ax]['type'] === 'vtext' && vs[ix]['type'] === 'vtext') {-	adjusted[ax]['text'] += vs[ix]['text'];-	continue;-    }-    adjusted[++ax] = vs[ix];-  }-  return adjusted;-}--window['copyDOMIntoVTree'] = function copyDOMIntoVTree(logLevel,mountPoint, vtree, doc) {-  if (!doc) { doc = window.document; }-    var mountChildIdx = 0, node;-    // If script tags are rendered first in body, skip them.-    if (!mountPoint) {-	if (doc.body.childNodes.length > 0) {-	    node = doc.body.firstChild;-	} else {-	    node = doc.body.appendChild (doc.createElement('div'));-	}-    } else if (mountPoint.childNodes.length === 0) {-	node = mountPoint.appendChild (doc.createElement('div'));-    } else {-	while (mountPoint.childNodes[mountChildIdx] && (mountPoint.childNodes[mountChildIdx].nodeType === Node.TEXT_NODE || mountPoint.childNodes[mountChildIdx].localName === 'script')){-	  mountChildIdx++;-	}-	if (!mountPoint.childNodes[mountChildIdx]) {-	    node = doc.body.appendChild (doc.createElement('div'));-	} else {-	    node = mountPoint.childNodes[mountChildIdx];-        }-    }--    if (!window['walk'](logLevel,vtree, node, doc)) {-    if (logLevel) {-      console.warn('Could not copy DOM into virtual DOM, falling back to diff');-    }-    // Remove all children before rebuilding DOM-    while (node.firstChild) node.removeChild(node.lastChild);-    vtree['domRef'] = node;-    window['populate'](null, vtree, doc);-    return false;-  }-  if (logLevel) {-    console.info ('Successfully prendered page');-  }-  return true;-}--window['diagnoseError'] = function diagnoseError(logLevel, vtree, node) {-    if (logLevel) console.warn('VTree differed from node', vtree, node);-}--window['walk'] = function walk(logLevel, vtree, node, doc) {-  // This is slightly more complicated than one might expect since-  // browsers will collapse consecutive text nodes into a single text node.-  // There can thus be fewer DOM nodes than VDOM nodes.-  var vdomChild,-      domChild;--  vtree['domRef'] = node;--  // Fire onCreated events as though the elements had just been created.-  window['callCreated'](vtree);--  vtree.children = window['collapseSiblingTextNodes'](vtree.children);-  for (var i = 0; i < vtree.children.length; i++) {-    vdomChild = vtree['children'][i];-    domChild = node.childNodes[i];-      if (!domChild) {-	  window['diagnoseError'](logLevel,vdomChild, domChild);-	  return false;-      }-    if (vdomChild.type === 'vtext') {-        if (domChild.nodeType !== Node.TEXT_NODE) {-  	    window['diagnoseError'](logLevel, vdomChild, domChild);-	    return false;-	}--        if (vdomChild['text'] === domChild.textContent) {-          vdomChild['domRef'] = domChild;-        } else {-          window['diagnoseError'](logLevel, vdomChild, domChild);-          return false;-	}-    } else {-      if (domChild.nodeType !== Node.ELEMENT_NODE) return false;-      vdomChild['domRef'] = domChild;-      if(!window['walk'](logLevel, vdomChild, domChild, doc)) return false;-    }-  }-  return true;-}
− jsbits/util.js 
@@ -1,14 +0,0 @@-window = typeof window === 'undefined' ? {} : window;-window['callFocus'] = function callFocus(id) {-  setTimeout(function(){-    var ele = document.getElementById(id);-    if (ele && ele.focus) ele.focus()-  }, 50);-}--window['callBlur'] = function callBlur(id) {-  setTimeout(function(){-    var ele = document.getElementById(id);-    if (ele && ele.blur) ele.blur()-  }, 50);-}
miso.cabal view
@@ -1,212 +1,223 @@+cabal-version:       2.2 name:                miso-version:             1.7.1.0+version:             1.12.0.0 category:            Web, Miso, Data Structures-license:             BSD3+license:             BSD-3-Clause license-file:        LICENSE-author:              David M. Johnson <djohnson.m@gmail.com>-maintainer:          David M. Johnson <djohnson.m@gmail.com>-homepage:            http://github.com/dmjio/miso-copyright:           Copyright (c) 2017-2020 David M. Johnson-bug-reports:         https://github.com/dmjio/miso/issues+author:              David M. Johnson <code@dmj.io>+maintainer:          David M. Johnson <code@dmj.io>+homepage:            https://haskell-miso.org/+copyright:           Copyright (c) 2016-2026 David M. Johnson+bug-reports:         https://github.com/haskell-miso/miso/issues build-type:          Simple extra-source-files:  README.md-cabal-version:       >=1.22-synopsis:            A tasty Haskell front-end framework+synopsis:            A tasty Haskell front-end web framework description:-            Miso is a small, production-ready, "isomorphic" Haskell front-end framework featuring a virtual-dom, recursive diffing / patching algorithm, event delegation, event batching, SVG, Server-sent events, Websockets, type-safe servant-style routing and an extensible Subscription-based subsystem. Inspired by Elm, Redux and Bobril. Miso is pure by default, but side effects (like XHR) can be introduced into the system via the Effect data type. Miso makes heavy use of the GHCJS FFI and therefore has minimal dependencies.+            Miso is a small, production-ready, component-oriented, isomorphic Haskell front-end web and mobile framework featuring a virtual-dom, recursive diffing / patching algorithm, event delegation, event batching, SVG, Server-sent events, Websockets, type-safe servant-style routing and an extensible Subscription-based subsystem. Inspired by Elm and React. Miso is pure by default, but side effects can be introduced into the system via the Effect data type. Miso makes heavy use of the GHC FFI and therefore has minimal dependencies.  extra-source-files:   README.md -flag tests+source-repository head+   type: git+   location: https://github.com/haskell-miso/miso.git++common cpp+  if impl(ghcjs) || arch(javascript)+    cpp-options:+      -DGHCJS_BOTH+  if impl(ghcjs)+    cpp-options:+      -DGHCJS_OLD+  elif arch(javascript)+    cpp-options:+      -DGHCJS_NEW+  elif arch(wasm32)+    cpp-options:+      -DWASM+  else+    cpp-options:+      -DVANILLA++  if flag(production)+    cpp-options:+      -DPRODUCTION++  if flag(ssr)+    cpp-options:+      -DSSR++  if flag(benchmark)+    cpp-options:+      -DBENCH++common client+  if impl(ghcjs) || arch(javascript) || arch(wasm32)+    if flag(production)+      js-sources:+        js/miso.prod.js+    else+      js-sources:+        js/miso.js++flag benchmark+  manual:+    True   default:     False   description:-    Builds Miso's tests+    When enabled this outputs (in milliseconds) the time it+    takes to build the virtual DOM on page load. -flag jsaddle-  manual: True+flag production+  manual:+    True   default:     False   description:-    Compile with JSaddle+    Uses miso's production quality JS (miso.prod.js).+    This is built from calling "bun build --production" -flag ios-  manual: True+flag ssr+  manual:+    True   default:     False   description:-    Cross compile to iOS--executable simple-  main-is:-    Main.hs-  if !impl(ghcjs) && !flag(jsaddle)-    buildable: False-  else-    ghcjs-options:-      -dedupe-    cpp-options:-      -DGHCJS_BROWSER-    hs-source-dirs:-      exe-    build-depends:-      aeson,-      base < 5,-      containers,-      miso,-      transformers-    default-language:-      Haskell2010-    if flag(ios)-      cpp-options:-        -DIOS-      ghc-options:-        -threaded-      build-depends:-        jsaddle-wkwebview-    else-      build-depends:-        jsaddle-warp+    Used to indicate if SSR (server-side rendering) is being used. Defaults to false.+    Enable when performing hydration / server rendering of Html using ToHtml. -executable tests-  main-is:-    Main.hs-  if !impl(ghcjs) || !flag(tests)-    buildable: False-  else-    ghcjs-options:-      -dedupe-    cpp-options:-      -DGHCJS_BROWSER-    hs-source-dirs:-      tests-    build-depends:-      aeson,-      base < 5,-      bytestring,-      ghcjs-base,-      QuickCheck,-      quickcheck-instances,-      miso,-      http-types,-      network-uri,-      http-api-data,-      containers,-      scientific,-      servant,-      text,-      unordered-containers,-      transformers,-      vector-    default-language:-      Haskell2010+flag template-haskell+  manual:+    True+  default:+    False+  description:+    Checks if template-haskell is enabled. If so, allows Miso.Lens.TH  library+  import:+    client,+    cpp   default-language:     Haskell2010+  other-modules:+    Miso.Delegate+    Miso.Diff+    Miso.DSL.FFI+    Miso.Hydrate+    Miso.FFI.Internal+    Miso.Runtime   exposed-modules:     Miso-    Miso.Util+    Miso.Binding+    Miso.Canvas+    Miso.Concurrent+    Miso.Date+    Miso.Data.Map+    Miso.Data.Set+    Miso.Data.Array+    Miso.DSL+    Miso.Effect+    Miso.Event+    Miso.Event.Decoder+    Miso.Event.Types+    Miso.EventSource+    Miso.Fetch+    Miso.FFI     Miso.Html     Miso.Html.Element     Miso.Html.Event     Miso.Html.Property-    Miso.Event-    Miso.Event.Decoder-    Miso.Event.Types+    Miso.Html.Render+    Miso.JSON+    Miso.JSON.Lexer+    Miso.JSON.Parser+    Miso.JSON.Types+    Miso.Lens+    Miso.Lens.Generic+    Miso.Mathml+    Miso.Mathml.Element+    Miso.Mathml.Property+    Miso.Media+    Miso.Navigator+    Miso.Prelude+    Miso.Property+    Miso.PubSub+    Miso.Random     Miso.Router+    Miso.Reload+    Miso.Runtime.Internal+    Miso.State+    Miso.Subscription+    Miso.Subscription.History+    Miso.Subscription.Keyboard+    Miso.Subscription.Mouse+    Miso.Subscription.OnLine+    Miso.Subscription.RAF+    Miso.Subscription.Util+    Miso.Subscription.Window     Miso.Svg-    Miso.Svg.Attribute+    Miso.Svg.Property     Miso.Svg.Element     Miso.Svg.Event-    Miso.Mathml-    Miso.Mathml.Element+    Miso.Storage     Miso.String+    Miso.CSS+    Miso.CSS.Color+    Miso.CSS.Types+    Miso.Types+    Miso.Util+    Miso.Util.Lexer+    Miso.Util.Parser     Miso.WebSocket-  other-modules:-    Miso.Concurrent-    Miso.Html.Internal-  ghc-options:-    -Wall-  hs-source-dirs:-    src-  build-depends:-    aeson,-    base < 5,-    bytestring,-    containers,-    http-api-data,-    http-types,-    network-uri,-    servant,-    text,-    transformers-  if impl(ghcjs) || flag (jsaddle)-    if flag(jsaddle)-      build-depends:-        jsaddle-      cpp-options:-        -DJSADDLE-      hs-source-dirs:-        jsaddle-ffi-      if flag (ios)-        cpp-options:-          -DIOS-        other-modules:-          Miso.JSBits-      else-        build-depends:-          file-embed-    else++  -- Live reload (meant for WASM or Vanilla)+  c-sources:+    cbits/foreign.c++  -- FFI declarations+  if arch(javascript) || impl(ghcjs)+    hs-source-dirs:+      ffi/js+    build-depends:+      ghcjs-base -any++    if impl(ghcjs)       build-depends:-        ghcjs-base-      hs-source-dirs:-        ghcjs-ffi-      js-sources:-        jsbits/diff.js-        jsbits/delegate.js-        jsbits/isomorphic.js-        jsbits/util.js+        ghcjs-prim++  elif arch(wasm32)     hs-source-dirs:-      frontend-src+      ffi/wasm     build-depends:-      containers,-      scientific,-      unordered-containers,-      transformers,-      vector+      ghc-experimental,+      template-haskell >= 2.21 && < 2.25     exposed-modules:-      Miso.Dev-      Miso.Effect-      Miso.Effect.Storage-      Miso.Effect.DOM-      Miso.Subscription-      Miso.Subscription.History-      Miso.Subscription.Keyboard-      Miso.Subscription.Mouse-      Miso.Subscription.WebSocket-      Miso.Subscription.Window-      Miso.Subscription.SSE-      Miso.Types+      Miso.DSL.TH+      Miso.DSL.TH.File     other-modules:-      Miso.Diff-      Miso.FFI-      Miso.FFI.History-      Miso.FFI.SSE-      Miso.FFI.Storage-      Miso.FFI.WebSocket-      Miso.Delegate+      Data.JSString   else+    hs-source-dirs:+      ffi/ghc++  if flag (template-haskell) && !impl(ghcjs)     exposed-modules:-      Miso.TypeLevel+      Miso.Lens.TH+      Miso.String.QQ+      Miso.FFI.QQ     build-depends:-      lucid,-      servant-lucid,-      vector-    hs-source-dirs:-      ghc-src+      template-haskell >= 2.21 && < 2.25 -source-repository head-   type: git-   location: https://github.com/dmjio/miso.git+  ghc-options:+    -Wall+  hs-source-dirs:+    src+  build-depends:+    base          < 5,+    bytestring    < 0.13,+    containers    < 0.9,+    transformers  < 0.7,+    mtl           < 2.4,+    text          < 2.2
+ src/Miso.hs view
@@ -0,0 +1,1766 @@+-----------------------------------------------------------------------------+{-# 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 <code@dmj.io>+-- 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 @\<body\>@). 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 @\<body\>@ is empty.+--+-- The 'miso' function (and 'prerender') assume that @\<body\>@ 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 @\<body\>@ 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: &lt;b&gt;bold&lt;\/b&gt;+-- 'text' "\<b\>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' "\<b\>bold\<\/b\>"   -- server and client: \<b\>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 \<li\> 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 @\<body\>@. 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 @\<body\>@. 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 @\<head\>@ 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 @\<head\>@ 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 @\<body\>@.+--   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 "\<html\>\<head\>\<\/head\>\<body\>hello world\<\/body\>\<html\>" > 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 @\<script\>@ 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 \<body\>. 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 <body>+--+-- 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 @\<body\>@+--+-- @+-- 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+----------------------------------------------------------------------------
+ src/Miso/Binding.hs view
@@ -0,0 +1,280 @@+-----------------------------------------------------------------------------+{-# LANGUAGE ExistentialQuantification  #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE RankNTypes                 #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Binding+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Data Bindings+--+-- "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.+--+-- __Note:__ This feature is experimental. For production inter-component+-- communication, prefer asynchronous messaging via @broadcast@ or+-- "Miso.PubSub".+--+-- == 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+    Binding (..)+  , Precedence (..)+    -- ** Combinators+  , (<-->)+  , (<<-->)+  , (<-->>)+  , (<--)+  , (-->)+  , (<--->)+  , (<<--->)+  , (<--->>)+  , (<---)+  , (--->)+  ) where+----------------------------------------------------------------------------+import Data.Functor.Const (Const(..))+import Control.Monad.Identity (Identity(..))+----------------------------------------------------------------------------+import Miso.Lens (Lens, Lens', LensCore(..))+----------------------------------------------------------------------------+-- | 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.+--+-- 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.+--+-- 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)+-----------------------------------------------------------------------------+-- | 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)+-----------------------------------------------------------------------------+-- | 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)+-----------------------------------------------------------------------------+-- | 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)+-----------------------------------------------------------------------------+-- | 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.+--+-- 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)+-----------------------------------------------------------------------------+-- | 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.+--+-- 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+p <---> c = Bidirectional Parent (get_ p) (set_ p) (get_ c) (set_ c)+  where+    get_ lens_ record = getConst (lens_ Const record)+    set_ lens_ field = runIdentity . lens_ (\_ -> Identity field)+-----------------------------------------------------------------------------+-- | 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+(<--->>)+  :: Lens' parent field+  -> Lens' child field+  -> Binding parent child+l <--->> r =+  case l <---> r of+    Bidirectional _ w x y z -> Bidirectional Parent w x y z+    _ -> error "impossible"+-----------------------------------------------------------------------------+-- | 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+(<<--->)+  :: Lens' parent field+  -> Lens' child field+  -> Binding parent child+l <<---> r =+  case l <---> r of+    Bidirectional _ w x y z -> Bidirectional Child w x y z+    _ -> error "impossible"+-----------------------------------------------------------------------------+-- | 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+p ---> c = ParentToChild (get_ p) (set_ c)+  where+    get_ lens_ record = getConst (lens_ Const record)+    set_ lens_ field = runIdentity . lens_ (\_ -> Identity field)+-----------------------------------------------------------------------------+-- | 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+(<-->>)+  :: Lens parent field+  -> Lens child field+  -> Binding parent child+l <-->> r =+  case l <--> r of+    Bidirectional _ w x y z -> Bidirectional Parent w x y z+    _ -> error "impossible"+-----------------------------------------------------------------------------+-- | 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+(<<-->)+  :: Lens parent field+  -> Lens child field+  -> Binding parent child+l <<--> r =+  case l <--> r of+    Bidirectional _ w x y z -> Bidirectional Child w x y z+    _ -> error "impossible"+-----------------------------------------------------------------------------+-- | 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 <---+(<---) :: Lens' parent field -> Lens' child field -> Binding parent child+p <--- c = ChildToParent (set_ p) (get_ c)+  where+    get_ lens_ record = getConst (lens_ Const record)+    set_ lens_ field = runIdentity . lens_ (\_ -> Identity field)+-----------------------------------------------------------------------------
+ src/Miso/CSS.hs view
@@ -0,0 +1,1993 @@+-----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.CSS+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = 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 @\<style\>@ 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+    module Miso.CSS.Types+    -- *** Smart Constructor+  , style_+  , styleInline_+  , sheet_+  , selector_+    -- *** Render+  , renderStyleSheet+    -- *** Combinators+  , alignContent+  , alignItems+  , alignSelf+  , animationDelay+  , animationDirection+  , animationDuration+  , animationFillMode+  , animationIterationCount+  , animation+  , animationName+  , animationPlayState+  , animationTimingFunction+  , aspectRatio+  , backgroundClip+  , backgroundColor+  , backgroundImage+  , background+  , backgroundOrigin+  , backgroundPosition+  , backgroundRepeat+  , backgroundSize+  , borderBottomColor+  , borderBottomLeftRadius+  , borderBottom+  , borderBottomRightRadius+  , borderBottomStyle+  , borderBottomWidth+  , borderCollapse+  , borderColor+  , borderEndEndRadius+  , borderEndStartRadius+  , borderInlineEndColor+  , borderInlineEndStyle+  , borderInlineEndWidth+  , borderInlineStartColor+  , borderInlineStartStyle+  , borderInlineStartWidth+  , borderLeftColor+  , borderLeft+  , borderLeftStyle+  , borderLeftWidth+  , border+  , borderRadius+  , borderRightColor+  , borderRight+  , borderRightStyle+  , borderRightWidth+  , borderStartEndRadius+  , borderStartStartRadius+  , borderStyle+  , borderTopColor+  , borderTopLeftRadius+  , borderTop+  , borderTopRightRadius+  , borderTopStyle+  , borderTopWidth+  , borderWidth+  , bottom+  , boxShadow+  , boxSizing+  , clipPath+  , accentColor+  , appearance+  , backdropFilter+  , caretColor+  , color+  , columnGap+  , cursor+  , direction+  , display+  , fill+  , filter+  , flexBasis+  , flexDirection+  , flexFlow+  , flexGrow+  , flex+  , flexShrink+  , flexWrap+  , fontFamily+  , fontSize+  , fontStretch+  , fontStyle+  , fontVariant+  , fontWeight+  , gap+  , gridAutoColumns+  , gridAutoFlow+  , gridAutoRows+  , gridColumn+  , gridColumnEnd+  , gridColumnSpan+  , gridColumnStart+  , gridRow+  , gridRowEnd+  , gridRowSpan+  , gridRowStart+  , gridTemplateColumns+  , gridTemplateRows+  , height+  , imageRendering+  , insetInlineEnd+  , insetInlineStart+  , justifyContent+  , justifyItems+  , justifySelf+  , left+  , letterSpacing+  , linearCrossGravity+  , linearDirection+  , linearGravity+  , linearLayoutGravity+  , linearWeight+  , linearWeightSum+  , lineHeight+  , marginBottom+  , marginInlineEnd+  , marginInlineStart+  , marginLeft+  , margin+  , marginRight+  , marginTop+  , maskImage+  , mask+  , maxHeight+  , maxWidth+  , minHeight+  , minWidth+  , mixBlendMode+  , objectFit+  , objectPosition+  , opacity+  , order+  , outline+  , outlineColor+  , outlineOffset+  , outlineStyle+  , outlineWidth+  , overflow+  , overflowX+  , overflowY+  , overscrollBehavior+  , paddingBottom+  , paddingInlineEnd+  , paddingInlineStart+  , paddingLeft+  , padding+  , paddingRight+  , paddingTop+  , perspective+  , pointerEvents+  , position+  , relativeAlignBottom+  , relativeAlignInlineEnd+  , relativeAlignInlineStart+  , relativeAlignLeft+  , relativeAlignRight+  , relativeAlignTop+  , relativeBottomOf+  , relativeCenter+  , relativeId+  , relativeInlineEndOf+  , relativeInlineStartOf+  , relativeLayoutOnce+  , relativeLeftOf+  , relativeRightOf+  , relativeTopOf+  , resize+  , right+  , rowGap+  , scrollBehavior+  , stroke+  , strokeWidth+  , textAlign+  , textDecoration+  , textIndent+  , textOverflow+  , textShadow+  , 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+  , xHandleColor+  , xHandleSize+  , zIndex+  -- *** Colors+  , module Miso.CSS.Color+  -- *** Units+  , px+  , ppx+  , pct+  , pt+  , vw+  , vh+  , deg+  , turn+  , rad+  , rpx+  , rem+  , em+  , s+  , ms+  -- *** Misc+  , url+  , 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+import           Miso.String (MisoString)+import qualified Miso.String as MS+import           Miso.CSS.Color+import           Miso.CSS.Types+import           Miso.Property+import           Miso.Types (Attribute)+import qualified Miso.Types as MT+import           Miso.Util ((=:))+-----------------------------------------------------------------------------+import           Prelude hiding (filter, rem)+-----------------------------------------------------------------------------+-- | Font sizing in terms of *pt*+--+-- @+-- >>> pt 10+-- "10pt"+-- @+--+pt :: Int -> MisoString+pt x = MS.ms x <> "pt"+-----------------------------------------------------------------------------+-- | Font sizing in terms of *px*+--+-- @+-- >>> px 10+-- "10px"+-- @+--+px :: Int -> MisoString+px x = MS.ms x <> "px"+-----------------------------------------------------------------------------+-- | Degree specification+--+-- @+-- >>> deg 10+-- "10deg"+-- @+--+deg :: Double -> MisoString+deg x = MS.ms x <> "deg"+-----------------------------------------------------------------------------+-- | Turn constructor, useful for specifying rotations+--+-- @+-- >>> turn 10.0+-- "10.0turn"+-- @+--+turn :: Double -> MisoString+turn x = MS.ms x <> "turn"+-----------------------------------------------------------------------------+-- | Radial constructor+--+-- @+-- >>> rad 10.0+-- "10.0rad"+-- @+--+rad :: Double -> MisoString+rad x = MS.ms x <> "rad"+-----------------------------------------------------------------------------+-- | Responsive pixel sizing, *rpx*+--+-- @+-- >>> rpx 10.0+-- "10.0rpx"+-- @+--+rpx :: Double -> MisoString+rpx x = MS.ms x <> "rpx"+-----------------------------------------------------------------------------+-- | Relative *em* sizing+--+-- @+-- >>> rem 10.0+-- "10.0rem"+-- @+--+rem :: Double -> MisoString+rem x = MS.ms x <> "rem"+-----------------------------------------------------------------------------+-- | *em* sizing+--+-- @+-- >>> em 10.0+-- "10.0em"+-- @+--+em :: Double -> MisoString+em x = MS.ms x <> "em"+-----------------------------------------------------------------------------+-- | Viewport height+--+-- @+-- >>> vh 10.0+-- "10.0vh"+-- @+--+vh :: Double -> MisoString+vh x = MS.ms x <> "vh"+-----------------------------------------------------------------------------+-- | Viewport width+--+-- @+-- >>> vw 10.0+-- "10.0vw"+-- @+--+vw :: Double -> MisoString+vw x = MS.ms x <> "vw"+-----------------------------------------------------------------------------+-- | Duration in seconds+--+-- @+-- >>> s 10.0+-- "10.0s"+-- @+--+s :: Double -> MisoString+s x = MS.ms x <> "s"+-----------------------------------------------------------------------------+-- | Duration in milliseconds+--+-- @+-- >>> ms 10.0+-- "10.0ms"+-- @+--+ms :: Double -> MisoString+ms x = MS.ms x <> "ms"+-----------------------------------------------------------------------------+-- | Wraps a value in the CSS @url()@ function, used for background images and similar.+--+-- @+-- >>> url "dog.png"+-- "url(dog.png)"+-- @+--+-- @+-- backgroundImage (url "banner.png")+-- @+--+-- <https://developer.mozilla.org/en-US/docs/Web/CSS/url>+--+url :: MisoString -> MisoString+url x = "url(" <> x <> ")"+-----------------------------------------------------------------------------+-- | 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)+-- @+--+-- <https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function/matrix>+--+matrix+  :: 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+    values =+      MS.intercalate ","+      [ MS.ms a+      , MS.ms b+      , MS.ms c+      , MS.ms d+      , MS.ms tx+      , MS.ms ty+      ]+-----------------------------------------------------------------------------+-- | Percentage unit.+--+-- @+-- >>> pct 50.0+-- "50.0%"+-- @+--+-- <https://developer.mozilla.org/en-US/docs/Web/CSS/percentage>+pct :: Double -> MisoString+pct x = MS.ms x <> "%"+-----------------------------------------------------------------------------+-- | 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"+-----------------------------------------------------------------------------+-- | Constructs a 'Styles' entry pairing a CSS selector with a list of properties.+-- Combine multiple entries with 'sheet_'.+--+-- @+-- sheet_+--   [ 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)+-----------------------------------------------------------------------------+-- | 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+-----------------------------------------------------------------------------+-- | Constructs a structured @style@ attribute from a list of CSS properties.+--+-- 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_+--       [ display       "flex"+--       , flexDirection "column"+--       , gap           (px 8)+--       , backgroundColor red+--       ]+--   ] []+-- @+--+-- See also 'styleInline_' for setting raw CSS strings.+--+-- <https://developer.mozilla.org/en-US/docs/Web/CSS>+--+style_ :: [Style] -> Attribute action+style_ = MT.Styles . M.fromList+-----------------------------------------------------------------------------+-- | Sets the @style@ attribute to a raw CSS string.+--+-- 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.+--+-- @+-- div_ [ styleInline_ "background-color:red; color:blue;" ] [ "foo" ]+-- @+--+-- <https://developer.mozilla.org/en-US/docs/Web/CSS>+--+styleInline_ ::  MisoString -> Attribute action+styleInline_ = textProp "style"+-----------------------------------------------------------------------------+-- | Renders a t'Styles' to a t'MisoString'+renderStyles :: Int -> Styles -> MisoString+renderStyles indent (Styles (sel,styles)) = MS.unlines+  [ sel <> " {" <> MS.replicate indent " "+  , MS.intercalate "\n"+        [ mconcat+          [ MS.replicate (indent + 2) " " <> k+          , " : "+          , v+          , ";"+          ]+        | (k,v) <- styles+        ]+  , MS.replicate indent " " <> "}"+  ]+renderStyles indent (KeyFrame name frames) = MS.intercalate " "+  [ "@keyframes"+  , name+  , "{\n"+  , MS.intercalate "\n  "+    [ renderStyles (indent + 2) (Styles frame)+    | frame <- frames+    ]+  , "}\n"+  ]+renderStyles indent (Media name frames) = MS.intercalate " "+  [ "@media"+  , name+  , "{\n"+  , MS.intercalate "\n  "+    [ renderStyles (indent + 2) (Styles frame)+    | frame <- frames+    ]+  , "}\n"+  ]+-----------------------------------------------------------------------------+-- | Renders a 'StyleSheet' to a 'MisoString' suitable for injection into a+-- @\<style\>@ tag.+--+-- @+-- view_ :: View model action+-- view_ = style [] [ text (renderStyleSheet mySheet) ]+-- @+--+renderStyleSheet :: StyleSheet -> MisoString+renderStyleSheet styleSheet = MS.intercalate "\n"+  [ renderStyles 0 styles+  | styles <- getStyleSheet styleSheet+  ]+-----------------------------------------------------------------------------+-- | 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'.+--+-- @+-- slideIn :: Styles+-- slideIn = keyframes_ "slide-in"+--   [ from_ [ transform "translateX(-100%)" ]+--   , at (pct 50) [ opacity 0.5 ]+--   , to_   [ transform "translateX(0)" ]+--   ]+-- @+--+-- <https://developer.mozilla.org/en-US/docs/Web/CSS/@keyframes>+--+keyframes_ :: MisoString -> [KeyframeStop] -> Styles+keyframes_ name stops = KeyFrame name (map getKeyframeStop stops)+-----------------------------------------------------------------------------+-- | 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.+--+-- @+-- responsive :: 'Styles'+-- responsive = 'media_' ('screen_' \`and_\` 'minWidth_' (px 480))+--   [ 'rule_' "header" [ 'height' "auto" ]+--   , 'rule_' "ul"     [ 'display' "block" ]+--   ]+-- @+--+-- <https://developer.mozilla.org/en-US/docs/Web/CSS/@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+alignContent x = "align-content" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/align-items+--+alignItems :: MisoString -> Style+alignItems x = "align-items" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/align-self+--+alignSelf :: MisoString -> Style+alignSelf x = "align-self" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/animation-delay+--+animationDelay :: MisoString -> Style+animationDelay x = "animation-delay" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/animation-direction+--+animationDirection :: MisoString -> Style+animationDirection x = "animation-direction" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/animation-duration+--+animationDuration :: MisoString -> Style+animationDuration x = "animation-duration" =: x+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/CSS/animation-fill-mode>+--+animationFillMode :: MisoString -> Style+animationFillMode x = "animation-fill-mode" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/animation-iteration-count+--+animationIterationCount :: MisoString -> Style+animationIterationCount x = "animation-iteration-count" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/animation+--+animation :: MisoString -> Style+animation x = "animation" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/animation-name+--+animationName :: MisoString -> Style+animationName x = "animation-name" =: x+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/CSS/animation-play-state>+--+animationPlayState :: MisoString -> Style+animationPlayState x = "animation-play-state" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/animation-timing-function+--+animationTimingFunction :: MisoString -> Style+animationTimingFunction x = "animation-timing-function" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/aspect-ratio+--+aspectRatio :: MisoString -> Style+aspectRatio x = "aspect-ratio" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/background-clip+--+backgroundClip :: MisoString -> Style+backgroundClip x = "background-clip" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/background-color+--+backgroundColor :: Color -> Style+backgroundColor x = "background-color" =: renderColor x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/background-image+--+backgroundImage :: MisoString -> Style+backgroundImage x = "background-image" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/background+--+background :: MisoString -> Style+background x = "background" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/background-origin+--+backgroundOrigin :: MisoString -> Style+backgroundOrigin x = "background-origin" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/background-position+--+backgroundPosition :: MisoString -> Style+backgroundPosition x = "background-position" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/background-repeat+--+backgroundRepeat :: MisoString -> Style+backgroundRepeat x = "background-repeat" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/background-size+--+backgroundSize :: MisoString -> Style+backgroundSize x = "background-size" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-bottom-color+--+borderBottomColor :: Color -> Style+borderBottomColor x = "border-bottom-color" =: renderColor x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-bottom-left-radius+--+borderBottomLeftRadius :: MisoString -> Style+borderBottomLeftRadius x = "border-bottom-left-radius" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-bottom+--+borderBottom :: MisoString -> Style+borderBottom x = "border-bottom" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-bottom-right-radius+--+borderBottomRightRadius :: MisoString -> Style+borderBottomRightRadius x = "border-bottom-right-radius" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-bottom-style+--+borderBottomStyle :: MisoString -> Style+borderBottomStyle x = "border-bottom-style" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-bottom-width+--+borderBottomWidth :: MisoString -> Style+borderBottomWidth x = "border-bottom-width" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-collapse+--+borderCollapse :: MisoString -> Style+borderCollapse x = "border-collapse" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-color+--+borderColor :: Color -> Style+borderColor x = "border-color" =: renderColor x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-end-radius+--+borderEndEndRadius :: MisoString -> Style+borderEndEndRadius x = "border-end-end-radius" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-end-start-radius+--+borderEndStartRadius :: MisoString -> Style+borderEndStartRadius x = "border-end-start-radius" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-inline-end-color+--+borderInlineEndColor :: Color -> Style+borderInlineEndColor x = "border-inline-end-color" =: renderColor x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-inline-end-style+--+borderInlineEndStyle :: MisoString -> Style+borderInlineEndStyle x = "border-inline-end-style" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-inline-end-width+--+borderInlineEndWidth :: MisoString -> Style+borderInlineEndWidth x = "border-inline-end-width" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-inline-start-color+--+borderInlineStartColor :: Color -> Style+borderInlineStartColor x = "border-inline-start-color" =: renderColor x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-inline-start-style+--+borderInlineStartStyle :: MisoString -> Style+borderInlineStartStyle x = "border-inline-start-style" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-inline-start-width+--+borderInlineStartWidth :: MisoString -> Style+borderInlineStartWidth x = "border-inline-start-width" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-left-color+--+borderLeftColor :: Color -> Style+borderLeftColor x = "border-left-color" =: renderColor x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-left+--+borderLeft :: MisoString -> Style+borderLeft x = "border-left" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-left-style+--+borderLeftStyle :: MisoString -> Style+borderLeftStyle x = "border-left-style" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-left-width+--+borderLeftWidth :: MisoString -> Style+borderLeftWidth x = "border-left-width" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border+--+border :: MisoString -> Style+border x = "border" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-radius+--+borderRadius :: MisoString -> Style+borderRadius x = "border-radius" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-right-color+--+borderRightColor :: Color -> Style+borderRightColor x = "border-right-color" =: renderColor x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-right+--+borderRight :: MisoString -> Style+borderRight x = "border-right" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-right-style+--+borderRightStyle :: MisoString -> Style+borderRightStyle x = "border-right-style" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-right-width+--+borderRightWidth :: MisoString -> Style+borderRightWidth x = "border-right-width" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-start-end-radius+--+borderStartEndRadius :: MisoString -> Style+borderStartEndRadius x = "border-start-end-radius" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-start-start-radius+--+borderStartStartRadius :: MisoString -> Style+borderStartStartRadius x = "border-start-start-radius" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-style+--+borderStyle :: MisoString -> Style+borderStyle x = "border-style" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-top-color+--+borderTopColor :: Color -> Style+borderTopColor x = "border-top-color" =: renderColor x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-top-left-radius+--+borderTopLeftRadius :: MisoString -> Style+borderTopLeftRadius x = "border-top-left-radius" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-top+--+borderTop :: MisoString -> Style+borderTop x = "border-top" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-top-right-radius+--+borderTopRightRadius :: MisoString -> Style+borderTopRightRadius x = "border-top-right-radius" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-top-style+--+borderTopStyle :: MisoString -> Style+borderTopStyle x = "border-top-style" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-top-width+--+borderTopWidth :: MisoString -> Style+borderTopWidth x = "border-top-width" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/border-width+--+borderWidth :: MisoString -> Style+borderWidth x = "border-width" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/bottom+--+bottom :: MisoString -> Style+bottom x = "bottom" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/box-shadow+--+boxShadow :: MisoString -> Style+boxShadow x = "box-shadow" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/box-sizing+--+boxSizing :: MisoString -> Style+boxSizing x = "box-sizing" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/clip-path+--+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+color x = "color" =: renderColor x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/column-gap+--+columnGap :: MisoString -> Style+columnGap x = "column-gap" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/direction+--+direction :: MisoString -> Style+direction x = "direction" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/display+--+display :: MisoString -> Style+display x = "display" =: x+-----------------------------------------------------------------------------+-- | SVG [fill](https://developer.mozilla.org/en-US/docs/Web/CSS/fill) color.+--+-- > fill red+--+fill :: Color -> Style+fill x = "fill" =: renderColor x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/filter+--+filter :: MisoString -> Style+filter x = "filter" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/flex-basis+--+flexBasis :: MisoString -> Style+flexBasis x = "flex-basis" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/flex-direction+--+flexDirection :: MisoString -> Style+flexDirection x = "flex-direction" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/flex-flow+--+flexFlow :: MisoString -> Style+flexFlow x = "flex-flow" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/flex-grow+--+flexGrow :: Double -> Style+flexGrow x = "flex-grow" =: MS.ms x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/flex+--+flex :: MisoString -> Style+flex x = "flex" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/flex-shrink+--+flexShrink :: Double -> Style+flexShrink x = "flex-shrink" =: MS.ms x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/flex-wrap+--+flexWrap :: MisoString -> Style+flexWrap x = "flex-wrap" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/font-family+--+fontFamily :: MisoString -> Style+fontFamily x = "font-family" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/font-size+--+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+fontWeight x = "font-weight" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/cursor+--+cursor :: MisoString -> Style+cursor x = "cursor" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/gap+--+gap :: MisoString -> Style+gap x = "gap" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/grid-auto-columns+--+gridAutoColumns :: MisoString -> Style+gridAutoColumns x = "grid-auto-columns" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/grid-auto-flow+--+gridAutoFlow :: MisoString -> Style+gridAutoFlow x = "grid-auto-flow" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/grid-auto-rows+--+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+gridColumnEnd x = "grid-column-end" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/grid-column-span+--+gridColumnSpan :: MisoString -> Style+gridColumnSpan x = "grid-column-span" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/grid-column-start+--+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+gridRowEnd x = "grid-row-end" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/grid-row-span+--+gridRowSpan :: MisoString -> Style+gridRowSpan x = "grid-row-span" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/grid-row-start+--+gridRowStart :: MisoString -> Style+gridRowStart x = "grid-row-start" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/grid-template-columns+--+gridTemplateColumns :: MisoString -> Style+gridTemplateColumns x = "grid-template-columns" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/grid-template-rows+--+gridTemplateRows :: MisoString -> Style+gridTemplateRows x = "grid-template-rows" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/height+--+height :: MisoString -> Style+height x = "height" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/image-rendering+--+imageRendering :: MisoString -> Style+imageRendering x = "image-rendering" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/inset-inline-end+--+insetInlineEnd :: MisoString -> Style+insetInlineEnd x = "inset-inline-end" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/inset-inline-start+--+insetInlineStart :: MisoString -> Style+insetInlineStart x = "inset-inline-start" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/justify-content+--+justifyContent :: MisoString -> Style+justifyContent x = "justify-content" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/justify-items+--+justifyItems :: MisoString -> Style+justifyItems x = "justify-items" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/justify-self+--+justifySelf :: MisoString -> Style+justifySelf x = "justify-self" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/left+--+left :: MisoString -> Style+left x = "left" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/letter-spacing+--+letterSpacing :: MisoString -> Style+letterSpacing x = "letter-spacing" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/linear-cross-gravity+--+linearCrossGravity :: MisoString -> Style+linearCrossGravity x = "linear-cross-gravity" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/linear-direction+--+linearDirection :: MisoString -> Style+linearDirection x = "linear-direction" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/linear-gravity+--+linearGravity :: MisoString -> Style+linearGravity x = "linear-gravity" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/linear-layout-gravity+--+linearLayoutGravity :: MisoString -> Style+linearLayoutGravity x = "linear-layout-gravity" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/linear-weight+--+linearWeight :: MisoString -> Style+linearWeight x = "linear-weight" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/linear-weight-sum+--+linearWeightSum :: MisoString -> Style+linearWeightSum x = "linear-weight-sum" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/line-height+--+lineHeight :: MisoString -> Style+lineHeight x = "line-height" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/margin-bottom+--+marginBottom :: MisoString -> Style+marginBottom x = "margin-bottom" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/margin-inline-end+--+marginInlineEnd :: MisoString -> Style+marginInlineEnd x = "margin-inline-end" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/margin-inline-start+--+marginInlineStart :: MisoString -> Style+marginInlineStart x = "margin-inline-start" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/margin-left+--+marginLeft :: MisoString -> Style+marginLeft x = "margin-left" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/margin+--+margin :: MisoString -> Style+margin x = "margin" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/margin-right+--+marginRight :: MisoString -> Style+marginRight x = "margin-right" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/margin-top+--+marginTop :: MisoString -> Style+marginTop x = "margin-top" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/mask-image+--+maskImage :: MisoString -> Style+maskImage x = "mask-image" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/mask+--+mask :: MisoString -> Style+mask x = "mask" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/max-height+--+maxHeight :: MisoString -> Style+maxHeight x = "max-height" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/max-width+--+maxWidth :: MisoString -> Style+maxWidth x = "max-width" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/min-height+--+minHeight :: MisoString -> Style+minHeight x = "min-height" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/min-width+--+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 :: Double -> Style+opacity x = "opacity" =: MS.ms x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/order+--+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+overflow x = "overflow" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/overflow-x+--+overflowX :: MisoString -> Style+overflowX x = "overflow-x" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/overflow-y+--+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+paddingBottom x = "padding-bottom" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/padding-inline-end+--+paddingInlineEnd :: MisoString -> Style+paddingInlineEnd x = "padding-inline-end" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/padding-inline-start+--+paddingInlineStart :: MisoString -> Style+paddingInlineStart x = "padding-inline-start" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/padding-left+--+paddingLeft :: MisoString -> Style+paddingLeft x = "padding-left" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/padding+--+padding :: MisoString -> Style+padding x = "padding" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/padding-right+--+paddingRight :: MisoString -> Style+paddingRight x = "padding-right" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/padding-top+--+paddingTop :: MisoString -> Style+paddingTop x = "padding-top" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/perspective+--+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+position x = "position" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-align-bottom+--+relativeAlignBottom :: MisoString -> Style+relativeAlignBottom x = "relative-align-bottom" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-align-inline-end+--+relativeAlignInlineEnd :: MisoString -> Style+relativeAlignInlineEnd x = "relative-align-inline-end" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-align-inline-start+--+relativeAlignInlineStart :: MisoString -> Style+relativeAlignInlineStart x = "relative-align-inline-start" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-align-left+--+relativeAlignLeft :: MisoString -> Style+relativeAlignLeft x = "relative-align-left" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-align-right+--+relativeAlignRight :: MisoString -> Style+relativeAlignRight x = "relative-align-right" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-align-top+--+relativeAlignTop :: MisoString -> Style+relativeAlignTop x = "relative-align-top" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-bottom-of+--+relativeBottomOf :: MisoString -> Style+relativeBottomOf x = "relative-bottom-of" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-center+--+relativeCenter :: MisoString -> Style+relativeCenter x = "relative-center" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-id+--+relativeId :: MisoString -> Style+relativeId x = "relative-id" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-inline-end-of+--+relativeInlineEndOf :: MisoString -> Style+relativeInlineEndOf x = "relative-inline-end-of" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-inline-start-of+--+relativeInlineStartOf :: MisoString -> Style+relativeInlineStartOf x = "relative-inline-start-of" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-layout-once+--+relativeLayoutOnce :: MisoString -> Style+relativeLayoutOnce x = "relative-layout-once" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-left-of+--+relativeLeftOf :: MisoString -> Style+relativeLeftOf x = "relative-left-of" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-right-of+--+relativeRightOf :: MisoString -> Style+relativeRightOf x = "relative-right-of" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/relative-top-of+--+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+right x = "right" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/row-gap+--+rowGap :: MisoString -> Style+rowGap x = "row-gap" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/scroll-behavior+--+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+strokeWidth x = "stroke-width" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/text-align+--+textAlign :: MisoString -> Style+textAlign x = "text-align" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/text-decoration+--+textDecoration :: MisoString -> Style+textDecoration x = "text-decoration" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/text-indent+--+textIndent :: MisoString -> Style+textIndent x = "text-indent" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/text-overflow+--+textOverflow :: MisoString -> Style+textOverflow x = "text-overflow" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/text-shadow+--+textShadow :: MisoString -> Style+textShadow x = "text-shadow" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/text-stroke-color+--+textStrokeColor :: Color -> Style+textStrokeColor x = "text-stroke-color" =: renderColor x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/text-stroke+--+textStroke :: MisoString -> Style+textStroke x = "text-stroke" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/text-stroke-width+--+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+top x = "top" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transform+--+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+transitionDelay x = "transition-delay" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transition-duration+--+transitionDuration :: MisoString -> Style+transitionDuration x = "transition-duration" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transition+--+transition :: MisoString -> Style+transition x = "transition" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transition-property+--+transitionProperty :: MisoString -> Style+transitionProperty x = "transition-property" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/transition-timing-function+--+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+verticalAlign x = "vertical-align" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/visibility+--+visibility :: MisoString -> Style+visibility x = "visibility" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/white-space+--+whiteSpace :: MisoString -> Style+whiteSpace x = "white-space" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/width+--+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+wordBreak x = "word-break" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/xAutoFontSize+--+xAutoFontSize :: MisoString -> Style+xAutoFontSize x = "-x-auto-font-size" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/xAutoFontSizePresetSizes+--+xAutoFontSizePresetSizes :: MisoString -> Style+xAutoFontSizePresetSizes x = "-x-auto-font-size-preset-sizes" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/xHandleColor+--+xHandleColor :: Color -> Style+xHandleColor x = "-x-handle-color" =: renderColor x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/xHandleSize+--+xHandleSize :: MisoString -> Style+xHandleSize x = "-x-handle-size" =: x+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/CSS/z-index+--+zIndex :: Int -> Style+zIndex x = "z-index" =: MS.ms x+-----------------------------------------------------------------------------
+ src/Miso/CSS/Color.hs view
@@ -0,0 +1,1901 @@+-----------------------------------------------------------------------------+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TypeApplications      #-}+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.CSS.Color+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- 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+-- <https://www.w3.org/TR/css-color-4/#named-colors CSS named colors>.+--+-- 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)@ — <https://www.w3.org/TR/css-color-4/#rgb-functions RGB>+-- ['rgba' r g b a] @rgba(r,g,b,a)@ — <https://www.w3.org/TR/css-color-4/#rgb-functions RGBA>+-- ['hsl' h s l] @hsl(h,s,l)@ — <https://www.w3.org/TR/css-color-4/#the-hsl-notation HSL>+-- ['hsla' h s l a] @hsla(h,s,l,a)@ — <https://www.w3.org/TR/css-color-4/#the-hsl-notation HSLA>+-- ['oklch' l c h] @oklch(l% c h)@ — <https://www.w3.org/TR/css-color-4/#the-oklch-notation OKLCH>+-- ['oklcha' l c h a] @oklch(l% c h / a)@ — <https://www.w3.org/TR/css-color-4/#the-oklch-notation OKLCHA>+-- ['hex' s] @#s@ — <https://www.w3.org/TR/css-color-4/#hex-notation Hex>+-- ['var' name] @var(--name)@ — <https://www.w3.org/TR/css-variables/ CSS Variables>+--+-- = 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 <https://www.w3.org/TR/css-color-4/#named-colors CSS named colors>+-- 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+    Color (RGB, RGBA, HSL, HSLA, OKLCH, OKLCHA, Hex)+    -- *** Smart constructor+  , rgba+  , rgb+  , hsl+  , hsla+  , oklch+  , oklcha+  , hex+  , var+    -- *** Render+  , renderColor+    -- *** Colors+  , transparent+  , aliceblue+  , antiquewhite+  , aqua+  , aquamarine+  , azure+  , beige+  , bisque+  , black+  , blanchedalmond+  , blue+  , blueviolet+  , brown+  , burlywood+  , cadetblue+  , chartreuse+  , chocolate+  , coral+  , cornflowerblue+  , cornsilk+  , crimson+  , cyan+  , darkblue+  , darkcyan+  , darkgoldenrod+  , darkgray+  , darkgreen+  , darkgrey+  , darkkhaki+  , darkmagenta+  , darkolivegreen+  , darkorange+  , darkorchid+  , darkred+  , darksalmon+  , darkseagreen+  , darkslateblue+  , darkslategray+  , darkslategrey+  , darkturquoise+  , darkviolet+  , deeppink+  , deepskyblue+  , dimgray+  , dimgrey+  , dodgerblue+  , firebrick+  , floralwhite+  , forestgreen+  , fuchsia+  , gainsboro+  , ghostwhite+  , gold+  , goldenrod+  , gray+  , green+  , greenyellow+  , grey+  , honeydew+  , hotpink+  , indianred+  , indigo+  , ivory+  , khaki+  , lavender+  , lavenderblush+  , lawngreen+  , lemonchiffon+  , lightblue+  , lightcoral+  , lightcyan+  , lightgoldenrodyellow+  , lightgray+  , lightgreen+  , lightgrey+  , lightpink+  , lightsalmon+  , lightseagreen+  , lightskyblue+  , lightslategray+  , lightslategrey+  , lightsteelblue+  , lightyellow+  , lime+  , limegreen+  , linen+  , magenta+  , maroon+  , mediumaquamarine+  , mediumblue+  , mediumorchid+  , mediumpurple+  , mediumseagreen+  , mediumslateblue+  , mediumspringgreen+  , mediumturquoise+  , mediumvioletred+  , midnightblue+  , mintcream+  , mistyrose+  , moccasin+  , navajowhite+  , navy+  , oldlace+  , olive+  , olivedrab+  , orange+  , orangered+  , orchid+  , palegoldenrod+  , palegreen+  , paleturquoise+  , palevioletred+  , papayawhip+  , peachpuff+  , peru+  , pink+  , plum+  , powderblue+  , purple+  , red+  , rosybrown+  , royalblue+  , saddlebrown+  , salmon+  , sandybrown+  , seagreen+  , seashell+  , sienna+  , silver+  , skyblue+  , slateblue+  , slategray+  , slategrey+  , snow+  , springgreen+  , steelblue+  , tan+  , teal+  , thistle+  , tomato+  , turquoise+  , violet+  , wheat+  , white+  , whitesmoke+  , yellow+  , yellowgreen+  ) where+-----------------------------------------------------------------------------+import           Miso.String (MisoString, ms)+import qualified Miso.String as MS+-----------------------------------------------------------------------------+import           Data.Proxy+import           GHC.TypeLits+import           GHC.OverloadedLabels+import           Miso.DSL (ToJSVal(..), ToArgs(..))+import           Prelude hiding (tan)+-----------------------------------------------------------------------------+-- | Data type for expressing Color+data Color+  = RGBA Int Int Int Double+  -- ^ Red, green, blue and alpha transparency. See [here](https://www.w3schools.com/colors/colors_rgb.asp)+  | RGB Int Int Int+  -- ^ Red, green, blue. See [here](https://www.w3schools.com/colors/colors_rgb.asp)+  | HSL Int Int Int+  -- ^ Hue, saturation, light. See [here](https://www.w3schools.com/colors/colors_hsl.asp)+  | HSLA Int Int Int Double+  -- ^ Hue, saturation, light and alpha transparency. See [here](https://www.w3schools.com/colors/colors_hsl.asp)+  | Hex MisoString+  -- ^ Hexadecimal representation of a color. See [here](https://www.w3schools.com/colors/colors_hexadecimal.asp)+  | VarColor MisoString+  -- ^ A CSS variable+  | OKLCH Double Double Double+  -- ^ Lightness, Chroma, Hue. See [oklch](https://developer.mozilla.org/en-US/docs/Web/CSS/Reference/Values/color_value/oklch).+  | OKLCHA Double Double Double Double+  -- ^ Lightness, Chroma, Hue, Alpha. See [oklhc](https://developer.mozilla.org/en-US/docs/Web/CSS/Reference/Values/color_value/oklch).+  deriving (Show, Eq)+-----------------------------------------------------------------------------+-- | 'IsLabel' instance on 'Color'+--+-- @+-- grey :: Color+-- grey = #cccccc+-- @+instance KnownSymbol color => IsLabel color Color where+  fromLabel = Hex (ms color)+    where+      color = symbolVal (Proxy @color)+-----------------------------------------------------------------------------+-- | 'IsLabel' instance on 'MisoString' for construction of hex colors as strings+--+-- @+-- grey :: MisoString+-- grey = #cccccc+-- @+instance KnownSymbol hex => IsLabel hex MisoString where+  fromLabel = ms ("#" <> symbolVal (Proxy @hex))+-----------------------------------------------------------------------------+-- | 'ToArgs' instance for 'Color'+instance ToArgs Color where+  toArgs color = (:[]) <$> toJSVal color+-----------------------------------------------------------------------------+-- | 'ToJSVal' instance for 'Color'+instance ToJSVal Color where+  toJSVal = toJSVal . renderColor+-----------------------------------------------------------------------------+-- | Renders a 'Color' as 'MisoString'+--+-- >>> renderColor (hex "ccc")+-- "#ccc"+--+renderColor :: Color -> MisoString+renderColor (RGBA r g b a) = "rgba(" <> values <> ")"+  where+    values = MS.intercalate ","+      [ MS.ms r+      , MS.ms g+      , MS.ms b+      , MS.ms a+      ]+renderColor (RGB r g b) = "rgb(" <> values <> ")"+  where+    values = MS.intercalate ","+      [ MS.ms r+      , MS.ms g+      , MS.ms b+      ]+renderColor (HSLA h s l a) = "hsla(" <> values <> ")"+  where+    values = MS.intercalate ","+      [ MS.ms h+      , MS.ms s+      , MS.ms l+      , MS.ms a+      ]+renderColor (HSL h s l) = "hsl(" <> values <> ")"+  where+    values = MS.intercalate ","+      [ MS.ms h+      , MS.ms s+      , MS.ms l+      ]+renderColor (OKLCH l c h) = "oklch(" <> values <> ")"+  where+    values = MS.intercalate " "+      [ MS.ms l <> "%"+      , MS.ms c+      , MS.ms h+      ]+renderColor (OKLCHA l c h a) = "oklch(" <> values <> ")"+  where+    values = MS.intercalate " "+      [ MS.ms l <> "%"+      , MS.ms c+      , MS.ms h+      ] <> " / " <> MS.ms a+renderColor (Hex s) = "#" <> s+renderColor (VarColor n) = "var(--" <> n <> ")"+-----------------------------------------------------------------------------+-- | Smart constructor for a [CSS variable](https://developer.mozilla.org/en-US/docs/Web/CSS/CSS_cascading_variables/Using_CSS_custom_properties).+--+-- >>> renderColor (var "foo")+-- "var(--foo)"+--+var :: MisoString -> Color+var = VarColor+-----------------------------------------------------------------------------+-- | Smart constructor for an [RGBA](https://www.w3schools.com/css/css_colors_rgb.asp) 'Color' value.+--+-- >>> renderColor (rgba 0 0 0 1.0)+-- "rgba(0,0,0,1.0)"+--+rgba :: Int -> Int -> Int -> Double -> Color+rgba = RGBA+-----------------------------------------------------------------------------+-- | Smart constructor for an [RGB](https://www.w3schools.com/css/css_colors_rgb.asp) 'Color' value.+--+-- >>> renderColor (rgb 0 0 0)+-- "rgb(0,0,0)"+--+rgb :: Int -> Int -> Int -> Color+rgb = RGB+-----------------------------------------------------------------------------+-- | Smart constructor for an [HSL](https://www.w3schools.com/css/css_colors_hsl.asp) 'Color' value.+--+-- >>> renderColor (hsl 0 0 0)+-- "hsl(0,0,0)"+--+hsl :: Int -> Int -> Int -> Color+hsl = HSL+-----------------------------------------------------------------------------+-- | Smart constructor for a [HSLA](https://www.w3schools.com/css/css_colors_hsl.asp) 'Color' value.+--+-- >>> renderColor (hsla 0 0 0 1.0)+-- "hsla(0,0,0,1.0)"+--+hsla :: Int -> Int -> Int -> Double -> Color+hsla = HSLA+-----------------------------------------------------------------------------+-- | Smart constructor for a 'Hex' 'Color'+--+-- >>> renderColor (hex "ccc")+-- "#ccc"+--+hex :: MisoString -> Color+hex = Hex+-----------------------------------------------------------------------------+-- | Smart constructor for an 'OKLCH' 'Color'+--+-- >>> renderColor (oklch 40.1 0.123 0.123)+-- "oklch(40.1% 0.123 0.123)"+--+oklch :: Double -> Double -> Double -> Color+oklch = OKLCH+-----------------------------------------------------------------------------+-- | 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)"+--+oklcha :: Double -> Double -> Double -> Double -> Color+oklcha = OKLCHA+-----------------------------------------------------------------------------+-- | Smart constructor for the 'transparent' color+--+-- >>> renderColor transparent+-- "rgba(0,0,0,0.0)"+--+transparent :: Color+transparent = rgba 0 0 0 0+-----------------------------------------------------------------------------+-- | Smart constructor for the 'aliceblue' 'Color'.+--+-- >>> renderColor aliceblue+-- "rgba(240,248,255,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iYWxpY2VibHVlIi8+PC9zdmc+>>+--+aliceblue :: Color+aliceblue = rgba 240 248 255 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'antiquewhite' 'Color'.+--+-- >>> renderColor antiquewhite+-- "rgba(250,235,215,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iYW50aXF1ZXdoaXRlIi8+PC9zdmc+>>+--+antiquewhite :: Color+antiquewhite = rgba 250 235 215 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'aqua' 'Color'.+--+-- >>> renderColor aqua+-- "rgba(0,255,255,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iYXF1YSIvPjwvc3ZnPg==>>+--+aqua :: Color+aqua = rgba 0 255 255 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'aquamarine' 'Color'.+--+-- >>> renderColor aquamarine+-- "rgba(127,255,212,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iYXF1YW1hcmluZSIvPjwvc3ZnPg==>>+--+aquamarine :: Color+aquamarine = rgba 127 255 212 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'azure' 'Color'.+--+-- >>> renderColor azure+-- "rgba(240,255,255,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iYXp1cmUiLz48L3N2Zz4=>>+--+azure :: Color+azure = rgba 240 255 255 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'beige' 'Color'.+--+-- >>> renderColor beige+-- "rgba(245,245,220,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iYmVpZ2UiLz48L3N2Zz4=>>+--+beige :: Color+beige = rgba 245 245 220 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'bisque' 'Color'.+--+-- >>> renderColor bisque+-- "rgba(255,228,196,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iYmlzcXVlIi8+PC9zdmc+>>+--+bisque :: Color+bisque = rgba 255 228 196 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'black' 'Color'.+--+-- >>> renderColor black+-- "rgba(0,0,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iYmxhY2siLz48L3N2Zz4=>>+--+black :: Color+black = rgba 0 0 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'blanchedalmond' 'Color'.+--+-- >>> renderColor blanchedalmond+-- "rgba(255,235,205,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iYmxhbmNoZWRhbG1vbmQiLz48L3N2Zz4=>>+--+blanchedalmond :: Color+blanchedalmond = rgba 255 235 205 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'blue' 'Color'.+--+-- >>> renderColor blue+-- "rgba(0,0,255,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iYmx1ZSIvPjwvc3ZnPg==>>+--+blue :: Color+blue = rgba 0 0 255 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'blueviolet' 'Color'.+--+-- >>> renderColor blueviolet+-- "rgba(138,43,226,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iYmx1ZXZpb2xldCIvPjwvc3ZnPg==>>+--+blueviolet :: Color+blueviolet = rgba 138 43 226 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'brown' 'Color'.+--+-- >>> renderColor brown+-- "rgba(165,42,42,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iYnJvd24iLz48L3N2Zz4=>>+--+brown :: Color+brown = rgba 165 42 42 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'burlywood' 'Color'.+--+-- >>> renderColor burlywood+-- "rgba(222,184,135,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iYnVybHl3b29kIi8+PC9zdmc+>>+--+burlywood :: Color+burlywood = rgba 222 184 135 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'cadetblue' 'Color'.+--+-- >>> renderColor cadetblue+-- "rgba(95,158,160,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iY2FkZXRibHVlIi8+PC9zdmc+>>+--+cadetblue :: Color+cadetblue = rgba 95 158 160 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'chartreuse' 'Color'.+--+-- >>> renderColor chartreuse+-- "rgba(127,255,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iY2hhcnRyZXVzZSIvPjwvc3ZnPg==>>+--+chartreuse :: Color+chartreuse = rgba 127 255 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'chocolate' 'Color'.+--+-- >>> renderColor chocolate+-- "rgba(210,105,30,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iY2hvY29sYXRlIi8+PC9zdmc+>>+--+chocolate :: Color+chocolate = rgba 210 105 30 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'coral' 'Color'.+--+-- >>> renderColor coral+-- "rgba(255,127,80,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iY29yYWwiLz48L3N2Zz4=>>+--+coral :: Color+coral = rgba 255 127 80 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'cornflowerblue' 'Color'.+--+-- >>> renderColor cornflowerblue+-- "rgba(100,149,237,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iY29ybmZsb3dlcmJsdWUiLz48L3N2Zz4=>>+--+cornflowerblue :: Color+cornflowerblue = rgba 100 149 237 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'cornsilk' 'Color'.+--+-- >>> renderColor cornsilk+-- "rgba(255,248,220,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iY29ybnNpbGsiLz48L3N2Zz4=>>+--+cornsilk :: Color+cornsilk = rgba 255 248 220 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'crimson' 'Color'.+--+-- >>> renderColor crimson+-- "rgba(220,20,60,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iY3JpbXNvbiIvPjwvc3ZnPg==>>+--+crimson :: Color+crimson = rgba 220 20 60 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'cyan' 'Color'.+--+-- >>> renderColor cyan+-- "rgba(0,255,255,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iY3lhbiIvPjwvc3ZnPg==>>+--+cyan :: Color+cyan = rgba 0 255 255 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkblue' 'Color'.+--+-- >>> renderColor darkblue+-- "rgba(0,0,139,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya2JsdWUiLz48L3N2Zz4=>>+--+darkblue :: Color+darkblue = rgba 0 0 139 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkcyan' 'Color'.+--+-- >>> renderColor darkcyan+-- "rgba(0,139,139,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya2N5YW4iLz48L3N2Zz4=>>+--+darkcyan :: Color+darkcyan = rgba 0 139 139 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkgoldenrod' 'Color'.+--+-- >>> renderColor darkgoldenrod+-- "rgba(184,134,11,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya2dvbGRlbnJvZCIvPjwvc3ZnPg==>>+--+darkgoldenrod :: Color+darkgoldenrod = rgba 184 134 11 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkgray' 'Color'.+--+-- >>> renderColor darkgray+-- "rgba(169,169,169,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya2dyYXkiLz48L3N2Zz4=>>+--+darkgray :: Color+darkgray = rgba 169 169 169 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkgreen' 'Color'.+--+-- >>> renderColor darkgreen+-- "rgba(0,100,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya2dyZWVuIi8+PC9zdmc+>>+--+darkgreen :: Color+darkgreen = rgba 0 100 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkgrey' 'Color'.+--+-- >>> renderColor darkgrey+-- "rgba(169,169,169,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya2dyZXkiLz48L3N2Zz4=>>+--+darkgrey :: Color+darkgrey = rgba 169 169 169 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkkhaki' 'Color'.+--+-- >>> renderColor darkkhaki+-- "rgba(189,183,107,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya2toYWtpIi8+PC9zdmc+>>+--+darkkhaki :: Color+darkkhaki = rgba 189 183 107 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkmagenta' 'Color'.+--+-- >>> renderColor darkmagenta+-- "rgba(139,0,139,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya21hZ2VudGEiLz48L3N2Zz4=>>+--+darkmagenta :: Color+darkmagenta = rgba 139 0 139 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkolivegreen' 'Color'.+--+-- >>> renderColor darkolivegreen+-- "rgba(85,107,47,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya29saXZlZ3JlZW4iLz48L3N2Zz4=>>+--+darkolivegreen :: Color+darkolivegreen = rgba 85 107 47 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkorange' 'Color'.+--+-- >>> renderColor darkorange+-- "rgba(255,140,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya29yYW5nZSIvPjwvc3ZnPg==>>+--+darkorange :: Color+darkorange = rgba 255 140 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkorchid' 'Color'.+--+-- >>> renderColor darkorchid+-- "rgba(153,50,204,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya29yY2hpZCIvPjwvc3ZnPg==>>+--+darkorchid :: Color+darkorchid = rgba 153 50 204 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkred' 'Color'.+--+-- >>> renderColor darkred+-- "rgba(139,0,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya3JlZCIvPjwvc3ZnPg==>>+--+darkred :: Color+darkred = rgba 139 0 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darksalmon' 'Color'.+--+-- >>> renderColor darksalmon+-- "rgba(233,150,122,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya3NhbG1vbiIvPjwvc3ZnPg==>>+--+darksalmon :: Color+darksalmon = rgba 233 150 122 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkseagreen' 'Color'.+--+-- >>> renderColor darkseagreen+-- "rgba(143,188,143,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya3NlYWdyZWVuIi8+PC9zdmc+>>+--+darkseagreen :: Color+darkseagreen = rgba 143 188 143 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkslateblue' 'Color'.+--+-- >>> renderColor darkslateblue+-- "rgba(72,61,139,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya3NsYXRlYmx1ZSIvPjwvc3ZnPg==>>+--+darkslateblue :: Color+darkslateblue = rgba 72 61 139 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkslategray' 'Color'.+--+-- >>> renderColor darkslategray+-- "rgba(47,79,79,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya3NsYXRlZ3JheSIvPjwvc3ZnPg==>>+--+darkslategray :: Color+darkslategray = rgba 47 79 79 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkslategrey' 'Color'.+--+-- >>> renderColor darkslategrey+-- "rgba(47,79,79,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya3NsYXRlZ3JleSIvPjwvc3ZnPg==>>+--+darkslategrey :: Color+darkslategrey = rgba 47 79 79 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkturquoise' 'Color'.+--+-- >>> renderColor darkturquoise+-- "rgba(0,206,209,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya3R1cnF1b2lzZSIvPjwvc3ZnPg==>>+--+darkturquoise :: Color+darkturquoise = rgba 0 206 209 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'darkviolet' 'Color'.+--+-- >>> renderColor darkviolet+-- "rgba(148,0,211,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGFya3Zpb2xldCIvPjwvc3ZnPg==>>+--+darkviolet :: Color+darkviolet = rgba 148 0 211 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'deeppink' 'Color'.+--+-- >>> renderColor deeppink+-- "rgba(255,20,147,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGVlcHBpbmsiLz48L3N2Zz4=>>+--+deeppink :: Color+deeppink = rgba 255 20 147 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'deepskyblue' 'Color'.+--+-- >>> renderColor deepskyblue+-- "rgba(0,191,255,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGVlcHNreWJsdWUiLz48L3N2Zz4=>>+--+deepskyblue :: Color+deepskyblue = rgba 0 191 255 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'dimgray' 'Color'.+--+-- >>> renderColor dimgray+-- "rgba(105,105,105,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGltZ3JheSIvPjwvc3ZnPg==>>+--+dimgray :: Color+dimgray = rgba 105 105 105 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'dimgrey' 'Color'.+--+-- >>> renderColor dimgrey+-- "rgba(105,105,105,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZGltZ3JleSIvPjwvc3ZnPg==>>+--+dimgrey :: Color+dimgrey = rgba 105 105 105 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'dodgerblue' 'Color'.+--+-- >>> renderColor dodgerblue+-- "rgba(30,144,255,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZG9kZ2VyYmx1ZSIvPjwvc3ZnPg==>>+--+dodgerblue :: Color+dodgerblue = rgba 30 144 255 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'firebrick' 'Color'.+--+-- >>> renderColor firebrick+-- "rgba(178,34,34,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZmlyZWJyaWNrIi8+PC9zdmc+>>+--+firebrick :: Color+firebrick = rgba 178 34 34 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'floralwhite' 'Color'.+--+-- >>> renderColor floralwhite+-- "rgba(255,250,240,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZmxvcmFsd2hpdGUiLz48L3N2Zz4=>>+--+floralwhite :: Color+floralwhite = rgba 255 250 240 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'forestgreen' 'Color'.+--+-- >>> renderColor forestgreen+-- "rgba(34,139,34,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZm9yZXN0Z3JlZW4iLz48L3N2Zz4=>>+--+forestgreen :: Color+forestgreen = rgba 34 139 34 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'fuchsia' 'Color'.+--+-- >>> renderColor fuchsia+-- "rgba(255,0,255,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZnVjaHNpYSIvPjwvc3ZnPg==>>+--+fuchsia :: Color+fuchsia = rgba 255 0 255 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'gainsboro' 'Color'.+--+-- >>> renderColor gainsboro+-- "rgba(220,220,220,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZ2FpbnNib3JvIi8+PC9zdmc+>>+--+gainsboro :: Color+gainsboro = rgba 220 220 220 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'ghostwhite' 'Color'.+--+-- >>> renderColor ghostwhite+-- "rgba(248,248,255,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZ2hvc3R3aGl0ZSIvPjwvc3ZnPg==>>+--+ghostwhite :: Color+ghostwhite = rgba 248 248 255 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'gold' 'Color'.+--+-- >>> renderColor gold+-- "rgba(255,215,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZ29sZCIvPjwvc3ZnPg==>>+--+gold :: Color+gold = rgba 255 215 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'goldenrod' 'Color'.+--+-- >>> renderColor goldenrod+-- "rgba(218,165,32,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZ29sZGVucm9kIi8+PC9zdmc+>>+--+goldenrod :: Color+goldenrod = rgba 218 165 32 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'gray' 'Color'.+--+-- >>> renderColor gray+-- "rgba(128,128,128,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZ3JheSIvPjwvc3ZnPg==>>+--+gray :: Color+gray = rgba 128 128 128 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'green' 'Color'.+--+-- >>> renderColor green+-- "rgba(0,128,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZ3JlZW4iLz48L3N2Zz4=>>+--+green :: Color+green = rgba 0 128 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'greenyellow' 'Color'.+--+-- >>> renderColor greenyellow+-- "rgba(173,255,47,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZ3JlZW55ZWxsb3ciLz48L3N2Zz4=>>+--+greenyellow :: Color+greenyellow = rgba 173 255 47 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'grey' 'Color'.+--+-- >>> renderColor grey+-- "rgba(128,128,128,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iZ3JleSIvPjwvc3ZnPg==>>+--+grey :: Color+grey = rgba 128 128 128 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'honeydew' 'Color'.+--+-- >>> renderColor honeydew+-- "rgba(240,255,240,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iaG9uZXlkZXciLz48L3N2Zz4=>>+--+honeydew :: Color+honeydew = rgba 240 255 240 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'hotpink' 'Color'.+--+-- >>> renderColor hotpink+-- "rgba(255,105,180,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iaG90cGluayIvPjwvc3ZnPg==>>+--+hotpink :: Color+hotpink = rgba 255 105 180 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'indianred' 'Color'.+--+-- >>> renderColor indianred+-- "rgba(205,92,92,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iaW5kaWFucmVkIi8+PC9zdmc+>>+--+indianred :: Color+indianred = rgba 205 92 92 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'indigo' 'Color'.+--+-- >>> renderColor indigo+-- "rgba(75,0,130,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iaW5kaWdvIi8+PC9zdmc+>>+--+indigo :: Color+indigo = rgba 75 0 130 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'ivory' 'Color'.+--+-- >>> renderColor ivory+-- "rgba(255,255,240,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0iaXZvcnkiLz48L3N2Zz4=>>+--+ivory :: Color+ivory = rgba 255 255 240 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'khaki' 'Color'.+--+-- >>> renderColor khaki+-- "rgba(240,230,140,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ia2hha2kiLz48L3N2Zz4=>>+--+khaki :: Color+khaki = rgba 240 230 140 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lavender' 'Color'.+--+-- >>> renderColor lavender+-- "rgba(230,230,250,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGF2ZW5kZXIiLz48L3N2Zz4=>>+--+lavender :: Color+lavender = rgba 230 230 250 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lavenderblush' 'Color'.+--+-- >>> renderColor lavenderblush+-- "rgba(255,240,245,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGF2ZW5kZXJibHVzaCIvPjwvc3ZnPg==>>+--+lavenderblush :: Color+lavenderblush = rgba 255 240 245 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lawngreen' 'Color'.+--+-- >>> renderColor lawngreen+-- "rgba(124,252,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGF3bmdyZWVuIi8+PC9zdmc+>>+--+lawngreen :: Color+lawngreen = rgba 124 252 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lemonchiffon' 'Color'.+--+-- >>> renderColor lemonchiffon+-- "rgba(255,250,205,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGVtb25jaGlmZm9uIi8+PC9zdmc+>>+--+lemonchiffon :: Color+lemonchiffon = rgba 255 250 205 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightblue' 'Color'.+--+-- >>> renderColor lightblue+-- "rgba(173,216,230,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRibHVlIi8+PC9zdmc+>>+--+lightblue :: Color+lightblue = rgba 173 216 230 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightcoral' 'Color'.+--+-- >>> renderColor lightcoral+-- "rgba(240,128,128,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRjb3JhbCIvPjwvc3ZnPg==>>+--+lightcoral :: Color+lightcoral = rgba 240 128 128 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightcyan' 'Color'.+--+-- >>> renderColor lightcyan+-- "rgba(224,255,255,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRjeWFuIi8+PC9zdmc+>>+--+lightcyan :: Color+lightcyan = rgba 224 255 255 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightgoldenrodyellow' 'Color'.+--+-- >>> renderColor lightgoldenrodyellow+-- "rgba(250,250,210,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRnb2xkZW5yb2R5ZWxsb3ciLz48L3N2Zz4=>>+--+lightgoldenrodyellow :: Color+lightgoldenrodyellow = rgba 250 250 210 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightgray' 'Color'.+--+-- >>> renderColor lightgray+-- "rgba(211,211,211,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRncmF5Ii8+PC9zdmc+>>+--+lightgray :: Color+lightgray = rgba 211 211 211 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightgreen' 'Color'.+--+-- >>> renderColor lightgreen+-- "rgba(144,238,144,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRncmVlbiIvPjwvc3ZnPg==>>+--+lightgreen :: Color+lightgreen = rgba 144 238 144 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightgrey' 'Color'.+--+-- >>> renderColor lightgrey+-- "rgba(211,211,211,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRncmV5Ii8+PC9zdmc+>>+--+lightgrey :: Color+lightgrey = rgba 211 211 211 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightpink' 'Color'.+--+-- >>> renderColor lightpink+-- "rgba(255,182,193,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRwaW5rIi8+PC9zdmc+>>+--+lightpink :: Color+lightpink = rgba 255 182 193 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightsalmon' 'Color'.+--+-- >>> renderColor lightsalmon+-- "rgba(255,160,122,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRzYWxtb24iLz48L3N2Zz4=>>+--+lightsalmon :: Color+lightsalmon = rgba 255 160 122 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightseagreen' 'Color'.+--+-- >>> renderColor lightseagreen+-- "rgba(32,178,170,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRzZWFncmVlbiIvPjwvc3ZnPg==>>+--+lightseagreen :: Color+lightseagreen = rgba 32 178 170 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightskyblue' 'Color'.+--+-- >>> renderColor lightskyblue+-- "rgba(135,206,250,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRza3libHVlIi8+PC9zdmc+>>+--+lightskyblue :: Color+lightskyblue = rgba 135 206 250 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightslategray' 'Color'.+--+-- >>> renderColor lightslategray+-- "rgba(119,136,153,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRzbGF0ZWdyYXkiLz48L3N2Zz4=>>+--+lightslategray :: Color+lightslategray = rgba 119 136 153 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightslategrey' 'Color'.+--+-- >>> renderColor lightslategrey+-- "rgba(119,136,153,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRzbGF0ZWdyZXkiLz48L3N2Zz4=>>+--+lightslategrey :: Color+lightslategrey = rgba 119 136 153 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightsteelblue' 'Color'.+--+-- >>> renderColor lightsteelblue+-- "rgba(176,196,222,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHRzdGVlbGJsdWUiLz48L3N2Zz4=>>+--+lightsteelblue :: Color+lightsteelblue = rgba 176 196 222 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lightyellow' 'Color'.+--+-- >>> renderColor lightyellow+-- "rgba(255,255,224,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGlnaHR5ZWxsb3ciLz48L3N2Zz4=>>+--+lightyellow :: Color+lightyellow = rgba 255 255 224 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'lime' 'Color'.+--+-- >>> renderColor lime+-- "rgba(0,255,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGltZSIvPjwvc3ZnPg==>>+--+lime :: Color+lime = rgba 0 255 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'limegreen' 'Color'.+--+-- >>> renderColor limegreen+-- "rgba(50,205,50,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGltZWdyZWVuIi8+PC9zdmc+>>+--+limegreen :: Color+limegreen = rgba 50 205 50 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'linen' 'Color'.+--+-- >>> renderColor linen+-- "rgba(250,240,230,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibGluZW4iLz48L3N2Zz4=>>+--+linen :: Color+linen = rgba 250 240 230 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'magenta' 'Color'.+--+-- >>> renderColor magenta+-- "rgba(255,0,255,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWFnZW50YSIvPjwvc3ZnPg==>>+--+magenta :: Color+magenta = rgba 255 0 255 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'maroon' 'Color'.+--+-- >>> renderColor maroon+-- "rgba(128,0,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWFyb29uIi8+PC9zdmc+>>+--+maroon :: Color+maroon = rgba 128 0 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'mediumaquamarine' 'Color'.+--+-- >>> renderColor mediumaquamarine+-- "rgba(102,205,170,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWVkaXVtYXF1YW1hcmluZSIvPjwvc3ZnPg==>>+--+mediumaquamarine :: Color+mediumaquamarine = rgba 102 205 170 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'mediumblue' 'Color'.+--+-- >>> renderColor mediumblue+-- "rgba(0,0,205,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWVkaXVtYmx1ZSIvPjwvc3ZnPg==>>+--+mediumblue :: Color+mediumblue = rgba 0 0 205 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'mediumorchid' 'Color'.+--+-- >>> renderColor mediumorchid+-- "rgba(186,85,211,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWVkaXVtb3JjaGlkIi8+PC9zdmc+>>+--+mediumorchid :: Color+mediumorchid = rgba 186 85 211 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'mediumpurple' 'Color'.+--+-- >>> renderColor mediumpurple+-- "rgba(147,112,219,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWVkaXVtcHVycGxlIi8+PC9zdmc+>>+--+mediumpurple :: Color+mediumpurple = rgba 147 112 219 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'mediumseagreen' 'Color'.+--+-- >>> renderColor mediumseagreen+-- "rgba(60,179,113,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWVkaXVtc2VhZ3JlZW4iLz48L3N2Zz4=>>+--+mediumseagreen :: Color+mediumseagreen = rgba 60 179 113 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'mediumslateblue' 'Color'.+--+-- >>> renderColor mediumslateblue+-- "rgba(123,104,238,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWVkaXVtc2xhdGVibHVlIi8+PC9zdmc+>>+--+mediumslateblue :: Color+mediumslateblue = rgba 123 104 238 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'mediumspringgreen' 'Color'.+--+-- >>> renderColor mediumspringgreen+-- "rgba(0,250,154,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWVkaXVtc3ByaW5nZ3JlZW4iLz48L3N2Zz4=>>+--+mediumspringgreen :: Color+mediumspringgreen = rgba 0 250 154 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'mediumturquoise' 'Color'.+--+-- >>> renderColor mediumturquoise+-- "rgba(72,209,204,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWVkaXVtdHVycXVvaXNlIi8+PC9zdmc+>>+--+mediumturquoise :: Color+mediumturquoise = rgba 72 209 204 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'mediumvioletred' 'Color'.+--+-- >>> renderColor mediumvioletred+-- "rgba(199,21,133,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWVkaXVtdmlvbGV0cmVkIi8+PC9zdmc+>>+--+mediumvioletred :: Color+mediumvioletred = rgba 199 21 133 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'midnightblue' 'Color'.+--+-- >>> renderColor midnightblue+-- "rgba(25,25,112,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWlkbmlnaHRibHVlIi8+PC9zdmc+>>+--+midnightblue :: Color+midnightblue = rgba 25 25 112 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'mintcream' 'Color'.+--+-- >>> renderColor mintcream+-- "rgba(245,255,250,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWludGNyZWFtIi8+PC9zdmc+>>+--+mintcream :: Color+mintcream = rgba 245 255 250 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'mistyrose' 'Color'.+--+-- >>> renderColor mistyrose+-- "rgba(255,228,225,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibWlzdHlyb3NlIi8+PC9zdmc+>>+--+mistyrose :: Color+mistyrose = rgba 255 228 225 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'moccasin' 'Color'.+--+-- >>> renderColor moccasin+-- "rgba(255,228,181,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibW9jY2FzaW4iLz48L3N2Zz4=>>+--+moccasin :: Color+moccasin = rgba 255 228 181 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'navajowhite' 'Color'.+--+-- >>> renderColor navajowhite+-- "rgba(255,222,173,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibmF2YWpvd2hpdGUiLz48L3N2Zz4=>>+--+navajowhite :: Color+navajowhite = rgba 255 222 173 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'navy' 'Color'.+--+-- >>> renderColor navy+-- "rgba(0,0,128,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ibmF2eSIvPjwvc3ZnPg==>>+--+navy :: Color+navy = rgba 0 0 128 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'oldlace' 'Color'.+--+-- >>> renderColor oldlace+-- "rgba(253,245,230,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ib2xkbGFjZSIvPjwvc3ZnPg==>>+--+oldlace :: Color+oldlace = rgba 253 245 230 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'olive' 'Color'.+--+-- >>> renderColor olive+-- "rgba(128,128,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ib2xpdmUiLz48L3N2Zz4=>>+--+olive :: Color+olive = rgba 128 128 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'olivedrab' 'Color'.+--+-- >>> renderColor olivedrab+-- "rgba(107,142,35,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ib2xpdmVkcmFiIi8+PC9zdmc+>>+--+olivedrab :: Color+olivedrab = rgba 107 142 35 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'orange' 'Color'.+--+-- >>> renderColor orange+-- "rgba(255,165,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ib3JhbmdlIi8+PC9zdmc+>>+--+orange :: Color+orange = rgba 255 165 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'orangered' 'Color'.+--+-- >>> renderColor orangered+-- "rgba(255,69,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ib3JhbmdlcmVkIi8+PC9zdmc+>>+--+orangered :: Color+orangered = rgba 255 69 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'orchid' 'Color'.+--+-- >>> renderColor orchid+-- "rgba(218,112,214,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ib3JjaGlkIi8+PC9zdmc+>>+--+orchid :: Color+orchid = rgba 218 112 214 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'palegoldenrod' 'Color'.+--+-- >>> renderColor palegoldenrod+-- "rgba(238,232,170,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icGFsZWdvbGRlbnJvZCIvPjwvc3ZnPg==>>+--+palegoldenrod :: Color+palegoldenrod = rgba 238 232 170 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'palegreen' 'Color'.+--+-- >>> renderColor palegreen+-- "rgba(152,251,152,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icGFsZWdyZWVuIi8+PC9zdmc+>>+--+palegreen :: Color+palegreen = rgba 152 251 152 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'paleturquoise' 'Color'.+--+-- >>> renderColor paleturquoise+-- "rgba(175,238,238,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icGFsZXR1cnF1b2lzZSIvPjwvc3ZnPg==>>+--+paleturquoise :: Color+paleturquoise = rgba 175 238 238 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'palevioletred' 'Color'.+--+-- >>> renderColor palevioletred+-- "rgba(219,112,147,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icGFsZXZpb2xldHJlZCIvPjwvc3ZnPg==>>+--+palevioletred :: Color+palevioletred = rgba 219 112 147 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'papayawhip' 'Color'.+--+-- >>> renderColor papayawhip+-- "rgba(255,239,213,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icGFwYXlhd2hpcCIvPjwvc3ZnPg==>>+--+papayawhip :: Color+papayawhip = rgba 255 239 213 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'peachpuff' 'Color'.+--+-- >>> renderColor peachpuff+-- "rgba(255,218,185,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icGVhY2hwdWZmIi8+PC9zdmc+>>+--+peachpuff :: Color+peachpuff = rgba 255 218 185 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'peru' 'Color'.+--+-- >>> renderColor peru+-- "rgba(205,133,63,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icGVydSIvPjwvc3ZnPg==>>+--+peru :: Color+peru = rgba 205 133 63 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'pink' 'Color'.+--+-- >>> renderColor pink+-- "rgba(255,192,203,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icGluayIvPjwvc3ZnPg==>>+--+pink :: Color+pink = rgba 255 192 203 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'plum' 'Color'.+--+-- >>> renderColor plum+-- "rgba(221,160,221,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icGx1bSIvPjwvc3ZnPg==>>+--+plum :: Color+plum = rgba 221 160 221 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'powderblue' 'Color'.+--+-- >>> renderColor powderblue+-- "rgba(176,224,230,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icG93ZGVyYmx1ZSIvPjwvc3ZnPg==>>+--+powderblue :: Color+powderblue = rgba 176 224 230 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'purple' 'Color'.+--+-- >>> renderColor purple+-- "rgba(128,0,128,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icHVycGxlIi8+PC9zdmc+>>+--+purple :: Color+purple = rgba 128 0 128 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'red' 'Color'.+--+-- >>> renderColor red+-- "rgba(255,0,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icmVkIi8+PC9zdmc+>>+--+red :: Color+red = rgba 255 0 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'rosybrown' 'Color'.+--+-- >>> renderColor rosybrown+-- "rgba(188,143,143,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icm9zeWJyb3duIi8+PC9zdmc+>>+--+rosybrown :: Color+rosybrown = rgba 188 143 143 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'royalblue' 'Color'.+--+-- >>> renderColor royalblue+-- "rgba(65,105,225,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0icm95YWxibHVlIi8+PC9zdmc+>>+--+royalblue :: Color+royalblue = rgba 65 105 225 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'saddlebrown' 'Color'.+--+-- >>> renderColor saddlebrown+-- "rgba(139,69,19,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic2FkZGxlYnJvd24iLz48L3N2Zz4=>>+--+saddlebrown :: Color+saddlebrown = rgba 139 69 19 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'salmon' 'Color'.+--+-- >>> renderColor salmon+-- "rgba(250,128,114,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic2FsbW9uIi8+PC9zdmc+>>+--+salmon :: Color+salmon = rgba 250 128 114 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'sandybrown' 'Color'.+--+-- >>> renderColor sandybrown+-- "rgba(244,164,96,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic2FuZHlicm93biIvPjwvc3ZnPg==>>+--+sandybrown :: Color+sandybrown = rgba 244 164 96 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'seagreen' 'Color'.+--+-- >>> renderColor seagreen+-- "rgba(46,139,87,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic2VhZ3JlZW4iLz48L3N2Zz4=>>+--+seagreen :: Color+seagreen = rgba 46 139 87 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'seashell' 'Color'.+--+-- >>> renderColor seashell+-- "rgba(255,245,238,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic2Vhc2hlbGwiLz48L3N2Zz4=>>+--+seashell :: Color+seashell = rgba 255 245 238 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'sienna' 'Color'.+--+-- >>> renderColor sienna+-- "rgba(160,82,45,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic2llbm5hIi8+PC9zdmc+>>+--+sienna :: Color+sienna = rgba 160 82 45 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'silver' 'Color'.+--+-- >>> renderColor silver+-- "rgba(192,192,192,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic2lsdmVyIi8+PC9zdmc+>>+--+silver :: Color+silver = rgba 192 192 192 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'skyblue' 'Color'.+--+-- >>> renderColor skyblue+-- "rgba(135,206,235,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic2t5Ymx1ZSIvPjwvc3ZnPg==>>+--+skyblue :: Color+skyblue = rgba 135 206 235 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'slateblue' 'Color'.+--+-- >>> renderColor slateblue+-- "rgba(106,90,205,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic2xhdGVibHVlIi8+PC9zdmc+>>+--+slateblue :: Color+slateblue = rgba 106 90 205 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'slategray' 'Color'.+--+-- >>> renderColor slategray+-- "rgba(112,128,144,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic2xhdGVncmF5Ii8+PC9zdmc+>>+--+slategray :: Color+slategray = rgba 112 128 144 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'slategrey' 'Color'.+--+-- >>> renderColor slategrey+-- "rgba(112,128,144,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic2xhdGVncmV5Ii8+PC9zdmc+>>+--+slategrey :: Color+slategrey = rgba 112 128 144 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'snow' 'Color'.+--+-- >>> renderColor snow+-- "rgba(255,250,250,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic25vdyIvPjwvc3ZnPg==>>+--+snow :: Color+snow = rgba 255 250 250 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'springgreen' 'Color'.+--+-- >>> renderColor springgreen+-- "rgba(0,255,127,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic3ByaW5nZ3JlZW4iLz48L3N2Zz4=>>+--+springgreen :: Color+springgreen = rgba 0 255 127 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'steelblue' 'Color'.+--+-- >>> renderColor steelblue+-- "rgba(70,130,180,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ic3RlZWxibHVlIi8+PC9zdmc+>>+--+steelblue :: Color+steelblue = rgba 70 130 180 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'tan' 'Color'.+--+-- >>> renderColor tan+-- "rgba(210,180,140,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0idGFuIi8+PC9zdmc+>>+--+tan :: Color+tan = rgba 210 180 140 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'teal' 'Color'.+--+-- >>> renderColor teal+-- "rgba(0,128,128,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0idGVhbCIvPjwvc3ZnPg==>>+--+teal :: Color+teal = rgba 0 128 128 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'thistle' 'Color'.+--+-- >>> renderColor thistle+-- "rgba(216,191,216,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0idGhpc3RsZSIvPjwvc3ZnPg==>>+--+thistle :: Color+thistle = rgba 216 191 216 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'tomato' 'Color'.+--+-- >>> renderColor tomato+-- "rgba(255,99,71,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0idG9tYXRvIi8+PC9zdmc+>>+--+tomato :: Color+tomato = rgba 255 99 71 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'turquoise' 'Color'.+--+-- >>> renderColor turquoise+-- "rgba(64,224,208,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0idHVycXVvaXNlIi8+PC9zdmc+>>+--+turquoise :: Color+turquoise = rgba 64 224 208 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'violet' 'Color'.+--+-- >>> renderColor violet+-- "rgba(238,130,238,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0idmlvbGV0Ii8+PC9zdmc+>>+--+violet :: Color+violet = rgba 238 130 238 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'wheat' 'Color'.+--+-- >>> renderColor wheat+-- "rgba(245,222,179,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0id2hlYXQiLz48L3N2Zz4=>>+--+wheat :: Color+wheat = rgba 245 222 179 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'white' 'Color'.+--+-- >>> renderColor white+-- "rgba(255,255,255,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0id2hpdGUiLz48L3N2Zz4=>>+--+white :: Color+white = rgba 255 255 255 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'whitesmoke' 'Color'.+--+-- >>> renderColor whitesmoke+-- "rgba(245,245,245,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0id2hpdGVzbW9rZSIvPjwvc3ZnPg==>>+--+whitesmoke :: Color+whitesmoke = rgba 245 245 245 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'yellow' 'Color'.+--+-- >>> renderColor yellow+-- "rgba(255,255,0,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ieWVsbG93Ii8+PC9zdmc+>>+--+yellow :: Color+yellow = rgba 255 255 0 1+-----------------------------------------------------------------------------+-- | Smart constructor for the 'yellowgreen' 'Color'.+--+-- >>> renderColor yellowgreen+-- "rgba(154,205,50,1.0)"+--+-- <<data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHdpZHRoPSIxMDAiIGhlaWdodD0iMTAwIj48cmVjdCB3aWR0aD0iMTAwIiBoZWlnaHQ9IjEwMCIgZmlsbD0ieWVsbG93Z3JlZW4iLz48L3N2Zz4=>>+--+yellowgreen :: Color+yellowgreen = rgba 154 205 50 1+-----------------------------------------------------------------------------
+ src/Miso/CSS/Types.hs view
@@ -0,0 +1,130 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.CSS.Types+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = 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+--   <https://developer.mozilla.org/en-US/docs/Web/CSS/@keyframes \@keyframes>+--   animation, or a+--   <https://developer.mozilla.org/en-US/docs/Web/CSS/CSS_media_queries \@media>+--   query.+-- * 'StyleSheet' — an ordered list of 'Styles' rule blocks that together form+--   a complete+--   <https://developer.mozilla.org/en-US/docs/Web/API/StyleSheet stylesheet>.+--+-- 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 \<style\> 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)+-----------------------------------------------------------------------------+-- | Type for a CSS StyleSheet. Internally it maps From CSS selectors to t'Styles'.+--+-- @+-- testSheet :: StyleSheet+-- testSheet =+--    sheet_+--    [ selector_ ".name"+--        [ backgroundColor red+--        , alignContent "top"+--        ]+--    , selector_ "#container"+--        [ backgroundColor blue+--        , alignContent "center"+--        ]+--    , keyframes_ "slide-in"+--      [ from_ [ transforms [ translateX (pct 0) ] ]+--      , at (pct 50)+--        [ backgroundColor red+--        , backgroundSize "10px"+--        ]+--      , to_ [ transforms [ translateX (pct 100) ] ]+--      ]+--    , media_ (screen_ `and_` minWidth_ (px 480))+--      [ rule_ "header" [ height "auto" ]+--      , rule_ "ul"     [ display "block" ]+--      ]+--    ]+-- @+--+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)+-----------------------------------------------------------------------------+-- | An individual CSS <https://developer.mozilla.org/en-US/docs/Web/CSS/transform-function transform function>.+-- 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)+-----------------------------------------------------------------------------
+ src/Miso/Canvas.hs view
@@ -0,0 +1,721 @@+-----------------------------------------------------------------------------+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Canvas+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Canvas" is a typed Haskell wrapper around the browser's+-- <https://developer.mozilla.org/en-US/docs/Web/API/Canvas_API HTML5 Canvas 2D API>.+-- 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+-- <https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D CanvasRenderingContext2D>+-- 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+  , CanvasContext2D+  , Pattern            (..)+  , Gradient           (..)+  , ImageData          (..)+  , LineCapType        (..)+  , PatternType        (..)+  , LineJoinType       (..)+  , DirectionType      (..)+  , TextAlignType      (..)+  , TextBaselineType   (..)+  , CompositeOperation (..)+  , StyleArg           (..)+  , Coord+   -- * Property+  , canvas+  , canvas_+    -- * API+  , set+  , globalCompositeOperation+  , clearRect+  , fillRect+  , strokeRect+  , beginPath+  , closePath+  , moveTo+  , lineTo+  , fill+  , rect+  , stroke+  , bezierCurveTo+  , arc+  , arcTo+  , quadraticCurveTo+  , direction+  , fillText+  , font+  , strokeText+  , textAlign+  , textBaseline+  , addColorStop+  , createLinearGradient+  , createPattern+  , createRadialGradient+  , fillStyle+  , lineCap+  , lineJoin+  , lineWidth+  , miterLimit+  , shadowBlur+  , shadowColor+  , shadowOffsetX+  , shadowOffsetY+  , strokeStyle+  , scale+  , rotate+  , translate+  , transform+  , setTransform+  , drawImage+  , drawImage'+  , createImageData+  , getImageData+  , setImageData+  , height+  , width+  , putImageData+  , globalAlpha+  , clip+  , save+  , restore+  -- * Smart constructors+  , gradient+  , pattern_+  , color+  ) where+-----------------------------------------------------------------------------+import           Control.Monad.IO.Class (liftIO)+import           Control.Monad.Reader (ReaderT, runReaderT, ask)+-----------------------------------------------------------------------------+import           Miso.DSL hiding (call)+import qualified Miso.FFI as FFI+import           Miso.FFI (Image)+import           Miso.Types+import           Miso.CSS (Color, renderColor)+-----------------------------------------------------------------------------+-- | Another variant of canvas, this is not specialized to 'ReaderT'. This is+-- useful when building applications with three.js, or other libraries where+-- explicit context is not necessary.+canvas_+  :: forall model action canvasState+   . (FromJSVal canvasState, ToJSVal canvasState)+  => [ Attribute action ]+  -> (DOMRef -> IO canvasState)+  -- ^ Init function, takes 'DOMRef' as arg, returns canvas init. state.+  -> (canvasState -> IO ())+  -- ^ Callback to render graphics using this canvas' context, takes init state as arg.+  -> View model action+canvas_ attributes initialize_ draw_ = node HTML "canvas" attrs []+  where+    attrs :: [ Attribute action ]+    attrs = initCallback : drawCallack : attributes++    initCallback :: Attribute action+    initCallback = On $ \_ (VTree vtree) _ _ -> do+      flip (FFI.set "onCreated") vtree =<< do+        FFI.syncCallback1 $ \domRef -> do+          initialState <- initialize_ domRef+          FFI.set "state" initialState (Object domRef)++    drawCallack :: Attribute action+    drawCallack = On $ \_ (VTree vtree) _ _ -> do+      flip (FFI.set "draw") vtree =<< do+        FFI.syncCallback1 $ \domRef -> do+          state <- fromJSValUnchecked =<< domRef ! ("state" :: MisoString)+          draw_ state+-----------------------------------------------------------------------------+-- | Element for drawing on a [\<canvas\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/canvas).+-- This function abstracts over the context and interpret callback,+-- including dimension ("2d" or "3d") canvas.+canvas+  :: forall model action canvasState+   . (FromJSVal canvasState, ToJSVal canvasState)+  => [ Attribute action ]+  -> (DOMRef -> Canvas canvasState)+  -- ^ Init function, takes 'DOMRef' as arg, returns canvas init. state.+  -> (canvasState -> Canvas ())+  -- ^ Callback to render graphics using this canvas' context, takes init state as arg.+  -> View model action+canvas attributes initialize draw = node HTML "canvas" attrs []+  where+    attrs :: [ Attribute action ]+    attrs = initCallback : drawCallack : attributes++    initCallback :: Attribute action+    initCallback = On $ \_ (VTree vtree) _ _ -> do+      flip (FFI.set "onCreated") vtree =<< do+        FFI.syncCallback1 $ \domRef -> do+          ctx <- domRef # ("getContext" :: MisoString) $ ["2d" :: MisoString]+          initialState <- runReaderT (initialize domRef) ctx+          FFI.set "state" initialState (Object domRef)++    drawCallack :: Attribute action+    drawCallack = On $ \_ (VTree vtree) _ _ -> do+      flip (FFI.set "draw") vtree =<< do+        FFI.syncCallback1 $ \domRef -> do+          jval <- domRef ! ("state" :: MisoString)+          initialState <- fromJSValUnchecked jval+          ctx <- domRef # ("getContext" :: MisoString) $ ["2d" :: MisoString]+          runReaderT (draw initialState) ctx+-----------------------------------------------------------------------------+-- | Various patterns used in the canvas API+data PatternType = Repeat | RepeatX | RepeatY | NoRepeat+-----------------------------------------------------------------------------+instance ToJSVal PatternType where+  toJSVal = toJSVal . renderPattern+-----------------------------------------------------------------------------+instance FromJSVal PatternType where+  fromJSVal pat =+    fromJSValUnchecked @MisoString pat >>= \case+      "repeat" -> pure (Just Repeat)+      "repeat-x" -> pure (Just RepeatX)+      "repeat-y" -> pure (Just RepeatY)+      "no-repeat" -> pure (Just NoRepeat)+      _ -> pure Nothing+-----------------------------------------------------------------------------+-- | Color, Gradient or Pattern styling+data StyleArg+  = ColorArg Color+  | GradientArg Gradient+  | PatternArg Pattern+-----------------------------------------------------------------------------+-- | Smart constructor for 'Color' when using 'StyleArg'+color :: Color -> StyleArg+color = ColorArg+-----------------------------------------------------------------------------+-- | Smart constructor for t'Gradient' when using t'StyleArg'+gradient :: Gradient -> StyleArg+gradient = GradientArg+-----------------------------------------------------------------------------+-- | Smart constructor for t'Pattern' when using t'StyleArg'+pattern_ :: Pattern -> StyleArg+pattern_ = PatternArg+-----------------------------------------------------------------------------+-- | Renders a t'StyleArg' to a 'JSVal'+renderStyleArg :: StyleArg -> IO JSVal+renderStyleArg = \case+  ColorArg c -> toJSVal (renderColor c)+  GradientArg g -> toJSVal g+  PatternArg p -> toJSVal p+-----------------------------------------------------------------------------+instance ToArgs StyleArg where+  toArgs arg = (:[]) <$> toJSVal arg+-----------------------------------------------------------------------------+instance ToJSVal StyleArg where+  toJSVal = renderStyleArg+-----------------------------------------------------------------------------+-- | Pretty-prints a t'PatternType' as 'Miso.String.MisoString'+renderPattern :: PatternType -> MisoString+renderPattern = \case+  Repeat -> "repeat"+  RepeatX -> "repeat-x"+  RepeatY -> "repeat-y"+  NoRepeat -> "no-repeat"+-----------------------------------------------------------------------------+-- | [LineCap](https://www.w3schools.com/tags/canvas_linecap.asp)+data LineCapType+  = LineCapButt+  | LineCapRound+  | LineCapSquare+  deriving (Show, Eq)+-----------------------------------------------------------------------------+instance ToArgs LineCapType where+  toArgs arg = (:[]) <$> toJSVal arg+-----------------------------------------------------------------------------+instance ToJSVal LineCapType where+  toJSVal = toJSVal . renderLineCapType+-----------------------------------------------------------------------------+-- | Pretty-printing for 'LineCapType'+renderLineCapType :: LineCapType -> MisoString+renderLineCapType = \case+  LineCapButt -> "butt"+  LineCapRound -> "round"+  LineCapSquare -> "square"+-----------------------------------------------------------------------------+-- | [LineJoin](https://www.w3schools.com/tags/canvas_linejoin.asp)+data LineJoinType+  = LineJoinBevel+  | LineJoinRound+  | LineJoinMiter+  deriving (Show, Eq)+-----------------------------------------------------------------------------+instance ToArgs LineJoinType where+  toArgs arg = (:[]) <$> toJSVal arg+-----------------------------------------------------------------------------+instance ToJSVal LineJoinType where+  toJSVal = toJSVal . renderLineJoinType+-----------------------------------------------------------------------------+-- | Pretty-print a 'LineJoinType'+renderLineJoinType :: LineJoinType -> MisoString+renderLineJoinType = \case+ LineJoinBevel -> "bevel"+ LineJoinRound -> "round"+ LineJoinMiter -> "miter"+-----------------------------------------------------------------------------+-- | Left-to-right, right-to-left, or inherit direction type.+data DirectionType+  = LTR+  | RTL+  | Inherit+  deriving (Show, Eq)+-----------------------------------------------------------------------------+instance ToArgs DirectionType where+  toArgs arg = (:[]) <$> toJSVal arg+-----------------------------------------------------------------------------+instance ToJSVal DirectionType where+  toJSVal = toJSVal . renderDirectionType+-----------------------------------------------------------------------------+-- | Pretty-printing for 'DirectionType'+renderDirectionType :: DirectionType -> MisoString+renderDirectionType = \case+  LTR -> "ltr"+  RTL -> "rtl"+  Inherit -> "inherit"+-----------------------------------------------------------------------------+-- | Text alignment type+data TextAlignType+  = TextAlignCenter+  | TextAlignEnd+  | TextAlignLeft+  | TextAlignRight+  | TextAlignStart+  deriving (Show, Eq)+-----------------------------------------------------------------------------+instance ToArgs TextAlignType where+  toArgs arg = (:[]) <$> toJSVal arg+-----------------------------------------------------------------------------+instance ToJSVal TextAlignType where+  toJSVal = toJSVal . renderTextAlignType+-----------------------------------------------------------------------------+-- | Pretty-print 'TextAlignType'+renderTextAlignType :: TextAlignType -> MisoString+renderTextAlignType = \case+  TextAlignCenter -> "center"+  TextAlignEnd -> "end"+  TextAlignLeft -> "left"+  TextAlignRight -> "right"+  TextAlignStart -> "start"+-----------------------------------------------------------------------------+-- | TextBaselineType+data TextBaselineType+  = TextBaselineAlphabetic+  | TextBaselineTop+  | TextBaselineHanging+  | TextBaselineMiddle+  | TextBaselineIdeographic+  | TextBaselineBottom+  deriving (Show, Eq)+-----------------------------------------------------------------------------+instance ToArgs TextBaselineType where+  toArgs arg = (:[]) <$> toJSVal arg+-----------------------------------------------------------------------------+instance ToJSVal TextBaselineType where+  toJSVal = toJSVal . renderTextBaselineType+-----------------------------------------------------------------------------+-- | Pretty-printing for 'TextBaselineType'+renderTextBaselineType :: TextBaselineType -> MisoString+renderTextBaselineType = \case+  TextBaselineAlphabetic -> "alphabetic"+  TextBaselineTop -> "top"+  TextBaselineHanging -> "hanging"+  TextBaselineMiddle -> "middle"+  TextBaselineIdeographic -> "ideographic"+  TextBaselineBottom -> "bottom"+-----------------------------------------------------------------------------+-- | CompositeOperation+data CompositeOperation+  = SourceOver+  | SourceAtop+  | SourceIn+  | SourceOut+  | DestinationOver+  | DestinationAtop+  | DestinationIn+  | DestinationOut+  | Lighter+  | Copy+  | Xor+  deriving (Show, Eq)+-----------------------------------------------------------------------------+instance ToArgs CompositeOperation where+  toArgs arg = (:[]) <$> toJSVal arg+-----------------------------------------------------------------------------+instance ToJSVal CompositeOperation where+  toJSVal = toJSVal . renderCompositeOperation+-----------------------------------------------------------------------------+-- | Pretty-print a 'CompositeOperation'+renderCompositeOperation :: CompositeOperation -> MisoString+renderCompositeOperation = \case+  SourceOver -> "source-over"+  SourceAtop -> "source-atop"+  SourceIn -> "source-in"+  SourceOut -> "source-out"+  DestinationOver -> "destination-over"+  DestinationAtop -> "destination-atop"+  DestinationIn -> "destination-in"+  DestinationOut -> "destination-out"+  Lighter -> "lighter"+  Copy -> "copy"+  Xor -> "xor"+-----------------------------------------------------------------------------+-- | Type used to hold a canvas Pattern+newtype Pattern = Pattern JSVal deriving (ToJSVal)+-----------------------------------------------------------------------------+instance FromJSVal Pattern where+  fromJSVal = pure . pure . Pattern+-----------------------------------------------------------------------------+-- | Type used to hold a Gradient+newtype Gradient = Gradient JSVal deriving (ToJSVal, ToArgs)+-----------------------------------------------------------------------------+instance FromJSVal Gradient where+  fromJSVal = pure . pure . Gradient+-----------------------------------------------------------------------------+-- | Type used to hold t'ImageData'+newtype ImageData = ImageData JSVal deriving (ToJSVal, ToObject)+-----------------------------------------------------------------------------+instance ToArgs ImageData where+  toArgs args = (:[]) <$> toJSVal args+-----------------------------------------------------------------------------+instance FromJSVal ImageData where+  fromJSVal = pure . pure . ImageData+-----------------------------------------------------------------------------+-- | An (x,y) coordinate.+type Coord = (Double, Double)+-----------------------------------------------------------------------------+-- | The canvas t'CanvasContext2D'+type CanvasContext2D = JSVal+-----------------------------------------------------------------------------+call :: (FromJSVal a, ToArgs args) => MisoString -> args -> Canvas a+call name arg = do+  ctx <- ask+  liftIO $ fromJSValUnchecked =<< do+    ctx # name $ arg+-----------------------------------------------------------------------------+-- | Property setter specialized to t'Canvas'.+--+-- @+-- globalCompositeOperation :: CompositeOperation -> Canvas ()+-- globalCompositeOperation = set "globalCompositeOperation"+-- @+--+set :: ToArgs args => MisoString -> args -> Canvas ()+set name args = do+  ctx <- ask+  liftIO $ setField ctx name (toArgs args)+-----------------------------------------------------------------------------+-- | DSL for expressing operations on 'canvas_'+type Canvas a = ReaderT CanvasContext2D IO a+-----------------------------------------------------------------------------+-- | [ctx.globalCompositeOperation = "source-over"](https://www.w3schools.com/tags/canvas_globalcompositeoperation.asp)+globalCompositeOperation :: CompositeOperation -> Canvas ()+globalCompositeOperation = set "globalCompositeOperation"+-----------------------------------------------------------------------------+-- | [ctx.clearRect(x,y,width,height)](https://www.w3schools.com/tags/canvas_clearrect.asp)+clearRect :: (Double, Double, Double, Double) -> Canvas ()+clearRect = call "clearRect"+-----------------------------------------------------------------------------+-- | [ctx.fillRect(x,y,width,height)](https://www.w3schools.com/tags/canvas_fillrect.asp)+fillRect :: (Double, Double, Double, Double) -> Canvas ()+fillRect = call "fillRect"+-----------------------------------------------------------------------------+-- | [ctx.strokeRect(x,y,width,height)](https://www.w3schools.com/tags/canvas_strokerect.asp)+strokeRect :: (Double, Double, Double, Double) -> Canvas ()+strokeRect = call "strokeRect"+-----------------------------------------------------------------------------+-- | [ctx.beginPath()](https://www.w3schools.com/tags/canvas_beginpath.asp)+beginPath :: () -> Canvas ()+beginPath = call "beginPath"+-----------------------------------------------------------------------------+-- | [ctx.closePath()](https://www.w3schools.com/tags/canvas_closepath.asp)+closePath :: () -> Canvas ()+closePath = call "closePath"+-----------------------------------------------------------------------------+-- | [ctx.moveTo(x,y)](https://www.w3schools.com/tags/canvas_moveto.asp)+moveTo :: Coord -> Canvas ()+moveTo = call "moveTo"+-----------------------------------------------------------------------------+-- | [ctx.lineTo(x,y)](https://www.w3schools.com/tags/canvas_lineto.asp)+lineTo :: Coord -> Canvas ()+lineTo = call "lineTo"+-----------------------------------------------------------------------------+-- | [ctx.fill()](https://www.w3schools.com/tags/canvas_fill.asp)+fill :: () -> Canvas ()+fill = call "fill"+-----------------------------------------------------------------------------+-- | [ctx.rect(x,y,width,height)](https://www.w3schools.com/tags/canvas_rect.asp)+rect :: (Double, Double, Double, Double) -> Canvas ()+rect = call "rect"+-----------------------------------------------------------------------------+-- | [ctx.stroke()](https://www.w3schools.com/tags/canvas_stroke.asp)+stroke :: () -> Canvas ()+stroke = call "stroke"+-----------------------------------------------------------------------------+-- | [ctx.bezierCurveTo(cp1x,cp1y,cp2x,cp2y,x,y)](https://www.w3schools.com/tags/canvas_beziercurveto.asp)+bezierCurveTo :: (Double, Double, Double, Double, Double, Double) -> Canvas ()+bezierCurveTo = call "bezierCurveTo"+-----------------------------------------------------------------------------+-- | [context.arc(x, y, r, sAngle, eAngle, counterclockwise)](https://www.w3schools.com/tags/canvas_arc.asp)+arc :: (Double, Double, Double, Double, Double) -> Canvas ()+arc = call "arc"+-----------------------------------------------------------------------------+-- | [context.arcTo(x1, y1, x2, y2, r)](https://www.w3schools.com/tags/canvas_arcto.asp)+arcTo :: (Double, Double, Double, Double, Double) -> Canvas ()+arcTo = call "arcTo"+-----------------------------------------------------------------------------+-- | [context.quadraticCurveTo(cpx,cpy,x,y)](https://www.w3schools.com/tags/canvas_quadraticcurveto.asp)+quadraticCurveTo :: (Double, Double, Double, Double) -> Canvas ()+quadraticCurveTo = call "quadraticCurveTo"+-----------------------------------------------------------------------------+-- | [context.direction = "ltr"](https://www.w3schools.com/tags/canvas_direction.asp)+direction :: DirectionType -> Canvas ()+direction = set "direction"+-----------------------------------------------------------------------------+-- | [context.fillText(text,x,y)](https://www.w3schools.com/tags/canvas_filltext.asp)+fillText :: (MisoString, Double, Double) -> Canvas ()+fillText = call "fillText"+-----------------------------------------------------------------------------+-- | [context.font = "italic small-caps bold 12px arial"](https://www.w3schools.com/tags/canvas_font.asp)+font :: MisoString -> Canvas ()+font = set "font"+-----------------------------------------------------------------------------+-- | [ctx.strokeText()](https://www.w3schools.com/tags/canvas_stroketext.asp)+strokeText :: (MisoString, Double, Double) -> Canvas ()+strokeText = call "strokeText"+-----------------------------------------------------------------------------+-- | [ctx.textAlign = "start"](https://www.w3schools.com/tags/canvas_textalign.asp)+textAlign :: TextAlignType -> Canvas ()+textAlign = set "textAlign"+-----------------------------------------------------------------------------+-- | [ctx.textBaseline = "top"](https://www.w3schools.com/tags/canvas_textBaseLine.asp)+textBaseline :: TextBaselineType -> Canvas ()+textBaseline = set "textBaseline"+-----------------------------------------------------------------------------+-- | [gradient.addColorStop(stop,color)](https://www.w3schools.com/tags/canvas_addcolorstop.asp)+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 ()+-----------------------------------------------------------------------------+-- | [ctx.createLinearGradient(x0,y0,x1,y1)](https://www.w3schools.com/tags/canvas_createlineargradient.asp)+createLinearGradient :: (Double, Double, Double, Double) -> Canvas Gradient+createLinearGradient = call "createLinearGradient"+-----------------------------------------------------------------------------+-- | [ctx.createPattern(image, "repeat")](https://www.w3schools.com/tags/canvas_createpattern.asp)+createPattern :: (Image, PatternType) -> Canvas Pattern+createPattern = call "createPattern"+-----------------------------------------------------------------------------+-- | [ctx.createRadialGradient(x0,y0,r0,x1,y1,r1)](https://www.w3schools.com/tags/canvas_createradialgradient.asp)+createRadialGradient :: (Double,Double,Double,Double,Double,Double) -> Canvas Gradient+createRadialGradient = call "createRadialGradient"+-----------------------------------------------------------------------------+-- | [ctx.fillStyle = "red"](https://www.w3schools.com/tags/canvas_fillstyle.asp)+fillStyle :: StyleArg -> Canvas ()+fillStyle = set "fillStyle"+-----------------------------------------------------------------------------+-- | [ctx.lineCap = "butt"](https://www.w3schools.com/tags/canvas_lineCap.asp)+lineCap :: LineCapType -> Canvas ()+lineCap = set "lineCap"+-----------------------------------------------------------------------------+-- | [ctx.lineJoin = "bevel"](https://www.w3schools.com/tags/canvas_lineJoin.asp)+lineJoin :: LineJoinType -> Canvas ()+lineJoin = set "lineJoin"+-----------------------------------------------------------------------------+-- | [ctx.lineWidth = 10](https://www.w3schools.com/tags/canvas_lineWidth.asp)+lineWidth :: Double -> Canvas ()+lineWidth = set "lineWidth"+-----------------------------------------------------------------------------+-- | [ctx.miterLimit = 10](https://www.w3schools.com/tags/canvas_miterLimit.asp)+miterLimit :: Double -> Canvas ()+miterLimit = set "miterLimit"+-----------------------------------------------------------------------------+-- | [ctx.shadowBlur = 10](https://www.w3schools.com/tags/canvas_shadowBlur.asp)+shadowBlur :: Double -> Canvas ()+shadowBlur = set "shadowBlur"+-----------------------------------------------------------------------------+-- | [ctx.shadowColor = "red"](https://www.w3schools.com/tags/canvas_shadowColor.asp)+shadowColor :: Color -> Canvas ()+shadowColor = set "shadowColor"+-----------------------------------------------------------------------------+-- | [ctx.shadowOffsetX = 20](https://www.w3schools.com/tags/canvas_shadowOffsetX.asp)+shadowOffsetX :: Double -> Canvas ()+shadowOffsetX = set "shadowOffsetX"+-----------------------------------------------------------------------------+-- | [ctx.shadowOffsetY = 20](https://www.w3schools.com/tags/canvas_shadowOffsetY.asp)+shadowOffsetY :: Double -> Canvas ()+shadowOffsetY = set "shadowOffsetY"+-----------------------------------------------------------------------------+-- | [ctx.strokeStyle = "red"](https://www.w3schools.com/tags/canvas_strokeStyle.asp)+strokeStyle :: StyleArg -> Canvas ()+strokeStyle = set "strokeStyle"+-----------------------------------------------------------------------------+-- | [ctx.scale(width,height)](https://www.w3schools.com/tags/canvas_scale.asp)+scale :: (Double, Double) -> Canvas ()+scale = call "scale"+-----------------------------------------------------------------------------+-- | [ctx.rotate(angle)](https://www.w3schools.com/tags/canvas_rotate.asp)+rotate :: Double -> Canvas ()+rotate = call "rotate"+-----------------------------------------------------------------------------+-- | [ctx.translate(angle)](https://www.w3schools.com/tags/canvas_translate.asp)+translate :: Coord -> Canvas ()+translate = call "translate"+-----------------------------------------------------------------------------+-- | [ctx.transform(a,b,c,d,e,f)](https://www.w3schools.com/tags/canvas_transform.asp)+transform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()+transform = call "transform"+-----------------------------------------------------------------------------+-- | [ctx.setTransform(a,b,c,d,e,f)](https://www.w3schools.com/tags/canvas_setTransform.asp)+setTransform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()+setTransform = call "setTransform"+----------------------------------------------------------------------------+-- | [ctx.drawImage(image,x,y)](https://www.w3schools.com/tags/canvas_drawImage.asp)+drawImage :: (Image, Double, Double) -> Canvas ()+drawImage = call "drawImage"+-----------------------------------------------------------------------------+-- | [ctx.drawImage(image,x,y)](https://www.w3schools.com/tags/canvas_drawImage.asp)+drawImage' :: (Image, Double, Double, Double, Double) -> Canvas ()+drawImage' = call "drawImage"+-----------------------------------------------------------------------------+-- | [ctx.createImageData(width,height)](https://www.w3schools.com/tags/canvas_createImageData.asp)+createImageData :: (Double, Double) -> Canvas ImageData+createImageData = call "createImageData"+-----------------------------------------------------------------------------+-- | [ctx.getImageData(w,x,y,z)](https://www.w3schools.com/tags/canvas_getImageData.asp)+getImageData :: (Double, Double, Double, Double) -> Canvas ImageData+getImageData = call "getImageData"+-----------------------------------------------------------------------------+-- | [imageData.data\[index\] = 255](https://www.w3schools.com/tags/canvas_imagedata_data.asp)+setImageData :: (ImageData, Int, Double) -> Canvas ()+setImageData (imgData, index, value) = liftIO $ do+   o <- imgData ! ("data" :: MisoString)+   (o <## index) value+-----------------------------------------------------------------------------+-- | [imageData.height](https://www.w3schools.com/tags/canvas_imagedata_height.asp)+height :: ImageData -> Canvas Double+height (ImageData imgData) = liftIO $ do+  fromJSValUnchecked =<< imgData ! ("height" :: MisoString)+-----------------------------------------------------------------------------+-- | [imageData.width](https://www.w3schools.com/tags/canvas_imagedata_width.asp)+width :: ImageData -> Canvas Double+width (ImageData imgData) = liftIO $+  fromJSValUnchecked =<< imgData ! ("width" :: MisoString)+-----------------------------------------------------------------------------+-- | [ctx.putImageData(imageData,x,y)](https://www.w3schools.com/tags/canvas_putImageData.asp)+putImageData :: (ImageData, Double, Double) -> Canvas ()+putImageData = call "putImageData"+-----------------------------------------------------------------------------+-- | [ctx.globalAlpha = 0.2](https://www.w3schools.com/tags/canvas_globalAlpha.asp)+globalAlpha :: Double -> Canvas ()+globalAlpha = set "globalAlpha"+-----------------------------------------------------------------------------+-- | [ctx.clip()](https://www.w3schools.com/tags/canvas_clip.asp)+clip :: () -> Canvas ()+clip = call "clip"+-----------------------------------------------------------------------------+-- | [ctx.save()](https://www.w3schools.com/tags/canvas_save.asp)+save :: () -> Canvas ()+save = call "save"+-----------------------------------------------------------------------------+-- | [ctx.restore()](https://www.w3schools.com/tags/canvas_restore.asp)+restore :: () -> Canvas ()+restore = call "restore"+-----------------------------------------------------------------------------
src/Miso/Concurrent.hs view
@@ -1,40 +1,82 @@+----------------------------------------------------------------------------- {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module      :  Miso.Concurrent--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- Stability   :  experimental -- Portability :  non-portable------------------------------------------------------------------------------module Miso.Concurrent (-    Notify (..)-  , newNotify-  , newEmptyNotify+--+-- = 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 (..)+  , waiter+  , oneshot   ) where-+----------------------------------------------------------------------------- import Control.Concurrent---- | Concurrent API for `SkipChan` implementation-data Notify = Notify {-    wait :: IO ()+-----------------------------------------------------------------------------+-- | Synchronization primitive for event loop+data Waiter+  = Waiter+  { wait :: IO ()+    -- ^ Blocks on MVar   , notify :: IO ()+    -- ^ Unblocks threads waiting on MVar   }---- | Create a new `Notify`-newNotify :: IO Notify-newNotify = do-  mvar <- newMVar ()-  pure $ Notify-   (takeMVar mvar)-   (() <$ do tryPutMVar mvar $! ())---- | Create a new `Notify`-newEmptyNotify :: IO Notify-newEmptyNotify = do+-----------------------------------------------------------------------------+-- | Creates a new @Waiter@+--+-- Useful for multiple threads to wake-up / notify a single thread running in an+-- infinite loop, waiting for work (e.g. to process an event queue).+--+waiter :: IO Waiter+waiter = do   mvar <- newEmptyMVar-  pure $ Notify-   (takeMVar mvar)-   (() <$ do tryPutMVar mvar $! ())-+  pure Waiter+    { wait = takeMVar mvar+    , notify = do+        _ <- tryPutMVar mvar ()+        pure ()+    }+-----------------------------------------------------------------------------+-- | Creates a new @Waiter@+--+-- Useful for a single thread to wake-up multiple threads that are waiting +-- to run a oneshot task (e.g. like forking a thread).+--+oneshot :: IO Waiter+oneshot = do+  mvar <- newEmptyMVar+  pure Waiter+    { wait = readMVar mvar+    , notify = putMVar mvar ()+    }+-----------------------------------------------------------------------------
+ src/Miso/DSL.hs view
@@ -0,0 +1,897 @@+-----------------------------------------------------------------------------+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE DerivingStrategies   #-}+{-# LANGUAGE DefaultSignatures    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE KindSignatures       #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE LambdaCase           #-}+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE CPP                  #-}+#if __GLASGOW_HASKELL__ <= 865+{-# LANGUAGE UndecidableInstances #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.DSL+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = 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+    ToJSVal (..)+  , GToJSVal (..)+  , FromJSVal (..)+  , GFromJSVal (..)+  , ToArgs (..)+  , ToObject (..)+    -- * Types+  , JSVal+  , Object (..)+  , Function (..)+    -- * Utils+  , jsg+  , jsg0+  , jsg1+  , jsg2+  , jsg3+  , jsg4+  , jsg5+  , jsgf+  , global+  , (#)+  , setField+  , (<##)+  , (!)+  , listProps+  , call+  , new+  , create+  , createWith+  , setProp+  , getProp+  , eval+  , requestAnimationFrame+  , cancelAnimationFrame+  , freeFunction+  , (!!)+  , isUndefined+  , isNull+  , jsNull+  , syncCallback+  , syncCallback1+  , syncCallback2+  , syncCallback3+  , syncCallback'+  , syncCallback1'+  , syncCallback2'+  , syncCallback3'+  , asyncCallback+  , asyncCallback1+  , asyncCallback2+  , asyncCallback3+  , apply+  ) where+-----------------------------------------------------------------------------+import           Control.Applicative+#ifndef VANILLA+import           Data.Text (Text)+#endif+import           Control.Monad+import           Control.Monad.Trans.Maybe+import qualified Data.Map.Strict as M+import           Data.Map.Strict (Map)+import           GHC.Generics+import           GHC.TypeLits+import           Data.Kind+import           Prelude hiding ((!!))+-----------------------------------------------------------------------------+import           Miso.DSL.FFI+import           Miso.JSON (Value, fromJSVal_Value, toJSVal_Value)+import           Miso.String+-----------------------------------------------------------------------------+-- | A class for marshaling Haskell values into JS+class ToJSVal a where+  toJSVal :: a -> IO JSVal+  default toJSVal :: (Generic a, GToJSVal (Rep a)) => a -> IO JSVal+  toJSVal x = do+    o <- create+    gToJSVal (from x) o+    toJSVal o+-----------------------------------------------------------------------------+class GToJSVal (f :: Type -> Type) where+  gToJSVal :: f a -> Object -> IO ()+-----------------------------------------------------------------------------+instance GToJSVal a => GToJSVal (D1 i a) where+  gToJSVal (M1 x) = gToJSVal x+  {-# INLINE gToJSVal #-}+-----------------------------------------------------------------------------+instance GToJSVal a => GToJSVal (C1 i a) where+  gToJSVal (M1 x) = gToJSVal x+  {-# INLINE gToJSVal #-}+-----------------------------------------------------------------------------+instance (GToJSVal a, GToJSVal b) => GToJSVal (a :*: b) where+  gToJSVal (x :*: y) o = gToJSVal x o >> gToJSVal y o+  {-# INLINE gToJSVal #-}+-----------------------------------------------------------------------------+instance (TypeError ('Text "Sum types unsupported"), GToJSVal a, GToJSVal b) => GToJSVal (a :+: b) where+  gToJSVal = \case+    L1 x -> gToJSVal x+    R1 x -> gToJSVal x+  {-# INLINE gToJSVal #-}+-----------------------------------------------------------------------------+instance (ToJSVal a, Selector s) => GToJSVal (S1 s (K1 i a)) where+  gToJSVal (M1 (K1 x)) o =+    setField o fieldName =<< toJSVal x+      where+        fieldName = ms $ selName (undefined :: S1 s (K1 i a) ())+  {-# INLINE gToJSVal #-}+-----------------------------------------------------------------------------+instance GToJSVal U1 where+  gToJSVal U1 _ = pure ()+  {-# INLINE gToJSVal #-}+-----------------------------------------------------------------------------+instance GToJSVal V1 where+  gToJSVal _ _ = pure ()+  {-# INLINE gToJSVal #-}+-----------------------------------------------------------------------------+instance ToJSVal Bool where+  toJSVal = toJSVal_Bool+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance ToJSVal Double where+  toJSVal = toJSVal_Double+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance ToJSVal Float where+  toJSVal = toJSVal_Float+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance ToJSVal a => ToJSVal (IO a) where+  toJSVal action = toJSVal =<< action+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance ToJSVal () where+  toJSVal () = pure jsNull+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance ToJSVal Char where+  toJSVal = toJSVal_Char+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance ToJSVal Int where+  toJSVal = toJSVal_Int+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance ToJSVal a => ToJSVal (Map MisoString a) where+  toJSVal map_ = do+    o <- create+    forM_ (M.toList map_) $ \(k,v) ->+      setField o k =<< toJSVal v+    toJSVal o+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance FromJSVal a => FromJSVal (Map MisoString a) where+  fromJSVal o = pure <$> do foldM populate M.empty =<< listProps (Object o)+    where+      populate m k = do+        v <- fromJSValUnchecked =<< getProp k (Object o)+        pure (M.insert k v m)+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+instance ToJSVal a => ToObject (Map MisoString a) where+  toObject x = Object <$> toJSVal x+  {-# INLINE toObject #-}+-----------------------------------------------------------------------------+instance ToJSVal a => ToJSVal (Maybe a) where+  toJSVal = \case+    Nothing -> pure jsNull+    Just x -> toJSVal x+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance {-# OVERLAPPABLE #-} FromJSVal a => FromJSVal [a] where+  fromJSVal jsval_ = do+    fromJSVal_List jsval_ >>= \case+      Nothing -> pure Nothing+      Just xs -> sequence <$> mapM fromJSVal xs+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+instance FromJSVal [Char] where+  fromJSVal jsval_ = fmap unpack <$> fromJSVal jsval_+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+instance ToJSVal [Char] where+  toJSVal = toJSVal . toMisoString+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance {-# OVERLAPPABLE #-} ToJSVal a => ToJSVal [a] where+  toJSVal = toJSVal_List <=< mapM toJSVal+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance ToJSVal JSVal where+  toJSVal = pure+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance FromJSVal Value where+  fromJSVal = fromJSVal_Value+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+-- | A class for marshaling JS values into Haskell+class FromJSVal a where+  fromJSVal :: JSVal -> IO (Maybe a)+  default fromJSVal :: (Generic a, GFromJSVal (Rep a)) => JSVal -> IO (Maybe a)+  fromJSVal x = fmap to <$> gFromJSVal (Object x)+  fromJSValUnchecked :: JSVal -> IO a+  fromJSValUnchecked x = do+    fromJSVal x >>= \case+      Nothing -> error "fromJSValUnchecked: failure"+      Just y -> pure y+-----------------------------------------------------------------------------+class GFromJSVal (f :: Type -> Type) where+  gFromJSVal :: Object -> IO (Maybe (f a))+-----------------------------------------------------------------------------+instance GFromJSVal a => GFromJSVal (D1 i a) where+  gFromJSVal o = fmap M1 <$> gFromJSVal o+  {-# INLINE gFromJSVal #-}+-----------------------------------------------------------------------------+instance GFromJSVal a => GFromJSVal (C1 i a) where+  gFromJSVal o = fmap M1 <$> gFromJSVal o+  {-# INLINE gFromJSVal #-}+-----------------------------------------------------------------------------+instance GFromJSVal U1 where+  gFromJSVal _ = pure (Just U1)+  {-# INLINE gFromJSVal #-}+-----------------------------------------------------------------------------+instance GFromJSVal V1 where+  gFromJSVal _ = pure Nothing+  {-# INLINE gFromJSVal #-}+-----------------------------------------------------------------------------+instance (GFromJSVal a, GFromJSVal b) => GFromJSVal (a :*: b) where+  gFromJSVal o = runMaybeT $ (:*:) <$> MaybeT (gFromJSVal o) <*> MaybeT (gFromJSVal o)+  {-# INLINE gFromJSVal #-}+-----------------------------------------------------------------------------+instance (TypeError ('Text "Sum types unsupported"), GFromJSVal a, GFromJSVal b) => GFromJSVal (a :+: b) where+  gFromJSVal o = do+    x <- fmap L1 <$> gFromJSVal o+    case x of+      Nothing -> fmap R1 <$> gFromJSVal o+      Just y -> pure (Just y)+  {-# INLINE gFromJSVal #-}+-----------------------------------------------------------------------------+instance (FromJSVal a, Selector s) => GFromJSVal (S1 s (K1 i a)) where+  gFromJSVal o = fmap (M1 . K1) <$> do fromJSVal =<< getProp (ms name) o+    where+      name = selName (undefined :: S1 s (K1 i a) ())+  {-# INLINE gFromJSVal #-}+-----------------------------------------------------------------------------+instance FromJSVal Int where+  fromJSVal = fromJSVal_Int+  fromJSValUnchecked = fromJSValUnchecked_Int+  {-# INLINE fromJSVal #-}+  {-# INLINE fromJSValUnchecked #-}+-----------------------------------------------------------------------------+instance FromJSVal Char where+  fromJSVal = fromJSVal_Char+  fromJSValUnchecked = fromJSValUnchecked_Char+  {-# INLINE fromJSVal #-}+  {-# INLINE fromJSValUnchecked #-}+-----------------------------------------------------------------------------+instance FromJSVal Float where+  fromJSVal = fromJSVal_Float+  fromJSValUnchecked = fromJSValUnchecked_Float+  {-# INLINE fromJSVal #-}+  {-# INLINE fromJSValUnchecked #-}+-----------------------------------------------------------------------------+instance FromJSVal Double where+  fromJSVal = fromJSVal_Double+  fromJSValUnchecked = fromJSValUnchecked_Double+  {-# INLINE fromJSVal #-}+  {-# INLINE fromJSValUnchecked #-}+-----------------------------------------------------------------------------+instance FromJSVal Text where+  fromJSVal = fromJSVal_Text+  fromJSValUnchecked = fromJSValUnchecked_Text+  {-# INLINE fromJSVal #-}+  {-# INLINE fromJSValUnchecked #-}+-----------------------------------------------------------------------------+instance ToObject Object where+  toObject = pure+  {-# INLINE toObject #-}+-----------------------------------------------------------------------------+instance ToJSVal Value where+  toJSVal = toJSVal_Value+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance ToJSVal Text where+  toJSVal = toJSVal_Text+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance FromJSVal () where+  fromJSVal _ = pure (Just ())+    -- if isUndefined_ffi x || isNull_ffi x+    --   then pure (Just ())+    --   else pure Nothing+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+instance (ToJSVal a, ToJSVal b) => ToJSVal (a,b) where+  toJSVal (y,z) = do+    y_ <- toJSVal y+    z_ <- toJSVal z+    toJSVal_List [ y_, z_ ]+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance (ToJSVal a, ToJSVal b, ToJSVal c) => ToJSVal (a,b,c) where+  toJSVal (x,y,z) = do+    x_ <- toJSVal x+    y_ <- toJSVal y+    z_ <- toJSVal z+    toJSVal_List [ x_, y_, z_ ]+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d) => ToJSVal (a,b,c,d) where+  toJSVal (w,x,y,z) = do+    w_ <- toJSVal w+    x_ <- toJSVal x+    y_ <- toJSVal y+    z_ <- toJSVal z+    toJSVal_List [ w_, x_, y_, z_ ]+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d, ToJSVal e) => ToJSVal (a,b,c,d,e) where+  toJSVal (v,w,x,y,z) = do+    v_ <- toJSVal v+    w_ <- toJSVal w+    x_ <- toJSVal x+    y_ <- toJSVal y+    z_ <- toJSVal z+    toJSVal_List [ v_, w_, x_, y_, z_ ]+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d, ToJSVal e, ToJSVal f) => ToJSVal (a,b,c,d,e,f) where+  toJSVal (u,v,w,x,y,z) = do+    u_ <- toJSVal u+    v_ <- toJSVal v+    w_ <- toJSVal w+    x_ <- toJSVal x+    y_ <- toJSVal y+    z_ <- toJSVal z+    toJSVal_List [ u_, v_, w_, x_, y_, z_ ]+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+-- | Retrieves a field from globalThis+jsg :: MisoString -> IO JSVal+jsg key = global ! key+{-# INLINABLE jsg #-}+-----------------------------------------------------------------------------+-- | Invokes a function with a specified argument list+jsgf+  :: ToArgs args+  => MisoString+  -- ^ Global function name on @globalThis@+  -> args+  -- ^ Arguments to pass to the function+  -> IO JSVal+jsgf name = global # name+{-# INLINABLE jsgf #-}+-----------------------------------------------------------------------------+-- | Invokes a function with no argument+jsg0 :: MisoString -> IO JSVal+jsg0 name = jsgf name ([] :: [JSVal])+{-# INLINABLE jsg0 #-}+-----------------------------------------------------------------------------+-- | Invokes a function with 1 argument+jsg1 :: ToJSVal arg => MisoString -> arg -> IO JSVal+jsg1 name arg = jsgf name [arg]+{-# INLINABLE jsg1 #-}+-----------------------------------------------------------------------------+-- | Invokes a function with 2 arguments+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+  jsgf name [arg1_, arg2_]+{-# INLINABLE jsg2 #-}+-----------------------------------------------------------------------------+-- | Invokes a function with 3 arguments+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+  arg3_ <- toJSVal arg3+  jsgf name [arg1_, arg2_, arg3_]+{-# INLINABLE jsg3 #-}+-----------------------------------------------------------------------------+-- | Invokes a function with 4 arguments+jsg4 :: (ToJSVal arg1, ToJSVal arg2, ToJSVal arg3, ToJSVal arg4)+     => MisoString+     -> arg1+     -> arg2+     -> arg3+     -> arg4+     -> IO JSVal+jsg4 name arg1 arg2 arg3 arg4 = do+  arg1_ <- toJSVal arg1+  arg2_ <- toJSVal arg2+  arg3_ <- toJSVal arg3+  arg4_ <- toJSVal arg4+  jsgf name [arg1_, arg2_, arg3_, arg4_]+{-# INLINABLE jsg4 #-}+-----------------------------------------------------------------------------+-- | Invokes a function with 5 arguments+jsg5 :: (ToJSVal arg1, ToJSVal arg2, ToJSVal arg3, ToJSVal arg4, ToJSVal arg5)+     => MisoString+     -> arg1+     -> arg2+     -> arg3+     -> arg4+     -> arg5+     -> IO JSVal+jsg5 name arg1 arg2 arg3 arg4 arg5 = do+  arg1_ <- toJSVal arg1+  arg2_ <- toJSVal arg2+  arg3_ <- toJSVal arg3+  arg4_ <- toJSVal arg4+  arg5_ <- toJSVal arg5+  jsgf name [arg1_, arg2_, arg3_, arg4_, arg5_]+{-# INLINABLE jsg5 #-}+-----------------------------------------------------------------------------+-- | Sets a field on an Object at a specified field+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+  setProp_ffi k v' o'+{-# INLINABLE setField #-}+-----------------------------------------------------------------------------+-- | Sets a field on an Object at a specified index+infixr 1 <##+(<##) :: (ToObject o, ToJSVal v) => o -> Int -> v -> IO ()+(<##) o k v = do+  o' <- toJSVal =<< toObject o+  v' <- toJSVal v+  setPropIndex_ffi k v' o'+{-# INLINABLE (<##) #-}+-----------------------------------------------------------------------------+-- | Retrieves a property from an Object+(!) :: ToObject o => o -> MisoString -> IO JSVal+(!) = flip getProp+{-# INLINABLE (!) #-}+-----------------------------------------------------------------------------+-- | Lists the properties on a JS Object.+listProps :: Object -> IO [MisoString]+listProps (Object jsval) = do+  keys <- fromJSValUnchecked =<< listProps_ffi jsval+  forM keys fromJSValUnchecked+{-# INLINABLE listProps #-}+-----------------------------------------------------------------------------+-- | Calls a JS function on an t'Object' at a field with specified arguments.+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+  args' <- toJSVal =<< toArgs args+  invokeFunction o' this' args'+{-# INLINABLE call #-}+-----------------------------------------------------------------------------+-- | Calls a JS function on an t'Object' at a field with specified arguments.+infixr 2 #+(#) :: (ToObject object, ToArgs args) => object -> MisoString -> args -> IO JSVal+(#) o k args = do+  o' <- toJSVal =<< toObject o+  func <- getProp_ffi k o'+  args' <- toJSVal =<< toArgs args+  invokeFunction func o' args'+{-# INLINABLE (#) #-}+-----------------------------------------------------------------------------+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+    invokeFunction func o =<<+      toJSVal (toArgs args)+{-# INLINABLE apply #-}+-----------------------------------------------------------------------------+-- | Instantiates a new JS t'Object'.+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+  new_ffi obj argv+{-# INLINABLE new #-}+-----------------------------------------------------------------------------+-- | Creates a new JS t'Object'+create :: IO Object+create = Object <$> create_ffi+{-# INLINABLE create #-}+-----------------------------------------------------------------------------+-- | Creates a new JS t'Object' populated with key-value pairs specified+-- in the list. Meant for use with 'inline' JS functionality.+--+-- @+-- update = \case+--  Highlight domRef -> do+--    3 <- inline "hljs.highlight(domRef); return 3;" =<<+--      createWith [ "domRef" =: domRef ]+--    pure ()+-- @+--+createWith :: ToJSVal val => [(MisoString, val)] -> IO Object+createWith kvs = do+  o <- create+  forM_ kvs $ \(k,v) ->+    flip (setProp k) o =<< toJSVal v+  pure o+{-# INLINABLE createWith #-}+-----------------------------------------------------------------------------+-- | Sets a property on a JS t'Object'+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+  -- ^ Property name to read+  -> o+  -- ^ JavaScript object to read from+  -> IO JSVal+getProp k v = getProp_ffi k =<< toJSVal (toObject v)+{-# INLINABLE getProp #-}+-----------------------------------------------------------------------------+-- | Dynamically evaluates a JS string. See [eval](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/eval)+--+-- `eval()` is slower (not subject to JS engine optimizations) and also+-- has security vulnerabilities (can alter other local variables).+--+-- Consider using the more performant and secure (isolated) `inline` function.+--+eval :: MisoString -> IO JSVal+eval = eval_ffi+{-# INLINABLE eval #-}+-----------------------------------------------------------------------------+instance FromJSVal Bool where+  fromJSVal = fromJSVal_Bool+  fromJSValUnchecked = fromJSValUnchecked_Bool+  {-# INLINE fromJSVal #-}+  {-# INLINE fromJSValUnchecked #-}+-----------------------------------------------------------------------------+instance FromJSVal JSVal where+  fromJSVal = pure . Just+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+instance FromJSVal a => FromJSVal (Maybe a) where+  fromJSVal x = fromJSVal_Maybe x >>= \case+    Nothing -> pure Nothing+    Just Nothing -> pure (Just Nothing)+    Just (Just y) -> fmap Just <$> fromJSVal y+  fromJSValUnchecked x = fromJSValUnchecked_Maybe x >>= \case+    Nothing -> pure Nothing+    Just y -> Just <$> fromJSValUnchecked y+  {-# INLINE fromJSVal #-}+  {-# INLINE fromJSValUnchecked #-}+-----------------------------------------------------------------------------+-- | A class for creating arguments to a JS function+class ToArgs args where+  toArgs :: args -> IO [JSVal]+-----------------------------------------------------------------------------+instance ToArgs Double where+  toArgs x = (:[]) <$> toJSVal x+  {-# INLINE toArgs #-}+-----------------------------------------------------------------------------+instance ToArgs JSVal where+  toArgs val = pure [val]+  {-# INLINE toArgs #-}+-----------------------------------------------------------------------------+instance ToObject JSVal where+  toObject = pure . Object+  {-# INLINE toObject #-}+-----------------------------------------------------------------------------+-- | A class for creating JS objects.+class ToObject a where+  toObject :: a -> IO Object+  default toObject :: (Generic a, GToJSVal (Rep a)) => a -> IO Object+  toObject x = do+    o <- create+    gToJSVal (from x) o+    pure o+-----------------------------------------------------------------------------+instance ToJSVal a => ToObject (IO a) where+  toObject action = Object <$> (toJSVal =<< action)+  {-# INLINE toObject #-}+-----------------------------------------------------------------------------+instance ToArgs MisoString where+  toArgs arg = (:[]) <$> toJSVal arg+  {-# INLINE toArgs #-}+----------------------------------------------------------------------------+#ifndef VANILLA+----------------------------------------------------------------------------+instance ToJSVal MisoString where+  toJSVal = toJSVal_JSString+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+instance FromJSVal MisoString where+  fromJSVal = fromJSVal_JSString+  {-# INLINE fromJSVal #-}+----------------------------------------------------------------------------+#endif+----------------------------------------------------------------------------+instance ToJSVal arg => ToArgs [arg] where+    toArgs = mapM toJSVal+    {-# INLINE toArgs #-}+----------------------------------------------------------------------------+instance ToArgs () where+  toArgs _ = pure []+  {-# INLINE toArgs #-}+----------------------------------------------------------------------------+instance ToArgs Int where+  toArgs k = (:[]) <$> toJSVal k+  {-# INLINE toArgs #-}+-----------------------------------------------------------------------------+instance ToArgs Function where+  toArgs k = (:[]) <$> toJSVal k+  {-# INLINE toArgs #-}+-----------------------------------------------------------------------------+instance ToArgs Bool where+  toArgs k = (:[]) <$> toJSVal k+  {-# INLINE toArgs #-}+-----------------------------------------------------------------------------+instance ToArgs Object where+  toArgs k = (:[]) <$> toJSVal k+  {-# INLINE toArgs #-}+-----------------------------------------------------------------------------+instance ToArgs args => ToArgs (Maybe args) where+  toArgs (Just args) = toArgs args+  toArgs Nothing     = pure []+  {-# INLINE toArgs #-}+----------------------------------------------------------------------------+instance (ToJSVal arg1, ToJSVal arg2) => ToArgs (arg1, arg2) where+  toArgs (arg1, arg2) = do+    rarg1 <- toJSVal arg1+    rarg2 <- toJSVal arg2+    return [rarg1, rarg2]+  {-# INLINE toArgs #-}+----------------------------------------------------------------------------+instance (ToJSVal arg1, ToJSVal arg2, ToJSVal arg3) => ToArgs (arg1, arg2, arg3) where+  toArgs (arg1, arg2, arg3) = do+    rarg1 <- toJSVal arg1+    rarg2 <- toJSVal arg2+    rarg3 <- toJSVal arg3+    return [rarg1, rarg2, rarg3]+  {-# INLINE toArgs #-}+----------------------------------------------------------------------------+instance (ToJSVal arg1, ToJSVal arg2, ToJSVal arg3, ToJSVal arg4) => ToArgs (arg1, arg2, arg3, arg4) where+  toArgs (arg1, arg2, arg3, arg4) = do+    rarg1 <- toJSVal arg1+    rarg2 <- toJSVal arg2+    rarg3 <- toJSVal arg3+    rarg4 <- toJSVal arg4+    return [rarg1, rarg2, rarg3, rarg4]+  {-# INLINE toArgs #-}+----------------------------------------------------------------------------+instance (ToJSVal arg1, ToJSVal arg2, ToJSVal arg3, ToJSVal arg4, ToJSVal arg5) => ToArgs (arg1, arg2, arg3, arg4, arg5) where+  toArgs (arg1, arg2, arg3, arg4, arg5) = do+    rarg1 <- toJSVal arg1+    rarg2 <- toJSVal arg2+    rarg3 <- toJSVal arg3+    rarg4 <- toJSVal arg4+    rarg5 <- toJSVal arg5+    return [rarg1, rarg2, rarg3, rarg4, rarg5]+  {-# INLINE toArgs #-}+----------------------------------------------------------------------------+instance (ToJSVal arg1, ToJSVal arg2, ToJSVal arg3, ToJSVal arg4, ToJSVal arg5, ToJSVal arg6) => ToArgs (arg1, arg2, arg3, arg4, arg5, arg6) where+  toArgs (arg1, arg2, arg3, arg4, arg5, arg6) = do+    rarg1 <- toJSVal arg1+    rarg2 <- toJSVal arg2+    rarg3 <- toJSVal arg3+    rarg4 <- toJSVal arg4+    rarg5 <- toJSVal arg5+    rarg6 <- toJSVal arg6+    return [rarg1, rarg2, rarg3, rarg4, rarg5, rarg6]+  {-# INLINE toArgs #-}+----------------------------------------------------------------------------+-- | Frees references to a callback+freeFunction :: Function -> IO ()+freeFunction (Function x) = freeFunction_ffi x+{-# INLINABLE freeFunction #-}+-----------------------------------------------------------------------------+instance FromJSVal Function where+  fromJSVal = pure . Just . Function+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+instance FromJSVal Object where+  fromJSVal = pure . Just . Object+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+-- | Lookup a property based on its index+(!!) :: ToObject object => object -> Int -> IO JSVal+(!!) o k = getPropIndex_ffi k =<< toJSVal =<< toObject o+{-# INLINABLE (!!) #-}+-----------------------------------------------------------------------------+-- | Checks if a t'JSVal' is undefined+isUndefined :: ToJSVal val => val -> IO Bool+isUndefined val = isUndefined_ffi <$> toJSVal val+{-# INLINABLE isUndefined #-}+-----------------------------------------------------------------------------+-- | Checks if a t'JSVal' is null+isNull :: ToJSVal val => val -> IO Bool+isNull val = isNull_ffi <$> toJSVal val+{-# INLINABLE isNull #-}+-----------------------------------------------------------------------------+-- | A JS Object+newtype Object = Object { unObject :: JSVal } deriving newtype (ToJSVal, Eq)+-----------------------------------------------------------------------------+-- | A JS Functionn+newtype Function = Function { unFunction :: JSVal } deriving newtype (ToJSVal, Eq)+-----------------------------------------------------------------------------+instance (FromJSVal a, FromJSVal b) => FromJSVal (a,b) where+    fromJSVal r = runMaybeT $ (,) <$> jf r 0 <*> jf r 1+    {-# INLINE fromJSVal #-}+instance (FromJSVal a, FromJSVal b, FromJSVal c) => FromJSVal (a,b,c) where+    fromJSVal r = runMaybeT $ (,,) <$> jf r 0 <*> jf r 1 <*> jf r 2+    {-# INLINE fromJSVal #-}+instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d) => FromJSVal (a,b,c,d) where+    fromJSVal r = runMaybeT $ (,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3+    {-# INLINE fromJSVal #-}+instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d, FromJSVal e) => FromJSVal (a,b,c,d,e) where+    fromJSVal r = runMaybeT $ (,,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3 <*> jf r 4+    {-# INLINE fromJSVal #-}+instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d, FromJSVal e, FromJSVal f) => FromJSVal (a,b,c,d,e,f) where+    fromJSVal r = runMaybeT $ (,,,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3 <*> jf r 4 <*> jf r 5+    {-# INLINE fromJSVal #-}+instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d, FromJSVal e, FromJSVal f, FromJSVal g) => FromJSVal (a,b,c,d,e,f,g) where+    fromJSVal r = runMaybeT $ (,,,,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3 <*> jf r 4 <*> jf r 5 <*> jf r 6+    {-# INLINE fromJSVal #-}+instance (FromJSVal a, FromJSVal b, FromJSVal c, FromJSVal d, FromJSVal e, FromJSVal f, FromJSVal g, FromJSVal h) => FromJSVal (a,b,c,d,e,f,g,h) where+    fromJSVal r = runMaybeT $ (,,,,,,,) <$> jf r 0 <*> jf r 1 <*> jf r 2 <*> jf r 3 <*> jf r 4 <*> jf r 5 <*> jf r 6 <*> jf r 7+    {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+jf :: FromJSVal a => JSVal -> Int -> MaybeT IO a+{-# INLINE jf #-}+jf r n = MaybeT $ do+  x <- getPropIndex_ffi n r+  if isUndefined_ffi r+    then return Nothing+    else fromJSVal x+-----------------------------------------------------------------------------
+ src/Miso/Data/Array.hs view
@@ -0,0 +1,239 @@+-----------------------------------------------------------------------------+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Data.Array+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Data.Array" is a Haskell wrapper around the JavaScript+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Array Array>+-- object. Values of type @'Array' a@ live in JavaScript memory; all+-- operations run in 'IO' and mutate the underlying JS array in place.+--+-- 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 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+    Array+    -- * Construction+  , new+  , fromList+    -- * Deconstruction+  , toList+    -- * Operations+  , insert+  , push+  , member+  , size+  , splice+  , singleton+  , pop+  , shift+  , unshift+  , null+  , lookup+  , (!?)+  , reverse+  ) where+-----------------------------------------------------------------------------+import           Control.Monad (void, forM, forM_)+import           Prelude hiding (lookup, null, reverse)+-----------------------------------------------------------------------------+import           Miso.DSL (jsg, JSVal, ToObject, ToJSVal, FromJSVal, (!))+import qualified Miso.DSL as DSL+import           Miso.FFI (callFunction)+import           Miso.String (ms, unpack)+-----------------------------------------------------------------------------+newtype Array value = Array JSVal deriving (FromJSVal, ToJSVal, ToObject)+-----------------------------------------------------------------------------+-- | Constructs a new JS [Array](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Array) in t'IO'.+--+new :: IO (Array value)+new = Array <$> DSL.new (jsg "Array") ([] :: [JSVal])+-----------------------------------------------------------------------------+-- | Inserts a value into the t'Array' by value.+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+  pure ()+-----------------------------------------------------------------------------+-- | 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+  -- ^ 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 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 ->+      error ("(!?) index out of bounds: " <> unpack (ms key))+    Just value ->+      pure value+-----------------------------------------------------------------------------+-- | Return the size of t'Array'.+size :: Array value -> IO Int+size (Array m) = DSL.fromJSValUnchecked =<< m ! "length"+-----------------------------------------------------------------------------+-- | Return the null of t'Array'.+null :: Array value -> IO Bool+null m = (== 0) <$> size m+-----------------------------------------------------------------------------+-- | Checks existence of 'value' in t'Array', returns t'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+  -- ^ 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 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) ->+    insert k v m+  pure m+-----------------------------------------------------------------------------+-- | Converts an t'Array' to a list.+toList :: FromJSVal value => Array value -> IO [value]+toList m = do+  len <- subtract 1 <$> size m+  forM [0..len] (!? m)+-----------------------------------------------------------------------------+-- | Creates a new Array with a single element.+--+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.+--+-- Returns 'Nothing' if the t'Array' is empty.+--+pop :: FromJSVal a => Array a -> IO (Maybe a)+pop (Array arr) = DSL.fromJSValUnchecked =<< callFunction arr "pop" ([] :: [JSVal])+-----------------------------------------------------------------------------+-- | Removes the first element from an array and returns it.+--+shift :: FromJSVal a => Array a -> IO (Maybe a)+shift (Array arr) = DSL.fromJSValUnchecked =<< callFunction arr "shift" ([] :: [JSVal])+-----------------------------------------------------------------------------+-- | Adds one or more elements to the beginning of an array.+--+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.+--+reverse :: Array a -> IO ()+reverse (Array arr) = void $ callFunction arr "reverse" ([] :: [JSVal])+-----------------------------------------------------------------------------
+ src/Miso/Data/Map.hs view
@@ -0,0 +1,153 @@+-----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Data.Map+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Data.Map" is a Haskell wrapper around the JavaScript+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Map Map>+-- object. Values of type @'Map' k v@ live in JavaScript memory; all+-- operations run in 'IO' and mutate the underlying JS map in place.+--+-- 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.+--+-- 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+    Map+    -- * Construction+  , new+  , fromList+    -- * Operations+  , insert+  , lookup+  , clear+  , size+  , has+  , delete+  ) where+-----------------------------------------------------------------------------+import           Control.Monad (void, forM_)+import           Prelude hiding (lookup)+-----------------------------------------------------------------------------+import           Miso.DSL (jsg, JSVal, ToJSVal, FromJSVal, (!))+import qualified Miso.DSL as DSL+import           Miso.FFI (callFunction)+-----------------------------------------------------------------------------+newtype Map key value = Map JSVal deriving (FromJSVal, ToJSVal)+-----------------------------------------------------------------------------+-- | Constructs a new JS [Map](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Map) in t'IO'.+--+new :: IO (Map key value)+new = Map <$> DSL.new (jsg "Map") ([] :: [JSVal])+-----------------------------------------------------------------------------+-- | Inserts a value into the t'Map' by key.+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+  -- ^ 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'.+clear :: Map key value -> IO ()+clear (Map m) = void (callFunction m "clear" ())+-----------------------------------------------------------------------------+-- | Return the size of t'Map'.+size :: Map key value -> IO Int+size (Map m) = DSL.fromJSValUnchecked =<< m ! "size"+-----------------------------------------------------------------------------+-- | Checks existence of a value by 'key', returns t'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 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)]+  -- ^ Key-value pairs to populate the new map with+  -> IO (Map key value)+fromList xs = do+  m <- new+  forM_ xs $ \(k,v) ->+    insert k v m+  pure m+-----------------------------------------------------------------------------
+ src/Miso/Data/Set.hs view
@@ -0,0 +1,200 @@+-----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Data.Set+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Data.Set" is a Haskell wrapper around the JavaScript+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Set Set>+-- object. Values of type @'Set' a@ live in JavaScript memory; all+-- operations run in 'IO' and mutate the underlying JS set in place.+--+-- 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+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Equality_comparisons_and_sameness SameValueZero>+-- algorithm.+--+-- 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+    Set+    -- * Construction+  , new+  , fromList+    -- * Operations+  , insert+  , member+  , clear+  , size+  , delete+  , union+  , intersection+  , difference+  , isSubset+  , isSuperset+  , isDisjoint+  ) where+-----------------------------------------------------------------------------+import           Control.Monad (void, forM_)+import           Prelude hiding (lookup)+-----------------------------------------------------------------------------+import           Miso.DSL (jsg, JSVal, ToJSVal, FromJSVal, (!))+import qualified Miso.DSL as DSL+import           Miso.FFI (callFunction)+-----------------------------------------------------------------------------+newtype Set key = Set JSVal deriving (FromJSVal, ToJSVal)+-----------------------------------------------------------------------------+-- | Constructs a new JS [Set](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Set) in t'IO'.+--+new :: IO (Set key)+new = Set <$> DSL.new (jsg "Set") ([] :: [JSVal])+-----------------------------------------------------------------------------+-- | 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 ()+-----------------------------------------------------------------------------+-- | Empties the t'Set'.+clear :: Set key -> IO ()+clear (Set m) = void (callFunction m "clear" ())+-----------------------------------------------------------------------------+-- | Return the size of t'Set'.+size :: Set key -> IO Int+size (Set m) = DSL.fromJSValUnchecked =<< m ! "size"+-----------------------------------------------------------------------------+-- | Checks existence of 'key' in t'Set', returns t'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 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 elements.+fromList+  :: ToJSVal key+  => [key]+  -- ^ Elements to populate the new set with+  -> IO (Set key)+fromList xs = do+  m <- new+  forM_ xs $ \k ->+    insert k m+  pure m+-----------------------------------------------------------------------------+-- | The union of two t'Set'+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 -- ^ 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 -- ^ 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 -- ^ 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 -- ^ 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 -- ^ 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]+-----------------------------------------------------------------------------
+ src/Miso/Date.hs view
@@ -0,0 +1,524 @@+-----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Date+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Date" is a Haskell wrapper around the JavaScript+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date Date>+-- 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.+--+-- Import qualified to avoid clashing with 'Prelude':+--+-- @+-- 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+    Date+    -- * Construction+  , new+    -- * Conversion+  , toDateString+  , toISOString+  , toJSON+  , toLocaleDateString+  , toLocaleString+  , toLocaleTimeString+  , toString+  , toTimeString+  , toUTCString+  , valueOf+    -- * Getters+  , getDate+  , getDay+  , getFullYear+  , getHours+  , getMilliseconds+  , getMinutes+  , getMonth+  , getSeconds+  , getTime+  , getTimezoneOffset+  , getUTCDate+  , getUTCDay+  , getUTCFullYear+  , getUTCHours+  , getUTCMilliseconds+  , getUTCMinutes+  , getUTCMonth+  , getUTCSeconds+    -- * Setters+  , setDate+  , setFullYear+  , setHours+  , setMilliseconds+  , setMinutes+  , setMonth+  , setSeconds+  , setTime+  , setUTCDate+  , setUTCFullYear+  , setUTCHours+  , setUTCMilliseconds+  , setUTCMinutes+  , setUTCMonth+  , setUTCSeconds+  ) where+-----------------------------------------------------------------------------+import           Data.Maybe (catMaybes)+-----------------------------------------------------------------------------+import           Miso.DSL (jsg, JSVal, ToJSVal, FromJSVal, ToObject)+import qualified Miso.DSL as DSL+import           Miso.FFI (callFunction)+import           Miso.String (MisoString)+-----------------------------------------------------------------------------+newtype Date = Date JSVal deriving (FromJSVal, ToJSVal, ToObject, Eq)+-----------------------------------------------------------------------------+-- | Constructs a new JS [Date](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date) in t'IO'.+--+new :: IO Date+new = Date <$> DSL.new (jsg "Date") ([] :: [JSVal])+-----------------------------------------------------------------------------+call0 :: FromJSVal a => Date -> MisoString -> IO a+call0 (Date d) name = DSL.fromJSValUnchecked =<< callFunction d name ([] :: [JSVal])+-----------------------------------------------------------------------------+callArgs :: FromJSVal a => Date -> MisoString -> [JSVal] -> IO a+callArgs (Date d) name args = DSL.fromJSValUnchecked =<< callFunction d name args+-----------------------------------------------------------------------------+-- | Returns a human-readable date string.+--+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/toDateString>+--+toDateString :: Date -> IO MisoString+toDateString date = call0 date "toDateString"+-----------------------------------------------------------------------------+-- | Returns an ISO 8601 string.+--+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/toISOString>+--+toISOString :: Date -> IO MisoString+toISOString date = call0 date "toISOString"+-----------------------------------------------------------------------------+-- | Returns the JSON representation of the date.+--+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/toJSON>+--+toJSON :: Date -> IO MisoString+toJSON date = call0 date "toJSON"+-----------------------------------------------------------------------------+-- | Returns a locale-sensitive date string.+--+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/toLocaleDateString>+--+toLocaleDateString :: Date -> IO MisoString+toLocaleDateString date = call0 date "toLocaleDateString"+-----------------------------------------------------------------------------+-- | Returns a locale-sensitive date and time string.+--+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/toLocaleString>+--+toLocaleString :: Date -> IO MisoString+toLocaleString date = call0 date "toLocaleString"+-----------------------------------------------------------------------------+-- | Returns a locale-sensitive time string.+--+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/toLocaleTimeString>+--+toLocaleTimeString :: Date -> IO MisoString+toLocaleTimeString date = call0 date "toLocaleTimeString"+-----------------------------------------------------------------------------+-- | Returns the full date string.+--+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/toString>+--+toString :: Date -> IO MisoString+toString date = call0 date "toString"+-----------------------------------------------------------------------------+-- | Returns a time string.+--+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/toTimeString>+--+toTimeString :: Date -> IO MisoString+toTimeString date = call0 date "toTimeString"+-----------------------------------------------------------------------------+-- | Returns a UTC string.+--+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/toUTCString>+--+toUTCString :: Date -> IO MisoString+toUTCString date = call0 date "toUTCString"+-----------------------------------------------------------------------------+-- | Returns the primitive value (milliseconds since epoch).+--+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/valueOf>+--+valueOf :: Date -> IO Double+valueOf date = call0 date "valueOf"+-----------------------------------------------------------------------------+-- | Returns the day of the month.+--+getDate :: Date -> IO Int+getDate date = call0 date "getDate"+-----------------------------------------------------------------------------+-- | Returns the day of the week.+--+getDay :: Date -> IO Int+getDay date = call0 date "getDay"+-----------------------------------------------------------------------------+-- | Returns the full year.+--+getFullYear :: Date -> IO Int+getFullYear date = call0 date "getFullYear"+-----------------------------------------------------------------------------+-- | Returns the hour.+--+getHours :: Date -> IO Int+getHours date = call0 date "getHours"+-----------------------------------------------------------------------------+-- | Returns the milliseconds.+--+getMilliseconds :: Date -> IO Int+getMilliseconds date = call0 date "getMilliseconds"+-----------------------------------------------------------------------------+-- | Returns the minutes.+--+getMinutes :: Date -> IO Int+getMinutes date = call0 date "getMinutes"+-----------------------------------------------------------------------------+-- | Returns the month (0-11).+--+getMonth :: Date -> IO Int+getMonth date = call0 date "getMonth"+-----------------------------------------------------------------------------+-- | Returns the seconds.+--+getSeconds :: Date -> IO Int+getSeconds date = call0 date "getSeconds"+-----------------------------------------------------------------------------+-- | Returns milliseconds since epoch.+--+getTime :: Date -> IO Double+getTime date = call0 date "getTime"+-----------------------------------------------------------------------------+-- | Returns the time zone offset in minutes.+--+getTimezoneOffset :: Date -> IO Int+getTimezoneOffset date = call0 date "getTimezoneOffset"+-----------------------------------------------------------------------------+-- | Returns the UTC day of the month.+--+getUTCDate :: Date -> IO Int+getUTCDate date = call0 date "getUTCDate"+-----------------------------------------------------------------------------+-- | Returns the UTC day of the week.+--+getUTCDay :: Date -> IO Int+getUTCDay date = call0 date "getUTCDay"+-----------------------------------------------------------------------------+-- | Returns the UTC full year.+--+getUTCFullYear :: Date -> IO Int+getUTCFullYear date = call0 date "getUTCFullYear"+-----------------------------------------------------------------------------+-- | Returns the UTC hour.+--+getUTCHours :: Date -> IO Int+getUTCHours date = call0 date "getUTCHours"+-----------------------------------------------------------------------------+-- | Returns the UTC milliseconds.+--+getUTCMilliseconds :: Date -> IO Int+getUTCMilliseconds date = call0 date "getUTCMilliseconds"+-----------------------------------------------------------------------------+-- | Returns the UTC minutes.+--+getUTCMinutes :: Date -> IO Int+getUTCMinutes date = call0 date "getUTCMinutes"+-----------------------------------------------------------------------------+-- | Returns the UTC month (0-11).+--+getUTCMonth :: Date -> IO Int+getUTCMonth date = call0 date "getUTCMonth"+-----------------------------------------------------------------------------+-- | Returns the UTC seconds.+--+getUTCSeconds :: Date -> IO Int+getUTCSeconds date = call0 date "getUTCSeconds"+-----------------------------------------------------------------------------+-- | Sets the day of the month.+--+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+  -- ^ 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+  d' <- traverse DSL.toJSVal day+  callArgs (Date d) "setFullYear" (catMaybes [Just y, m, d'])+-----------------------------------------------------------------------------+-- | Sets the hour, with optional minutes, seconds, and milliseconds.+--+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+  s <- traverse DSL.toJSVal seconds+  ms <- traverse DSL.toJSVal millis+  callArgs (Date d) "setHours" (catMaybes [Just h, m, s, ms])+-----------------------------------------------------------------------------+-- | Sets the milliseconds.+--+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+  -- ^ 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+  ms <- traverse DSL.toJSVal millis+  callArgs (Date d) "setMinutes" (catMaybes [Just m, s, ms])+-----------------------------------------------------------------------------+-- | Sets the month, with optional day of the month.+--+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+  callArgs (Date d) "setMonth" (catMaybes [Just m, d'])+-----------------------------------------------------------------------------+-- | Sets the seconds, with optional milliseconds.+--+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+  callArgs (Date d) "setSeconds" (catMaybes [Just s, ms])+-----------------------------------------------------------------------------+-- | Sets the time in milliseconds since epoch.+--+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+  -- ^ 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+  -- ^ 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+  d' <- traverse DSL.toJSVal day+  callArgs (Date d) "setUTCFullYear" (catMaybes [Just y, m, d'])+-----------------------------------------------------------------------------+-- | Sets the UTC hour, with optional minutes, seconds, and milliseconds.+--+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+  s <- traverse DSL.toJSVal seconds+  ms <- traverse DSL.toJSVal millis+  callArgs (Date d) "setUTCHours" (catMaybes [Just h, m, s, ms])+-----------------------------------------------------------------------------+-- | Sets the UTC milliseconds.+--+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+  -- ^ 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+  ms <- traverse DSL.toJSVal millis+  callArgs (Date d) "setUTCMinutes" (catMaybes [Just m, s, ms])+-----------------------------------------------------------------------------+-- | Sets the UTC month, with optional day of the month.+--+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+  callArgs (Date d) "setUTCMonth" (catMaybes [Just m, d'])+-----------------------------------------------------------------------------+-- | Sets the UTC seconds, with optional milliseconds.+--+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+  callArgs (Date d) "setUTCSeconds" (catMaybes [Just s, ms])+-----------------------------------------------------------------------------
+ src/Miso/Delegate.hs view
@@ -0,0 +1,57 @@+-----------------------------------------------------------------------------+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Delegate+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Types and functions related to [event delegation](https://developer.mozilla.org/en-US/docs/Learn_web_development/Core/Scripting/Event_bubbling#event_delegation)+--+----------------------------------------------------------------------------+module Miso.Delegate+  ( delegator+  ) where+-----------------------------------------------------------------------------+import           Data.IORef (IORef, readIORef)+import qualified Data.Map.Strict as M+-----------------------------------------------------------------------------+import           Miso.DSL (create, JSVal, Object(..), ToJSVal(toJSVal))+import           Miso.Types (VTree(..), Events, Phase)+import           Miso.String (MisoString)+import qualified Miso.FFI.Internal as FFI+-----------------------------------------------------------------------------+-- | Local Event type, used to create field names for a delegated event+data Event+  = Event+  { name :: MisoString+  -- ^ Event name+  , capture :: Phase+  -- ^ Capture settings for event+  } deriving (Show, Eq)+-----------------------------------------------------------------------------+-- | Instance used to initialize event delegation+instance ToJSVal Event where+  toJSVal Event {..} = do+    o <- create+    flip (FFI.set "name") o =<< toJSVal name+    flip (FFI.set "capture") o =<< toJSVal capture+    toJSVal o+-----------------------------------------------------------------------------+-- | Entry point for event delegation+delegator+  :: JSVal+  -> IORef VTree+  -> Events+  -> Bool+  -> IO ()+delegator mountPointElement vtreeRef es debug = do+  evts <- toJSVal (uncurry Event <$> M.toList es)+  FFI.delegator mountPointElement evts debug $ do+    VTree (Object vtree) <- readIORef vtreeRef+    pure vtree+-----------------------------------------------------------------------------
+ src/Miso/Diff.hs view
@@ -0,0 +1,45 @@+-----------------------------------------------------------------------------+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Diff+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Functions and helpers for Virtual DOM diffing.+--+----------------------------------------------------------------------------+module Miso.Diff+  ( diff+  , mountElement+  ) where+-----------------------------------------------------------------------------+import qualified Miso.FFI.Internal as FFI+import           Miso.Types+import           Miso.DSL+-----------------------------------------------------------------------------+-- | diffing / patching a given element+diff :: Maybe VTree -> Maybe VTree -> JSVal -> IO ()+diff current new_ mountEl =+  case (current, new_) of+    (Nothing, Nothing) -> pure ()+    (Just (VTree current'), Just (VTree new')) -> do+      FFI.diff current' new' mountEl+      FFI.flush+    (Nothing, Just (VTree new')) -> do+      FFI.diff (Object jsNull) new' mountEl+      FFI.flush+    (Just (VTree current'), Nothing) -> do+      FFI.diff current' (Object jsNull) mountEl+      FFI.flush+-----------------------------------------------------------------------------+-- | return the configured mountPoint element or the body+mountElement :: MisoString -> IO JSVal+mountElement = \case+  "body" -> FFI.getBody+  e -> FFI.getElementById e+-----------------------------------------------------------------------------
+ src/Miso/Effect.hs view
@@ -0,0 +1,529 @@+-----------------------------------------------------------------------------+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -fno-warn-orphans       #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Effect+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = 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+    Effect+  , Sub+  , Sink+  , DOMRef+  , ComponentInfo (..)+  , ComponentId+  , mkComponentInfo+  -- ** 'IO'+  , Schedule (..)+  , Synchronicity (..)+    -- *** Combinators+  , (<#)+  , (#>)+  , batch+  , batch_+  , io+  , io_+  , sync+  , sync_+  , for+  , issue+  , withSink+  , mapSub+  , noop+  , beforeAll+  , afterAll+  , modifyAllIO+  -- *** Lens+  , componentInfoDOMRef+  , componentInfoParentId+  , componentInfoId+  -- *** Internal+  , runEffect+  -- *** Props+  , componentInfoProps+  , props+  , getProps+  ) where+-----------------------------------------------------------------------------+import           Control.Monad (void)+import           Data.Foldable (traverse_)+import           Control.Monad.RWS (RWS, put, tell, execRWS, censor, MonadReader)+-----------------------------------------------------------------------------+import           Miso.DSL.FFI+import           Miso.Lens+-----------------------------------------------------------------------------+-- | Smart constructor for t'ComponentInfo'+mkComponentInfo+  :: ComponentId+  -- ^ 'ComponentId'+  -> ComponentId+  -- ^ @parent@ 'ComponentId'+  -> DOMRef+  -- ^ 'DOMRef'+  -> props+  -> ComponentInfo parent props+mkComponentInfo = ComponentInfo+-----------------------------------------------------------------------------+-- | This is the 'Reader r' in t'Miso.Effect'. Accessible via 'Control.Monad.Reader.ask'. It holds+-- a phantom type for @parent@. This is used as a witness when calling the+-- 'parent' function. It gives access to 'Component' metadata such as the 'DOMRef' the+-- 'Component' was mounted on and the 'ComponentId' associated with it.+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'.+--+-- @+--   update = \case+--     SomeAction -> do+--       compId <- view componentInfoId+--       someAction compId+-- @+--+-- @since 1.9.0.0+componentInfoId :: Lens (ComponentInfo parent props) ComponentId+componentInfoId = lens _componentInfoId $ \r x -> r { _componentInfoId = x }+-----------------------------------------------------------------------------+-- | Lens for accessing the parents's  t'ComponentId' from t'ComponentInfo'.+--+-- @+--+-- update = \case+--   SomeAction -> do+--     compParentId <- view componentParentId+--     someAction compParentId+-- @+--+-- @since 1.9.0.0+componentInfoParentId :: Lens (ComponentInfo parent props) ComponentId+componentInfoParentId = lens _componentInfoParentId $ \r x -> r { _componentInfoParentId = x }+-----------------------------------------------------------------------------+-- | Lens for accessing the underlying t'Miso.Types.Component' t'DOMRef'.+--+-- @+--   update = \case+--     SomeAction -> do+--       domRef <- view componentDOMRef+--       someAction domRef+-- @+--+-- @since 1.9.0.0+componentInfoDOMRef :: Lens (ComponentInfo parent props) DOMRef+componentInfoDOMRef = lens _componentInfoDOMRef $ \r x -> r { _componentInfoDOMRef = x }+-----------------------------------------------------------------------------+-- | Lens for accessing the underlying t'Miso.Types.Component' @props@.+--+-- @+--   update = \case+--     SomeAction -> do+--       props <- view componentInfoProps+--       someAction props+-- @+--+-- @since 1.9.0.0+componentInfoProps :: Lens (ComponentInfo parent props) props+componentInfoProps = lens _componentInfoProps $ \r x -> r { _componentInfoProps = x }+-----------------------------------------------------------------------------+-- | Lens for accessing the underlying t'Miso.Types.Component' @props@.+--+-- This is a shorter convenience lens that is a synonynm for 'componentInfoProps'.+-- See 'getProps' for usage in the 'Effect' monad.+--+-- @+--   update = \case+--     SomeAction ->+--       someAction =<< view props+-- @+--+props :: Lens (ComponentInfo parent props) props+props = componentInfoProps+-----------------------------------------------------------------------------+-- | @props@ retrieval from within the 'Effect' monad.+--+-- @+--   update = \case+--     SomeAction -> do+--       props <- getProps+--       someAction props+-- @+--+getProps :: MonadReader (ComponentInfo parent props) m => m props+getProps = Miso.Lens.view props+-----------------------------------------------------------------------------+-- | 'ComponentId' of the current t'Miso.Types.Component'+type ComponentId = Int+-----------------------------------------------------------------------------+-- | Type synonym for constructing subscriptions.+--+-- For example usage see "Miso.Subscription"+--+-- The 'Sink' function is used to write to the global event queue.+type Sub action = Sink action -> IO ()+-----------------------------------------------------------------------------+-- | Function to write to the global event queue for processing by the scheduler.+type Sink action = action -> IO ()+-----------------------------------------------------------------------------+-- | Smart constructor for an 'Effect' with exactly one action.+infixl 0 <#+(<#) :: model -> IO action -> Effect parent props model action+(<#) m action = put m >> tell [ async $ \f -> f =<< action ]+-----------------------------------------------------------------------------+async :: (Sink action -> IO ()) -> Schedule action+async = Schedule Async+-----------------------------------------------------------------------------+-- | `Effect` smart constructor, flipped+infixr 0 #>+(#>) :: IO action -> model -> Effect parent props model action+(#>) = flip (<#)+-----------------------------------------------------------------------------+-- | Smart constructor for an 'Effect' with multiple 'IO' actions.+--+-- @since 1.9.0.0+batch+  :: [IO action]+  -- ^ Batch of 'IO' actions to execute+  -> Effect parent props model action+batch actions = sequence_+  [ tell [ async $ \f -> f =<< action ]+  | action <- actions+  ]+-----------------------------------------------------------------------------+-- | Like @batch@ but actions are discarded+--+-- @since 1.9.0.0+batch_ :: [IO ()] -> Effect parent props model action+batch_ actions = sequence_+  [ tell [ async (const action) ]+  | action <- actions+  ]+-----------------------------------------------------------------------------+-- | A monad for succinctly expressing model transitions in the @update@ function.+--+-- t'Effect' is a @RWS@, where the @State@ allows modification to 'model'.+-- It's also a @Writer@ @Monad@, where the accumulator is a list of scheduled+-- @IO@ actions. Multiple actions can be scheduled using 'Control.Monad.Writer.Class.tell'+-- from the @mtl@ library and a single asynchronous action can be scheduled using 'io_'.+--+-- An t'Effect' represents the results of an 'update' action.+--+-- It consists of the updated model and a list of subscriptions. Each t'Sub' is+-- run in a new thread so there is no risk of accidentally blocking the+-- application.+--+-- Tip: use the t'Effect' monad in combination with the stateful "Miso.Lens"+-- operators (all operators ending in "@=@"). The following example assumes+-- the lenses @field1@, @counter@ and @field2@ are in scope and that the+-- @LambdaCase@ language extension is enabled:+--+-- @+-- myComponent = Component+--   { update = \\case+--       MyAction1 -> do+--         field1 '.=' value1+--         counter '+=' 1+--       MyAction2 -> do+--         field2 '%=' f+--         'io_' $ do+--           'consoleLog' \"Hello\"+--           'consoleLog' \"World!\"+--   , ...+--   }+-- @+type Effect parent props model action = RWS (ComponentInfo parent props) [Schedule action] model ()+-----------------------------------------------------------------------------+-- | Represents a scheduled 'Effect' that is executed either synchronously+-- or asynchronously.+--+-- All t'IO' is by default asynchronous, use the 'sync' function for synchronous+-- execution. Beware 'sync' can block the render thread for a specific+-- t'Miso.Types.Component'.+--+-- N.B. During t'Miso.Types.Component' unmounting, all effects are evaluated+-- synchronously.+--+-- @since 1.9.0.0+data Schedule action = Schedule Synchronicity (Sink action -> IO ())+-----------------------------------------------------------------------------+-- | Type to represent a DOM reference+type DOMRef = JSVal+-----------------------------------------------------------------------------+-- | Internal function used to unwrap an @Effect@+runEffect+    :: Effect parent props model action+    -> ComponentInfo parent props+    -> model+    -> (model, [Schedule action])+runEffect = execRWS+-----------------------------------------------------------------------------+-- | 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)+  -- ^ 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+-- execution, see 'io'.+--+-- Please use this with caution because it will block the render thread.+--+-- @since 1.9.0.0+sync+  :: IO action+  -- ^ 'IO' action to execute synchronously+  -> Effect parent props model action+sync action = tell [ Schedule Sync $ \f -> f =<< action ]+-----------------------------------------------------------------------------+-- | Like 'sync', except discards the result.+--+-- @since 1.9.0.0+sync_+  :: IO ()+  -- ^ 'IO' action to execute synchronously+  -> Effect parent props model action+sync_ action = tell [ Schedule Sync $ \_ -> action ]+-----------------------------------------------------------------------------+-- | Schedule a single 'IO' action for later execution.+--+-- Note that multiple 'IO' action can be scheduled using+-- 'Control.Monad.Writer.Class.tell' from the @mtl@ library.+--+-- @since 1.9.0.0+io+  :: IO action+  -- ^ 'IO' action to execute asynchronously+  -> Effect parent props model action+io action = withSink (action >>=)+-----------------------------------------------------------------------------+-- | Like 'io' but doesn't cause an action to be dispatched to+-- the @update@ function.+--+-- This is handy for scheduling @IO@ computations where you don't care+-- about their results or when they complete.+--+-- Note: The result of @IO a@ is discarded.+--+-- @since 1.9.0.0+io_+  :: IO ()+  -- ^ 'IO' action to execute asynchronously+  -> Effect parent props model action+io_ action = withSink (\_ -> void action)+-----------------------------------------------------------------------------+-- | Like 'io' but generalized to any instance of 'Foldable'+--+-- This is handy for scheduling @IO@ computations that return a @Maybe@ value+--+-- @since 1.9.0.0+for+  :: Foldable f+  => IO (f action)+  -- ^ @actions@ executed in batch.+  -> Effect parent props model action+for actions = withSink $ \sink -> actions >>= traverse_ sink+-----------------------------------------------------------------------------+-- | Performs the given 'IO' action before all IO actions collected by the given+-- effect.+--+-- @+-- -- delays connecting a websocket by 100000 microseconds+-- beforeAll (liftIO $ threadDelay 100000) $ websocketConnectJSON OnConnect OnClose OnOpen OnError+-- @+--+-- @since 1.9.0.0+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+-- effect.+--+-- Example usage:+--+-- > -- log that running the a websocket Effect completed+-- > afterAll (consoleLog "Done running websocket effect") $ websocketConnectJSON OnConnect OnClose OnOpen OnError+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.+--+-- All 'IO' expressions collected by 'Effect' can be evaluated either+-- synchronously or asynchronously (the default).+--+-- This function can be used to adjoin additional actions to all 'IO'+-- 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)+  | Schedule x action <- actions+  ]+-----------------------------------------------------------------------------+-- | @withSink@ allows users to write to the global event queue. This is useful for introducing 'IO' into the system.+-- A synonym for 'Control.Monad.Writer.tell', specialized to 'Effect'.+--+-- A use-case is scheduling an 'IO' computation which creates a 3rd-party JS+-- widget which has an associated callback. The callback can then call the sink+-- to turn events into actions.+--+-- @+-- 'update' FetchJSON = 'withSink' $ \\sink -> getJSON (sink . ReceivedJSON) (sink . HandleError)+-- @+--+-- @since 1.9.0.0+withSink+  :: (Sink action -> IO ())+  -- ^ Callback function that provides access to the underlying 'Sink'.+  -> Effect parent props model action+withSink f = tell [ async f ]+-----------------------------------------------------------------------------+-- | Issue a new @action@ to be processed by 'Miso.Types.update'.+--+-- @+-- data Action = HelloWorld+-- type Model  = Int+--+-- 'update' :: Action -> 'Effect' parent Model Action+-- 'update' = \\case+--   Click -> 'issue' HelloWorld+-- @+--+-- @since 1.9.0.0+issue+  :: action+  -- ^ @action@ to raise+  -> Effect parent props model action+issue action = tell [ async $ \f -> f action ]+-----------------------------------------------------------------------------+-- | Helper for t'Miso.Types.Component' construction, when you want to ignore the 'Miso.Types.update'+-- function temporarily, or permanently.+--+-- @since 1.9.0.0+noop :: action -> Effect parent props model action+noop = const (pure ())+-----------------------------------------------------------------------------+-- | Type to indicate if effects should be handled asynchronously+-- or synchronously.+--+data Synchronicity+  = Async+  | Sync+  deriving (Show, Eq)+-----------------------------------------------------------------------------
src/Miso/Event.hs view
@@ -1,17 +1,246 @@ -----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+----------------------------------------------------------------------------- -- | -- Module      :  Miso.Event--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- Stability   :  experimental -- Portability :  non-portable+--+-- 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-   ( module Miso.Event.Decoder+   ( -- *** Smart constructors+     on+   , onCapture+   , onWithOptions+   , Phase (..)+   -- *** Lifecycle events+   , onCreated+   , onCreatedWith+   , onBeforeCreated+   , onDestroyed+   , onBeforeDestroyed+   , onBeforeDestroyedWith+    -- *** Exports+   , module Miso.Event.Decoder    , module Miso.Event.Types    ) where--import Miso.Event.Decoder-import Miso.Event.Types-+-----------------------------------------------------------------------------+import           Control.Monad (when)+import qualified Data.Map.Strict as M+import           Miso.JSON (parseEither)+-----------------------------------------------------------------------------+import           Miso.DSL+import           Miso.Event.Decoder+import           Miso.Event.Types+import qualified Miso.FFI.Internal as FFI+import           Miso.Types (Attribute (On), LogLevel(..), DOMRef, VTree(..))+import           Miso.String (MisoString, ms)+-----------------------------------------------------------------------------+-- | Attach a bubble-phase event handler to a VDOM node.+-- Convenience wrapper for @'onWithOptions' 'BUBBLE' 'defaultOptions'@.+--+-- The decoded event payload is converted to an @action@ by @toAction@ and+-- dispatched into the component's @update@ function.+--+-- @+-- 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+-----------------------------------------------------------------------------+-- | Attach a capture-phase event handler to a VDOM node.+-- Convenience wrapper for @'onWithOptions' 'CAPTURE' 'defaultOptions'@.+--+-- Events in the capture phase propagate from the document root down to the+-- target element, before any bubble-phase handlers run.+--+-- @+-- let captureClick = onCapture \"click\" emptyDecoder $ \\() _ -> MyAction+-- in button_ [ captureClick ] [ text_ \"capture me\" ]+-- @+--+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+-----------------------------------------------------------------------------+-- | Attach an event handler with explicit phase and propagation options.+--+-- * @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 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+    when (logLevel == DebugAll || logLevel == DebugEvents) $+      case M.lookup eventName events of+        Nothing ->+            FFI.consoleError $ mconcat+              [ "Event \""+              , eventName+              , "\" is not being listened on. To use this event, "+              , "add to the 'events' Map in Component"+              ]+        _ -> pure ()+    eventsVal <-+      getProp "events" n+    eventObj <-+      case phase of+        CAPTURE -> getProp "captures" (Object eventsVal)+        BUBBLE -> getProp "bubbles" (Object eventsVal)+    eventHandlerObject@(Object eo) <- create+    jsOptions <- toJSVal options+    decodeAtVal <- toJSVal decodeAt+    cb <- FFI.asyncCallback2 $ \e domRef -> do+        Just v <- fromJSVal =<< FFI.eventJSON decodeAtVal e+        case parseEither decoder v of+          Left msg -> FFI.consoleError ("[EVENT DECODE ERROR]: " <> ms msg)+          Right event -> sink (toAction event domRef)+    FFI.set "runEvent" cb eventHandlerObject+    FFI.set "options" jsOptions eventHandlerObject+    FFI.set eventName eo (Object eventObj)+-----------------------------------------------------------------------------+-- | 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+  -- ^ 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' 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)+  -- ^ 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+-----------------------------------------------------------------------------+-- | 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+  -- ^ 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+-----------------------------------------------------------------------------+-- | 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+  -- ^ 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 also receives the element's 'DOMRef'.+--+-- @since 1.9.0.0+--+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+-----------------------------------------------------------------------------+-- | 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+  -- ^ 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)+    FFI.set "onBeforeCreated" callback object+-----------------------------------------------------------------------------
src/Miso/Event/Decoder.hs view
@@ -1,88 +1,189 @@-{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+{-# LANGUAGE CPP               #-}+{-# LANGUAGE LambdaCase        #-} {-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module      :  Miso.Event.Decoder--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- 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+-- <https://developer.mozilla.org/en-US/docs/Web/API/Event DOM Event> 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-  ( -- * Decoder+  ( -- ** Types     Decoder (..)   , DecodeTarget (..)+    -- ** Combinators   , at-  -- * Decoders+    -- ** Decoders   , emptyDecoder   , keycodeDecoder   , keyInfoDecoder   , checkedDecoder   , valueDecoder-  )-  where--import Data.Aeson.Types+  , pointerDecoder+  ) where+----------------------------------------------------------------------------- import Control.Applicative-+-----------------------------------------------------------------------------+import Miso.DSL (ToJSVal(toJSVal)) import Miso.Event.Types+import Miso.JSON import Miso.String---- | Data type representing path (consisting of field names) within event object, where a decoder should be applied.+-----------------------------------------------------------------------------+-- | Data type representing path (consisting of field names) within event object+-- where a decoder should be applied. data DecodeTarget-  = DecodeTarget [MisoString] -- ^ Specify single path within Event object, where a decoder should be applied.-  | DecodeTargets [[MisoString]] -- ^ Specify multiple paths withing Event object, where decoding should be attempted. The first path where decoding suceeds is the one taken.---- | Decoder data type for parsing events-data Decoder a = Decoder {-  decoder :: Value -> Parser a -- ^ FromJSON-based Event decoder-, decodeAt :: DecodeTarget -- ^ Location in DOM of where to decode-}---- | Smart constructor for building a `Decoder`.-at :: [MisoString] -> (Value -> Parser a) -> Decoder a+  = DecodeTarget [MisoString]+  -- ^ Specify single path within Event object, where a decoder should be applied.+  | DecodeTargets [[MisoString]]+  -- ^ Specify multiple paths withing Event object, where decoding should be attempted. The first path where decoding suceeds is the one taken.+-----------------------------------------------------------------------------+-- | `ToJSVal` instance for t'DecodeTarget'.+instance ToJSVal DecodeTarget where+  toJSVal = \case+    DecodeTarget xs -> toJSVal xs+    DecodeTargets xs -> toJSVal xs+-----------------------------------------------------------------------------+-- | t'Decoder' data type for parsing events+data Decoder a+  = Decoder+  { decoder :: Value -> Parser a+    -- ^ FromJSON-based Event decoder+  , decodeAt :: DecodeTarget+    -- ^ Location in DOM of where to decode+  }+-----------------------------------------------------------------------------+-- | Smart constructor for building a t'Decoder'.+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 decoder for use with events like "click" that do not+-----------------------------------------------------------------------------+-- | Empty t'Decoder' for use with events like "click" that do not -- return any meaningful values emptyDecoder :: Decoder () emptyDecoder = mempty `at` go   where     go = withObject "emptyDecoder" $ \_ -> pure ()---- | Retrieves either "keyCode", "which" or "charCode" field in `Decoder`+-----------------------------------------------------------------------------+-- | Retrieves either "keyCode", "which" or "charCode" field in t'Decoder' keycodeDecoder :: Decoder KeyCode keycodeDecoder = Decoder {..}   where     decodeAt = DecodeTarget mempty     decoder = withObject "event" $ \o ->        KeyCode <$> (o .: "keyCode" <|> o .: "which" <|> o .: "charCode")---- | Retrieves either "keyCode", "which" or "charCode" field in `Decoder`, along with shift, ctrl, meta and alt.+-----------------------------------------------------------------------------+-- | Retrieves either "keyCode", "which" or "charCode" field in t'Decoder',+-- along with shift, ctrl, meta and alt. keyInfoDecoder :: Decoder KeyInfo keyInfoDecoder = Decoder {..}   where-    decodeAt = DecodeTarget mempty+    decodeAt =+      DecodeTarget mempty     decoder =       withObject "event" $ \o ->-        KeyInfo <$> (o .: "keyCode" <|> o .: "which" <|> o .: "charCode")-                <*> o .: "shiftKey"-                <*> o .: "metaKey"-                <*> o .: "ctrlKey"-                <*> o .: "altKey"---- | Retrieves "value" field in `Decoder`+        KeyInfo+          <$> (o .: "keyCode" <|> o .: "which" <|> o .: "charCode")+          <*> o .: "shiftKey"+          <*> o .: "metaKey"+          <*> o .: "ctrlKey"+          <*> o .: "altKey"+-----------------------------------------------------------------------------+-- | Retrieves "value" field in t'Decoder' valueDecoder :: Decoder MisoString valueDecoder = Decoder {..}   where     decodeAt = DecodeTarget ["target"]     decoder = withObject "target" $ \o -> o .: "value"---- | Retrieves "checked" field in Decoder+-----------------------------------------------------------------------------+-- | Retrieves "checked" field in t'Decoder' checkedDecoder :: Decoder Checked checkedDecoder = Decoder {..}   where     decodeAt = DecodeTarget ["target"]     decoder = withObject "target" $ \o ->-       Checked <$> (o .: "checked")+      Checked <$> (o .: "checked")+-----------------------------------------------------------------------------+-- | Pointer t'Decoder' for use with events like "onpointerover"+pointerDecoder :: Decoder PointerEvent+pointerDecoder = Decoder {..}+  where+    pair o x y = liftA2 (,) (o .: x) (o .: y)+    decodeAt = DecodeTarget mempty+    decoder = withObject "pointerDecoder" $ \o ->+      PointerEvent+        <$> o .: "pointerType"+        <*> o .: "pointerId"+        <*> o .: "isPrimary"+        <*> pair o "clientX" "clientY"+        <*> pair o "screenX" "screenY"+        <*> pair o "offsetX" "offsetY"+        <*> pair o "pageX" "pageY"+        <*> pair o "tiltX" "tiltY"+        <*> o .: "pressure"+        <*> o .: "button"+-----------------------------------------------------------------------------
src/Miso/Event/Types.hs view
@@ -1,79 +1,331 @@-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module      :  Miso.Event.Types--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- Stability   :  experimental -- Portability :  non-portable------------------------------------------------------------------------------module Miso.Event.Types where--import qualified Data.Map as M-import           GHC.Generics-import           Miso.String-import           Data.Aeson (FromJSON)-+--+-- = 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+-- <https://developer.mozilla.org/en-US/docs/Learn_web_development/Core/Scripting/Event_bubbling event delegation>:+-- 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+  , Phase (..)+    -- *** KeyboardEvent+  , KeyInfo (..)+  , KeyCode (..)+    -- *** CheckedEvent+  , Checked (..)+    -- *** PointerEvent+  , PointerEvent (..)+  , PointerType (..)+    -- *** Options+  , Options (..)+  , defaultOptions+  , preventDefault+  , stopPropagation+    -- *** Events+  , defaultEvents+  , keyboardEvents+  , mouseEvents+  , dragEvents+  , pointerEvents+  , mediaEvents+  , clipboardEvents+  , touchEvents+  ) where+-----------------------------------------------------------------------------+import           Miso.JSON (FromJSON(..), withText)+import qualified Data.Map.Strict as M+-----------------------------------------------------------------------------+import           Miso.DSL+import           Miso.String (MisoString, ms)+----------------------------------------------------------------------------- -- | Type useful for both KeyCode and additional key press information. 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. -- -- See <https://developer.mozilla.org/en-US/docs/Web/API/KeyboardEvent/keyCode#Browser_compatibility> newtype KeyCode = KeyCode Int-  deriving (Show, Eq, Ord, FromJSON)-+  deriving (Show, Eq, Ord, FromJSON, Num)+----------------------------------------------------------------------------- -- | Type used for Checkbox events. newtype Checked = Checked Bool   deriving (Show, Eq, Ord, FromJSON)---- | Options for handling event propagation.-data Options = Options {-    preventDefault :: Bool-  , stopPropagation :: Bool-  } deriving (Show, Eq, Generic)---- | Default value for 'Options'.+-----------------------------------------------------------------------------+-- | Type used for Pointer events.+-- <https://w3c.github.io/pointerevents>+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)@ — position relative to the viewport+  , screen :: (Double, Double)+  -- ^ @(screenX, screenY)@ — position relative to the screen+  , offset :: (Double, Double)+  -- ^ @(offsetX, offsetY)@ — position relative to the target element+  , page :: (Double,Double)+  -- ^ @(pageX, pageY)@ — position relative to the full document+  , tilt :: (Double,Double)+  -- ^ @(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+  -- ^ Which button changed state; @-1@ during move with no button change.+  -- See <https://w3c.github.io/pointerevents/#the-button-property PointerEvent.button>+  } deriving (Show, Eq)+-----------------------------------------------------------------------------+-- | Pointer type+-- <https://developer.mozilla.org/en-US/docs/Web/API/PointerEvent/pointerType>+data PointerType+  = MousePointerType+  | PenPointerType+  | TouchPointerType+  | UnknownPointerType MisoString+  deriving (Show, Eq)+-----------------------------------------------------------------------------+instance FromJSON PointerType where+  parseJSON = withText "PointerType" $ \case+    "mouse" -> pure MousePointerType+    "touch" -> pure TouchPointerType+    "pen"   -> pure PenPointerType+    x       -> pure (UnknownPointerType (ms x))+-----------------------------------------------------------------------------+-- | t'Options' for handling event propagation.+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+  mempty = defaultOptions+-----------------------------------------------------------------------------+instance Semigroup Options where+  Options p1 s1 <> Options p2 s2 = Options (p1 || p2) (s1 || s2)+-----------------------------------------------------------------------------+-- | Smart constructor for specifying 'preventDefault' --+-- @since 1.9.0.0+preventDefault :: Options+preventDefault = defaultOptions { _preventDefault = True }+-----------------------------------------------------------------------------+-- | Smart constructor for specifying 'stopPropagation'+--+-- @since 1.9.0.0+stopPropagation :: Options+stopPropagation = defaultOptions { _stopPropagation = True }+-----------------------------------------------------------------------------+instance ToJSVal Options where+  toJSVal Options {..} = do+    o <- create+    flip (setProp "preventDefault") o =<< toJSVal _preventDefault+    flip (setProp "stopPropagation") o =<< toJSVal _stopPropagation+    toJSVal o+-----------------------------------------------------------------------------+-- | Default value for @Options@.+-- -- > defaultOptions = Options { preventDefault = False, stopPropagation = False } defaultOptions :: Options-defaultOptions = Options False False---- | Related to using drop-related events-newtype AllowDrop = AllowDrop Bool-  deriving (Show, Eq, FromJSON)-+defaultOptions+  = Options+  { _preventDefault = False+  , _stopPropagation = False+  }+-----------------------------------------------------------------------------+-- | Convenience type for Events+type Events = M.Map MisoString Phase+----------------------------------------------------------------------------- -- | Default delegated events-defaultEvents :: M.Map MisoString Bool-defaultEvents = M.fromList [-    ("blur", True)-  , ("change", False)-  , ("click", False)-  , ("dblclick", False)-  , ("focus", False)-  , ("input", False)-  , ("keydown", False)-  , ("keypress", False)-  , ("keyup", False)-  , ("mouseup", False)-  , ("mousedown", False)-  , ("mouseenter", True)-  , ("mouseleave", False)-  , ("mouseover", False)-  , ("mouseout", False)-  , ("dragstart", False)-  , ("dragover", False)-  , ("dragend", False)-  , ("dragenter", False)-  , ("dragleave", False)-  , ("drag", False)-  , ("drop", False)-  , ("submit", False)+defaultEvents :: Events+defaultEvents = M.fromList+  [ ("blur", CAPTURE)+  , ("change", BUBBLE)+  , ("click", BUBBLE)+  , ("contextmenu", BUBBLE)+  , ("dblclick", BUBBLE)+  , ("focus", CAPTURE)+  , ("input", BUBBLE)+  , ("select", BUBBLE)+  , ("submit", BUBBLE)   ]+-----------------------------------------------------------------------------+-- | Keyboard events+keyboardEvents :: Events+keyboardEvents = M.fromList+  [ ("keydown", BUBBLE)+  , ("keypress", BUBBLE)+  , ("keyup", BUBBLE)+  ]+-----------------------------------------------------------------------------+-- | Mouse events+mouseEvents :: Events+mouseEvents = M.fromList+  [ ("mouseup", BUBBLE)+  , ("mousedown", BUBBLE)+  , ("mouseenter", CAPTURE)+  , ("mouseleave", BUBBLE)+  , ("mouseover", BUBBLE)+  , ("mouseout", BUBBLE)+  , ("contextmenu", BUBBLE)+  ]+-----------------------------------------------------------------------------+-- | Drag events+dragEvents :: Events+dragEvents = M.fromList+  [ ("dragstart", BUBBLE)+  , ("dragover", BUBBLE)+  , ("dragend", BUBBLE)+  , ("dragenter", BUBBLE)+  , ("dragleave", BUBBLE)+  , ("drag", BUBBLE)+  , ("drop", BUBBLE)+  ]+-----------------------------------------------------------------------------+-- | Pointer events+pointerEvents :: Events+pointerEvents = M.fromList+  [ ("pointerup", BUBBLE)+  , ("pointerdown", BUBBLE)+  , ("pointerenter", CAPTURE)+  , ("pointercancel", BUBBLE)+  , ("pointerleave", BUBBLE)+  , ("pointerover", BUBBLE)+  , ("pointerout", BUBBLE)+  , ("contextmenu", BUBBLE)+  ]+-----------------------------------------------------------------------------+-- | Audio video events+-- For use with the @<audio>@ and @<video>@ tags.+--+-- @+-- myApp :: 'Miso.Types.App' Model Action+-- myApp = ('Miso.Types.component' model update view){ events = 'defaultEvents' <> 'mediaEvents' }+-- @+mediaEvents :: Events+mediaEvents = M.fromList+  [ ("abort", CAPTURE)+  , ("canplay", CAPTURE)+  , ("canplaythrough", CAPTURE)+  , ("durationchange", BUBBLE)+  , ("emptied", CAPTURE)+  , ("ended", CAPTURE)+  , ("error", CAPTURE)+  , ("loadeddata", BUBBLE)+  , ("loadedmetadata", BUBBLE)+  , ("loadstart", BUBBLE)+  , ("pause", CAPTURE)+  , ("play", CAPTURE)+  , ("playing", CAPTURE)+  , ("progress", CAPTURE)+  , ("ratechange", CAPTURE)+  , ("seeked", CAPTURE)+  , ("seeking", CAPTURE)+  , ("stalled", CAPTURE)+  , ("suspend", CAPTURE)+  , ("timeupdate", CAPTURE)+  , ("volumechange", CAPTURE)+  , ("waiting", CAPTURE)+  ]+-----------------------------------------------------------------------------+-- | Clipboard events+clipboardEvents :: Events+clipboardEvents = M.fromList+  [ ("cut", BUBBLE)+  , ("copy", BUBBLE)+  , ("paste", BUBBLE)+  ]+-----------------------------------------------------------------------------+-- | Touch events+touchEvents :: Events+touchEvents = M.fromList+  [ ("touchstart", BUBBLE)+  , ("touchcancel", BUBBLE)+  , ("touchmove", BUBBLE)+  , ("touchend", BUBBLE)+  ]+-----------------------------------------------------------------------------+-- | Phase during which event listener is invoked.+--+-- @since 1.9.0.0+data Phase = CAPTURE | BUBBLE deriving (Eq, Show)+-----------------------------------------------------------------------------+instance ToJSVal Phase where+  toJSVal = \case+    CAPTURE -> toJSVal True+    BUBBLE -> toJSVal False+-----------------------------------------------------------------------------
+ src/Miso/EventSource.hs view
@@ -0,0 +1,106 @@+-----------------------------------------------------------------------------+{-# LANGUAGE CPP                        #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.EventSource+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- 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+    connectText+  , connectJSON+  , close+  , socketState+  -- *** Defaults+  , emptyEventSource+  -- *** Types+  , EventSource (..)+  , URL+  -- *** Re-exports+  , Payload (..)+  ) where+-----------------------------------------------------------------------------+import           Miso.JSON+-----------------------------------------------------------------------------+import           Miso.Effect+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 <https://developer.mozilla.org/en-US/docs/Web/API/EventSource>+connectText+  :: URL+  -- ^ URL endpoint for the Server-Sent Events stream+  -> (EventSource -> action)+  -- ^ @onOpen@ callback; receives the live 'EventSource' handle+  -> (MisoString -> action)+  -- ^ @onMessage@ callback; receives each raw text message+  -> (MisoString -> action)+  -- ^ @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 <https://developer.mozilla.org/en-US/docs/Web/API/EventSource>+connectJSON+  :: FromJSON value+  => URL+  -- ^ URL endpoint for the Server-Sent Events stream+  -> (EventSource -> action)+  -- ^ @onOpen@ callback; receives the live 'EventSource' handle+  -> (value -> action)+  -- ^ @onMessage@ callback; receives each JSON-decoded message+  -> (MisoString -> action)+  -- ^ @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+-- <https://developer.mozilla.org/en-US/docs/Web/API/EventSource/close EventSource.close()>.+close+  :: EventSource+  -- ^ The 'EventSource' handle to close+  -> Effect parent props model action+close = eventSourceClose+-----------------------------------------------------------------------------
+ src/Miso/FFI.hs view
@@ -0,0 +1,133 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.FFI+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- 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+    set+    -- ** Performance+  , now+    -- ** Logging+  , consoleLog+  , consoleLog'+  , consoleError+  , consoleWarn+    -- ** DOM+  , getElementById+  , focus+  , blur+  , select+  , setSelectionRange+  , alert+  , getProperty+  , callFunction+  , castJSVal+  , removeChild+    -- ** Styles+  , addStyle+  , addStyleSheet+    -- * JS+  , addSrc+  , addScript+  , addScriptImportMap+    -- ** Callbacks+  , syncCallback+  , syncCallback1+  , asyncCallback+  , asyncCallback1+  , asyncCallback2+    -- ** Drawing+  , flush+  , setDrawingContext+    -- ** Window+  , windowInnerWidth+  , windowInnerHeight+  , locationReload+    -- ** Image+  , Image (..)+  , newImage+    -- ** Date+  , Date (..)+  , newDate+  , toLocaleString+  , getSeconds+  , getMilliseconds+    -- ** DOM Traversal+  , nextSibling+  , previousSibling+    -- ** Element+  , click+  , setValue+    -- ** File Input+  , files+    -- ** Navigator+  , isOnLine+    -- ** ArrayBuffer+  , ArrayBuffer (..)+    -- ** Blob+  , Blob (..)+    -- ** Uint8Array+  , Uint8Array (..)+    -- ** FormData+  , FormData (..)+    -- ** File+  , File (..)+    -- ** URLSearchParams+  , URLSearchParams (..)+    -- ** FileReader+  , FileReader (..)+  , newFileReader+    -- ** Fetch API+  , fetch+  , Response (..)+    -- ** Event+  , addEventListener+  , removeEventListener+  , dispatchEvent+  , newEvent+  , newCustomEvent+  , Event (..)+  , eventPreventDefault+  , eventStopPropagation+    -- ** Inline JS+  , inline+    -- ** Scroll+  , scrollIntoView+    -- ** Fullscreen+  , requestFullscreen+    -- ** SplitMix32+  , splitmix32+    -- ** Math.random()+  , mathRandom+    -- ** Model+  , mountComponent+  , unmountComponent+  , modelHydration+  ) where+-----------------------------------------------------------------------------+import           Miso.FFI.Internal+-----------------------------------------------------------------------------
+ src/Miso/FFI/Internal.hs view
@@ -0,0 +1,1283 @@+-----------------------------------------------------------------------------+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE NamedFieldPuns             #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE CPP                        #-}+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -fno-warn-orphans       #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.FFI.Internal+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = 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+-- <https://github.com/haskell-miso/miso-lynx miso-lynx>, 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+   , syncCallback1+   , syncCallback2+   , asyncCallback+   , asyncCallback1+   , asyncCallback2+   -- * Events+   , addEventListener+   , removeEventListener+   , eventPreventDefault+   , eventStopPropagation+   -- * Window+   , windowAddEventListener+   , windowRemoveEventListener+   , windowInnerHeight+   , windowInnerWidth+   -- * Performance+   , now+   -- * Console+   , consoleWarn+   , consoleLog+   , consoleError+   , consoleLog'+   -- * JSON+   , eventJSON+   -- * Object+   , set+   , setValue+   -- * DOM+   , getBody+   , getDocument+   , getDrawingContext+   , getHydrationContext+   , getEventContext+   , getComponentContext+   , getElementById+   , removeChild+   , getHead+   , diff+   , nextSibling+   , previousSibling+   , getProperty+   , callFunction+   , castJSVal+   -- * Events+   , delegator+   , dispatchEvent+   , newEvent+   , newCustomEvent+   -- * Isomorphic+   , hydrate+   -- * Misc.+   , focus+   , blur+   , select+   , setSelectionRange+   , scrollIntoView+   , requestFullscreen+   , alert+   , locationReload+   -- * CSS+   , addStyle+   , addStyleSheet+   -- * JS+   , addSrc+   , addScript+   , addScriptImportMap+   -- * XHR+   , fetch+   , CONTENT_TYPE(..)+   -- * Drawing+   , setDrawingContext+   , flush+   -- * Image+   , Image (..)+   , newImage+   -- * Date+   , Date (..)+   , newDate+   , toLocaleString+   -- * Utils+   , getMilliseconds+   , getSeconds+   -- * Element+   , files+   , click+   -- * WebSocket+   , websocketConnect+   , websocketClose+   , websocketSend+   -- * SSE+   , eventSourceConnect+   , eventSourceClose+   -- * Blob+   , Blob (..)+   -- * FormData+   , FormData (..)+   -- * URLSearchParams+   , URLSearchParams (..)+   -- * File+   , File (..)+   -- * Uint8Array+   , Uint8Array (..)+   -- * ArrayBuffer+   , ArrayBuffer (..)+   -- * Navigator+   , geolocation+   , copyClipboard+   , getUserMedia+   , isOnLine+   -- * FileReader+   , FileReader (..)+   , newFileReader+   -- * Fetch API+   , Response (..)+   -- * Event+   , Event (..)+   -- * Class+   , populateClass+   , updateRef+   -- * Inline JS+   , inline+   -- * Randomness+   , splitmix32+   -- * Math+   , mathRandom+   -- * Crypto+   , getRandomValue+   -- * Model+   , mountComponent+   , unmountComponent+   , modelHydration+   ) where+-----------------------------------------------------------------------------+import           Control.Monad (void, forM_, (<=<), when, unless)+import           Data.Map.Strict (Map)+import           Data.Maybe+import           Prelude hiding ((!!))+-----------------------------------------------------------------------------+import           Miso.DSL+import           Miso.String+-----------------------------------------------------------------------------+-- | Set property on object+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+  setProp (fromMisoString k) v' o+-----------------------------------------------------------------------------+-- | Get a property of a 'JSVal'+--+-- Example usage:+--+-- > Just (value :: String) <- fromJSVal =<< getProperty domRef "value"+getProperty+  :: JSVal+  -- ^ JavaScript object to read from+  -> MisoString+  -- ^ Property name to retrieve+  -> IO JSVal+{-# INLINABLE getProperty #-}+getProperty = (!)+-----------------------------------------------------------------------------+-- | Calls a function on a 'JSVal'+--+-- Example usage:+--+-- > callFunction domRef "focus" ()+-- > callFunction domRef "setSelectionRange" (0, 3, "none")+callFunction :: (ToArgs args) => JSVal -> MisoString -> args -> IO JSVal+{-# INLINABLE callFunction #-}+callFunction = (#)+-----------------------------------------------------------------------------+-- | Marshalling of 'JSVal', useful for 'getProperty'+castJSVal :: (FromJSVal a) => JSVal -> IO (Maybe a)+{-# INLINABLE castJSVal #-}+castJSVal = fromJSVal+-----------------------------------------------------------------------------+-- | Register an event listener on given target.+addEventListener+  :: JSVal+  -- ^ Event target on which we want to register event listener+  -> MisoString+  -- ^ Type of event to listen to (e.g. "click")+  -> (JSVal -> IO ())+  -- ^ Callback which will be called when the event occurs,+  -- the event will be passed to it as a parameter.+  -> IO Function+{-# INLINABLE addEventListener #-}+addEventListener self name cb = do+#ifdef GHCJS_BOTH+  cb_ <- Function <$> syncCallback1 cb+#else+  cb_ <- Function <$> asyncCallback1 cb+#endif+  void $ self # "addEventListener" $ (name, cb_)+  pure cb_+-----------------------------------------------------------------------------+-- | Removes an event listener from given target.+removeEventListener+  :: JSVal+  -- ^ Event target from which we want to remove event listener+  -> MisoString+  -- ^ Type of event to listen to (e.g. "click")+  -> Function+  -- ^ Callback which will be called when the event occurs,+  -- the event will be passed to it as a parameter.+  -> IO ()+{-# INLINABLE removeEventListener #-}+removeEventListener self name cb =+  void $ self # "removeEventListener" $ (name, cb)+-----------------------------------------------------------------------------+-- | Removes an event listener from window+windowRemoveEventListener+  :: MisoString+  -- ^ Type of event to listen to (e.g. "click")+  -> Function+  -- ^ Callback which will be called when the event occurs,+  -- the event will be passed to it as a parameter.+  -> IO ()+{-# INLINABLE windowRemoveEventListener #-}+windowRemoveEventListener name cb = do+  win <- jsg "window"+  removeEventListener win name cb+-----------------------------------------------------------------------------+-- | Registers an event listener on window+windowAddEventListener+  :: MisoString+  -- ^ Type of event to listen to (e.g. "click")+  -> (JSVal -> IO ())+  -- ^ Callback which will be called when the event occurs,+  -- the event will be passed to it as a parameter.+  -> IO Function+{-# INLINABLE windowAddEventListener #-}+windowAddEventListener name cb = do+  win <- jsg "window"+  addEventListener win name cb+-----------------------------------------------------------------------------+-- | Stop propagation of events+eventStopPropagation :: JSVal -> IO ()+{-# INLINABLE eventStopPropagation #-}+eventStopPropagation e = do+  _ <- e # "stopPropagation" $ ()+  pure ()+-----------------------------------------------------------------------------+-- | Prevent default event behavior+eventPreventDefault :: JSVal -> IO ()+{-# INLINABLE eventPreventDefault #-}+eventPreventDefault e = do+  _ <- e # "preventDefault" $ ()+  pure ()+-----------------------------------------------------------------------------+-- | Retrieves the height (in pixels) of the browser window viewport including,+-- if rendered, the horizontal scrollbar.+--+-- See <https://developer.mozilla.org/en-US/docs/Web/API/Window/innerHeight>+windowInnerHeight :: IO Int+{-# INLINABLE windowInnerHeight #-}+windowInnerHeight = fromJSValUnchecked =<< jsg "window" ! "innerHeight"+-----------------------------------------------------------------------------+-- | Retrieves the width (in pixels) of the browser window viewport including+-- if rendered, the vertical scrollbar.+--+-- See <https://developer.mozilla.org/en-US/docs/Web/API/Window/innerWidth>+windowInnerWidth :: IO Int+{-# INLINABLE windowInnerWidth #-}+windowInnerWidth =+  fromJSValUnchecked =<< jsg "window" ! "innerWidth"+-----------------------------------------------------------------------------+-- | Retrieve high resolution time stamp+--+-- See <https://developer.mozilla.org/en-US/docs/Web/API/Performance/now>+now :: IO Double+{-# INLINABLE now #-}+now = fromJSValUnchecked =<< (jsg "performance" # "now" $ ())+-----------------------------------------------------------------------------+-- | Outputs a message to the web console+--+-- See <https://developer.mozilla.org/en-US/docs/Web/API/Console/log>+--+-- Console logging of JavaScript strings.+consoleLog :: MisoString -> IO ()+{-# INLINABLE consoleLog #-}+consoleLog v = do+  _ <- jsg "console" # "log" $ [ms v]+  pure ()+-----------------------------------------------------------------------------+-- | Outputs a warning message to the web console+--+-- See <https://developer.mozilla.org/en-US/docs/Web/API/Console/warn>+--+-- Console logging of JavaScript strings.+consoleWarn :: MisoString -> IO ()+{-# INLINABLE consoleWarn #-}+consoleWarn v = do+  _ <- jsg "console" # "warn" $ [ms v]+  pure ()+-----------------------------------------------------------------------------+-- | Outputs an error message to the web console+--+-- See <https://developer.mozilla.org/en-US/docs/Web/API/Console/error>+--+-- Console logging of JavaScript strings.+consoleError :: MisoString -> IO ()+{-# INLINABLE consoleError #-}+consoleError v = do+  _ <- jsg "console" # "error" $ [ms v]+  pure ()+-----------------------------------------------------------------------------+-- | Console-logging of JSVal+consoleLog' :: ToArgs a => a -> IO ()+{-# INLINABLE consoleLog' #-}+consoleLog' args' = do+  args <- toArgs args'+  _ <- jsg "console" # "log" $ args+  pure ()+-----------------------------------------------------------------------------+-- | Convert a JavaScript object to JSON+-- JSONified representation of events+eventJSON+    :: JSVal -- ^ decodeAt :: [JSString]+    -> JSVal -- ^ object with impure references to the DOM+    -> IO JSVal+{-# INLINABLE eventJSON #-}+eventJSON x y = do+  moduleMiso <- jsg "miso"+  moduleMiso # "eventJSON" $ [x,y]+-----------------------------------------------------------------------------+-- | Used to update the JavaScript reference post-diff.+updateRef+    :: ToJSVal val+    => val+    -> val+    -> IO ()+{-# INLINABLE updateRef #-}+updateRef jsval1 jsval2 = do+  moduleMiso <- jsg "miso"+  void $ moduleMiso # "updateRef" $ (jsval1, jsval2)+-----------------------------------------------------------------------------+-- | Convenience function to write inline javascript.+--+-- Prefer this function over the use of `eval`.+--+-- This function takes as arguments a JavaScript object and makes the+-- keys available in the function body.+--+-- @+--+-- data Person = Person { name :: MisoString, age :: Int }+--   deriving stock (Generic)+--   deriving anyclass (ToJSVal, ToObject)+--+-- logNameGetAge :: Person -> IO Int+-- logNameGetAge = inline+--   """+--   console.log('name', name);+--   return age;+--   """+--+-- @+--+inline+    :: (FromJSVal return, ToObject object)+    => MisoString+    -> object+    -> IO return+{-# INLINABLE inline #-}+inline code o = do+  moduleMiso <- jsg "miso"+  Object obj <- toObject o+  fromJSValUnchecked =<< do+    moduleMiso # "inline" $ (code, obj)+-----------------------------------------------------------------------------+-- | Populate the 'Miso.Html.Property.classList' Set on the virtual DOM.+populateClass+    :: JSVal+    -- ^ Node+    -> [MisoString]+    -- ^ classes+    -> IO ()+{-# INLINABLE populateClass #-}+populateClass domRef classes = do+  moduleMiso <- jsg "miso"+  void $ moduleMiso # "populateClass" $ (domRef, classes)+-----------------------------------------------------------------------------+-- | Retrieves a reference to document body.+--+-- See <https://developer.mozilla.org/en-US/docs/Web/API/Document/body>+getBody :: IO JSVal+{-# INLINABLE getBody #-}+getBody = do+  ctx <- getDrawingContext+  ctx # "getRoot" $ ()+-----------------------------------------------------------------------------+-- | Retrieves a reference to the document.+--+-- See <https://developer.mozilla.org/en-US/docs/Web/API/Document>+getDocument :: IO JSVal+{-# INLINABLE getDocument #-}+getDocument = jsg "document"+-----------------------------------------------------------------------------+-- | Retrieves a reference to the drawing context.+--+-- This is a miso specific construct used to provide an identical interface+-- for both native (iOS / Android, etc.) and browser environments.+--+getDrawingContext :: IO JSVal+{-# INLINABLE getDrawingContext #-}+getDrawingContext = jsg "miso" ! "drawingContext"+-----------------------------------------------------------------------------+-- | Retrieves a reference to the event context.+--+-- This is a miso specific construct used to provide an identical interface+-- for both native (iOS / Android, etc.) and browser environments.+--+getEventContext :: IO JSVal+{-# INLINABLE getEventContext #-}+getEventContext = jsg "miso" ! "eventContext"+-----------------------------------------------------------------------------+-- | Retrieves a reference to the hydration context.+--+-- This is a miso specific construct used to provide an identical interface+-- for both native (iOS / Android, etc.) and browser environments.+--+getHydrationContext :: IO JSVal+{-# INLINABLE getHydrationContext #-}+getHydrationContext = jsg "miso" ! "hydrationContext"+-----------------------------------------------------------------------------+-- | Retrieves a reference to the Component context.+--+-- This is a miso specific construct used to provide an identical interface+-- for both native (iOS / Android, etc.) and browser environments.+--+getComponentContext :: IO JSVal+{-# INLINABLE getComponentContext #-}+getComponentContext = jsg "miso" ! "componentContext"+-----------------------------------------------------------------------------+-- | Returns an Element object representing the element whose id property matches+-- the specified string.+--+-- See <https://developer.mozilla.org/en-US/docs/Web/API/Document/getElementById>+getElementById :: MisoString -> IO JSVal+{-# INLINABLE getElementById #-}+getElementById e = getDocument # "getElementById" $ [e]+-----------------------------------------------------------------------------+-- | Retrieves a reference to the renderer's "head" mount.+--+-- Calls @miso.drawingContext.getHead()@.+--+-- Note: custom renderers should implement this method.+--+-- @since 1.9.0.0+getHead :: IO JSVal+{-# INLINABLE getHead #-}+getHead = do+  context <- getDrawingContext+  context # "getHead" $ ()+-----------------------------------------------------------------------------+-- | Removes a child node from a parent node.+--+-- Calls @miso.drawingContext.removeChild(parent, child)@.+--+-- @since 1.9.0.0+removeChild :: JSVal -> JSVal -> IO ()+{-# INLINABLE removeChild #-}+removeChild parent child = do+  context <- getDrawingContext+  void $ context # "removeChild" $ (parent, child)+-----------------------------------------------------------------------------+-- | Diff two virtual DOMs+diff+  :: Object+  -- ^ current object+  -> Object+  -- ^ new object+  -> JSVal+  -- ^ parent node+  -> IO ()+{-# INLINABLE diff #-}+diff (Object a) (Object b) c = do+  moduleMiso <- jsg "miso"+  context <- getDrawingContext+  void $ moduleMiso # "diff" $ [a,b,c,context]+-----------------------------------------------------------------------------+-- | Initialize event delegation from a mount point.+delegator :: JSVal -> JSVal -> Bool -> IO JSVal -> IO ()+{-# INLINABLE delegator #-}+delegator mountPoint events debug getVTree = do+  ctx <- getEventContext+#ifdef WASM+  cb <- asyncCallback1 $ \continuation -> void (call continuation global =<< getVTree)+#else+  cb <- syncCallback1 $ \continuation -> void (call continuation global =<< getVTree)+#endif+  d <- toJSVal debug+  moduleMiso <- jsg "miso"+  void $ moduleMiso # "delegator" $ [mountPoint,events,cb,d,ctx]+-----------------------------------------------------------------------------+-- | Copies DOM pointers into virtual dom entry point into isomorphic javascript+--+-- See [hydration](https://en.wikipedia.org/wiki/Hydration_(web_development))+--+hydrate :: Bool -> JSVal -> JSVal -> IO JSVal+{-# INLINABLE hydrate #-}+hydrate logLevel mountPoint vtree = do+  ll <- toJSVal logLevel+  drawingContext <- getDrawingContext+  hydrationContext <- getHydrationContext+  moduleMiso <- jsg "miso"+  moduleMiso # "hydrate" $ (ll, mountPoint, vtree, hydrationContext, drawingContext)+-----------------------------------------------------------------------------+-- | Fails silently if the element is not found.+--+-- Analogous to @document.getElementById(id).focus()@.+focus :: MisoString -> IO ()+{-# INLINABLE focus #-}+focus x = void $ jsg "miso" # "callFocus" $ (x, 50 :: Int)+-----------------------------------------------------------------------------+-- | Fails silently if the element is not found.+--+-- Analogous to @document.getElementById(id).blur()@+blur :: MisoString -> IO ()+{-# INLINABLE blur #-}+blur x = void $ jsg "miso" # "callBlur" $ (x, 50 :: Int)+-----------------------------------------------------------------------------+-- | Fails silently if the element is not found.+--+-- Analogous to @document.querySelector('#' + id).select()@.+select :: MisoString -> IO ()+{-# INLINABLE select #-}+select x = void $ jsg "miso" # "callSelect" $ (x, 50 :: Int)+-----------------------------------------------------------------------------+-- | Fails silently if the element is not found.+--+-- Analogous to @document.querySelector('#' + id).setSelectionRange(start, end, \'none\')@.+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)+-----------------------------------------------------------------------------+-- | Calls @document.getElementById(id).scrollIntoView()@+scrollIntoView :: MisoString -> IO ()+{-# INLINABLE scrollIntoView #-}+scrollIntoView elId = do+  el <- jsg "document" # "getElementById" $ [elId]+  _ <- 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 #-}+alert a = () <$ jsg1 "alert" a+-----------------------------------------------------------------------------+-- | Calls the @location.reload()@ function.+locationReload :: IO ()+{-# INLINABLE locationReload #-}+locationReload = void $ jsg "location" # "reload" $ ([] :: [MisoString])+-----------------------------------------------------------------------------+-- | Appends a 'Miso.Html.Element.style_' element containing CSS to 'Miso.Html.Element.head_'+--+-- > addStyle "body { background-color: green; }"+--+-- > <head><style>body { background-color: green; }</style></head>+--+addStyle :: MisoString -> IO JSVal+{-# INLINABLE addStyle #-}+addStyle css = do+  context <- getDrawingContext+  head_ <- getHead+  style <- context # "createElement" $ ["style" :: MisoString]+  setField style "innerHTML" css+  void $ context # "appendChild" $ (head_, style)+  pure style+-----------------------------------------------------------------------------+-- | Appends a 'Miso.Html.Element.script_' element containing JS to 'Miso.Html.Element.head_'+--+-- > addScript False "function () { alert('hi'); }"+--+addScript :: Bool -> MisoString -> IO JSVal+{-# INLINABLE addScript #-}+addScript useModule js_ = do+  context <- getDrawingContext+  head_ <- getHead+  script <- context # "createElement" $ ["script" :: MisoString]+  when useModule $ setField script "type" ("module" :: MisoString)+  setField script "innerHTML" js_+  void $ context # "appendChild" $ (head_, script)+  pure script+-----------------------------------------------------------------------------+-- | Sets the @.value@ property on a 'DOMRef'.+--+-- Useful for resetting the @value@ property on an input element.+--+-- @+--   setValue domRef ("" :: MisoString)+-- @+--+setValue :: JSVal -> MisoString -> IO ()+{-# INLINABLE setValue #-}+setValue domRef value = setField domRef "value" value+-----------------------------------------------------------------------------+-- | Appends a 'Miso.Html.Element.script_' element containing a JS import map.+--+-- > addScript "{ \"import\" : { \"three\" : \"url\" } }"+--+addScriptImportMap :: MisoString -> IO JSVal+{-# INLINABLE addScriptImportMap #-}+addScriptImportMap impMap = do+  context <- getDrawingContext+  head_ <- getHead+  script <- context # "createElement" $ ["script" :: MisoString]+  setField script "type" ("importmap" :: MisoString)+  setField script "innerHTML" impMap+  void $ context # "appendChild" $ (head_, script)+  pure script+-----------------------------------------------------------------------------+-- | Appends a \<script\> element to 'Miso.Html.Element.head_'+--+-- > addSrc "https://example.com/script.js"+--+addSrc :: MisoString -> Bool -> IO JSVal+{-# INLINABLE addSrc #-}+addSrc url cacheBust = do+  context <- getDrawingContext+  head_ <- getHead+  link <- context # "createElement" $ ["script" :: MisoString]+  url_ <- appendTimestamp url cacheBust+  _ <- link # "setAttribute" $ ["src", url_ ]+  void $ context # "appendChild" $ (head_, link)+  pure link+-----------------------------------------------------------------------------+-- | Appends a StyleSheet 'Miso.Html.Element.link_' element to 'Miso.Html.Element.head_'+-- The 'Miso.Html.Element.link_' tag will contain a URL to a CSS file.+--+-- > addStyleSheet "https://cdn.jsdelivr.net/npm/todomvc-common@1.0.5/base.min.css"+--+-- > <head><link href="https://cdn.jsdelivr.net/npm/todomvc-common@1.0.5/base.min.css" ref="stylesheet"></head>+--+addStyleSheet :: MisoString -> Bool -> IO JSVal+{-# INLINABLE addStyleSheet #-}+addStyleSheet url cacheBust  = do+  context <- getDrawingContext+  head_ <- getHead+  link <- context # "createElement" $ ["link" :: MisoString]+  _ <- link # "setAttribute" $ ["rel","stylesheet" :: MisoString]+  url_ <- appendTimestamp url cacheBust+  _ <- link # "setAttribute" $ ["href", url_ ]+  void $ context # "appendChild" $ (head_, link)+  pure link+-----------------------------------------------------------------------------+-- | Helper for cache busting+appendTimestamp+  :: MisoString+  -- ^ Base URL to optionally append a timestamp query parameter to+  -> Bool+  -- ^ When 'True', appends @?v=\<timestamp\>@ to force cache invalidation+  -> IO MisoString+{-# INLINABLE appendTimestamp #-}+appendTimestamp url = \case+  True -> do+    ts <- fromJSValUnchecked =<< do jsg "Date" # "now" $ ()+    pure (url <> "?v=" <> ms (ts :: Double))+  False ->+    pure url+-----------------------------------------------------------------------------+-- | Retrieve JSON via Fetch API+--+-- Basic GET of JSON using Fetch API, will be expanded upon.+--+-- See <https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API>+--+fetch+  :: (FromJSVal success, FromJSVal error)+  => MisoString+  -- ^ url+  -> MisoString+  -- ^ method+  -> Maybe JSVal+  -- ^ body+  -> [(MisoString, MisoString)]+  -- ^ headers+  -> (Response success -> IO ())+  -- ^ successful callback+  -> (Response error -> IO ())+  -- ^ errorful callback+  -> CONTENT_TYPE+  -- ^ content type+  -> IO ()+{-# INLINABLE fetch #-}+fetch url method maybeBody requestHeaders successful errorful type_ = do+  successful_ <- toJSVal =<< asyncCallback1 (successful <=< fromJSValUnchecked)+  errorful_ <- toJSVal =<< asyncCallback1 (errorful <=< fromJSValUnchecked)+  moduleMiso <- jsg "miso"+  url_ <- toJSVal url+  method_ <- toJSVal method+  body_ <- toJSVal maybeBody+  Object headers_ <- do+    o <- create+    forM_ requestHeaders $ \(k,v) -> set k v o+    pure o+  typ <- toJSVal type_+  void $ moduleMiso # "fetchCore" $+    [ url_+    , method_+    , body_+    , headers_+    , successful_+    , errorful_+    , typ+    ]+-----------------------------------------------------------------------------+-- | List of possible content types that are available for use with the fetch API+data CONTENT_TYPE+  = JSON+  | ARRAY_BUFFER+  | TEXT+  | BLOB+  | BYTES+  | FORM_DATA+  | NONE+  deriving (Show, Eq)+-----------------------------------------------------------------------------+instance ToJSVal CONTENT_TYPE where+  toJSVal = \case+    JSON ->+      toJSVal ("json" :: MisoString)+    ARRAY_BUFFER ->+      toJSVal ("arrayBuffer" :: MisoString)+    TEXT ->+      toJSVal ("text" :: MisoString)+    BLOB ->+      toJSVal ("blob" :: MisoString)+    BYTES ->+      toJSVal ("bytes" :: MisoString)+    FORM_DATA ->+      toJSVal ("formData" :: MisoString)+    NONE ->+      toJSVal ("none" :: MisoString)+  {-# INLINE toJSVal #-}+-----------------------------------------------------------------------------+-- | Flush is used to force a draw of the render tree. This is currently+-- only used when targeting platforms other than the browser (like mobile).+flush :: IO ()+{-# INLINABLE flush #-}+flush = do+  context <- getDrawingContext+  void $ context # "flush" $ ([] :: [JSVal])+-----------------------------------------------------------------------------+-- | Type that holds an [Image](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/img).+newtype Image = Image JSVal+  deriving (ToJSVal, ToObject)+-----------------------------------------------------------------------------+instance FromJSVal Image where+  fromJSVal = pure . pure . Image+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+-- | Smart constructor for building a t'Image' w/ 'Miso.Html.Property.src_' 'Miso.Types.Attribute'.+newImage :: MisoString -> IO Image+{-# INLINABLE newImage #-}+newImage url = do+  img <- new (jsg "Image") ([] :: [MisoString])+  setField img "src" url+  pure (Image img)+-----------------------------------------------------------------------------+-- | Used to select a drawing context. Users can override the default DOM renderer+-- by implementing their own Context, and exporting it to the global scope. This+-- opens the door to different rendering engines, ala [miso-lynx](https://github.com/haskell-miso/miso-lynx).+setDrawingContext :: MisoString -> IO ()+{-# INLINABLE setDrawingContext #-}+setDrawingContext rendererName =+  void $ jsg "miso" # "setDrawingContext" $ [rendererName]+-----------------------------------------------------------------------------+-- | The [Date](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date) type+newtype Date = Date JSVal+  deriving (ToJSVal, ToObject, Eq)+-----------------------------------------------------------------------------+-- | Smart constructor for a t'Date'+newDate :: IO Date+{-# INLINABLE newDate #-}+newDate = Date <$> new (jsg "Date") ([] :: [MisoString])+-----------------------------------------------------------------------------+-- | Date conversion function to produce a locale+toLocaleString :: Date -> IO MisoString+{-# INLINABLE toLocaleString #-}+toLocaleString date = fromJSValUnchecked =<< do+  date # "toLocaleString" $ ()+-----------------------------------------------------------------------------+-- | Retrieves current milliseconds from t'Date'+getMilliseconds :: Date -> IO Double+{-# INLINABLE getMilliseconds #-}+getMilliseconds date =+  fromJSValUnchecked =<< do+    date # "getMilliseconds" $ ([] :: [MisoString])+-----------------------------------------------------------------------------+-- | Retrieves current seconds from t'Date'+getSeconds :: Date -> IO Double+{-# INLINABLE getSeconds #-}+getSeconds date =+  fromJSValUnchecked =<< do+    date # "getSeconds" $ ([] :: [MisoString])+-----------------------------------------------------------------------------+-- | Fetch next sibling DOM node+--+-- @since 1.9.0.0+nextSibling :: JSVal -> IO JSVal+{-# INLINABLE nextSibling #-}+nextSibling domRef = domRef ! "nextSibling"+-----------------------------------------------------------------------------+-- | Fetch previous sibling DOM node+--+-- @since 1.9.0.0+previousSibling :: JSVal -> IO JSVal+{-# INLINABLE previousSibling #-}+previousSibling domRef = domRef ! "previousSibling"+-----------------------------------------------------------------------------+-- | When working with @\<input type="file"\>@, this is useful for+-- extracting out the selected files.+--+-- @+--   update (InputClicked inputElement) = withSink $ \\sink -> do+--      files_ <- files inputElement+--      forM_ files_ $ \\file -> sink (Upload file)+--   update (Upload file) = do+--      fetch \"https://localhost:8080\/upload\" \"POST\" (Just file) []+--        Successful Errorful+-- @+--+-- @since 1.9.0.0+files :: JSVal -> IO [JSVal]+{-# INLINABLE files #-}+files domRef = fromJSValUnchecked =<< domRef ! "files"+-----------------------------------------------------------------------------+-- | Simulates a click event+--+-- > button & click ()+--+-- @since 1.9.0.0+click :: () -> JSVal -> IO ()+{-# INLINABLE click #-}+click () domRef = void $ domRef # "click" $ ([] :: [MisoString])+-----------------------------------------------------------------------------+-- | Get Camera on user's device+--+-- <https://developer.mozilla.org/en-US/docs/Web/API/MediaDevices/getUserMedia>+--+getUserMedia+  :: Bool+  -- ^ video+  -> Bool+  -- ^ audio+  -> (JSVal -> IO ())+  -- ^ successful+  -> (JSVal -> IO ())+  -- ^ errorful+  -> IO ()+{-# INLINABLE getUserMedia #-}+getUserMedia video audio successful errorful = do+  params <- create+  set "video" video params+  set "audio" audio params+  devices <- jsg "navigator" ! "mediaDevices"+  promise <- devices # "getUserMedia" $ [params]+  successfulCallback <- asyncCallback1 successful+  void $ promise # "then" $ [successfulCallback]+  errorfulCallback <- asyncCallback1 errorful+  void $ promise # "catch" $ [errorfulCallback]+-----------------------------------------------------------------------------+-- | Copy clipboard+--+-- <https://developer.mozilla.org/en-US/docs/Web/API/MediaDevices/getUserMedia>+--+copyClipboard+  :: MisoString+  -- ^ Text to copy+  -> IO ()+  -- ^ successful+  -> (JSVal -> IO ())+  -- ^ errorful+  -> IO ()+{-# INLINABLE copyClipboard #-}+copyClipboard txt successful errorful = do+  clipboard <- jsg "navigator" ! "clipboard"+  promise <- clipboard # "writeText" $ [txt]+  successfulCallback <- asyncCallback successful+  void $ promise # "then" $ [successfulCallback]+  errorfulCallback <- asyncCallback1 errorful+  void $ promise # "catch" $ [errorfulCallback]+-----------------------------------------------------------------------------+-- | Establishes a @WebSocket@ connection+websocketConnect+  :: MisoString+  -> IO ()+  -> (JSVal -> IO ())+  -> Maybe (JSVal -> IO ())+  -> Maybe (JSVal -> IO ())+  -> Maybe (JSVal -> IO ())+  -> Maybe (JSVal -> IO ())+  -> (JSVal -> IO ())+  -> Bool+  -> IO JSVal+{-# INLINABLE websocketConnect #-}+websocketConnect+  url onOpen onClose+  onMessageText onMessageJSON+  onMessageBLOB onMessageArrayBuffer+  onError textOnly = do+    url_ <- toJSVal url+    onOpen_ <- toJSVal =<< asyncCallback onOpen+    onClose_ <- toJSVal =<< asyncCallback1 onClose+    onMessageText_ <- withMaybe onMessageText+    onMessageJSON_ <- withMaybe onMessageJSON+    onMessageBLOB_ <- withMaybe onMessageBLOB+    onMessageArrayBuffer_ <- withMaybe onMessageArrayBuffer+    onError_ <- toJSVal =<< asyncCallback1 onError+    textOnly_ <- toJSVal textOnly+    jsg "miso" # "websocketConnect" $+      [ url_+      , onOpen_+      , onClose_+      , onMessageText_+      , onMessageJSON_+      , onMessageBLOB_+      , onMessageArrayBuffer_+      , onError_+      , textOnly_+      ]+  where+    withMaybe Nothing = pure jsNull+    withMaybe (Just f) = asyncCallback1 f+-----------------------------------------------------------------------------+websocketClose :: JSVal -> IO ()+{-# INLINABLE websocketClose #-}+websocketClose websocket = void $ do+  jsg "miso" # "websocketClose" $ [websocket]+-----------------------------------------------------------------------------+websocketSend :: JSVal -> JSVal -> IO ()+{-# INLINABLE websocketSend #-}+websocketSend websocket message = void $ do+  jsg "miso" # "websocketSend" $ [websocket, message]+-----------------------------------------------------------------------------+eventSourceConnect+  :: MisoString+  -> IO ()+  -> Maybe (JSVal -> IO ())+  -> Maybe (JSVal -> IO ())+  -> (JSVal -> IO ())+  -> Bool+  -> IO JSVal+{-# INLINABLE eventSourceConnect #-}+eventSourceConnect url onOpen onMessageText onMessageJSON onError textOnly = do+  onOpen_ <- asyncCallback onOpen+  onMessageText_ <- withMaybe onMessageText+  onMessageJSON_ <- withMaybe onMessageJSON+  onError_ <- asyncCallback1 onError+  textOnly_ <- toJSVal textOnly+  jsg "miso" # "eventSourceConnect" $+    (url, onOpen_, onMessageText_, onMessageJSON_, onError_, textOnly_)+    where+      withMaybe Nothing = pure jsNull+      withMaybe (Just f) = toJSVal =<< asyncCallback1 f+-----------------------------------------------------------------------------+eventSourceClose :: JSVal -> IO ()+{-# INLINABLE eventSourceClose #-}+eventSourceClose eventSource = void $ do+  jsg "miso" # "eventSourceClose" $ [eventSource]+-----------------------------------------------------------------------------+-- | Navigator function to query the current online status of the user's computer+--+-- See [navigator.onLine](https://developer.mozilla.org/en-US/docs/Web/API/Navigator/onLine)+--+isOnLine :: IO Bool+{-# INLINABLE isOnLine #-}+isOnLine = fromJSValUnchecked =<< jsg "navigator" ! "onLine"+-----------------------------------------------------------------------------+-- | [Blob](https://developer.mozilla.org/en-US/docs/Web/API/FormData)+newtype Blob = Blob JSVal+  deriving (ToJSVal, Eq)+-----------------------------------------------------------------------------+instance FromJSVal Blob where+  fromJSVal = pure . pure . Blob+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+-- | [FormData](https://developer.mozilla.org/en-US/docs/Web/API/FormData)+newtype FormData = FormData JSVal+  deriving (ToJSVal, Eq)+-----------------------------------------------------------------------------+instance FromJSVal FormData where+  fromJSVal = pure . pure . FormData+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+instance FromJSVal ArrayBuffer where+  fromJSVal = pure . pure . ArrayBuffer+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+-- | [ArrayBuffer](https://developer.mozilla.org/en-US/docs/Web/API/ArrayBuffer)+newtype ArrayBuffer = ArrayBuffer JSVal+  deriving (Eq, ToJSVal)+-----------------------------------------------------------------------------+geolocation :: (JSVal -> IO ()) -> (JSVal -> IO ()) -> IO ()+{-# INLINABLE geolocation #-}+geolocation successful errorful = do+  geo <- jsg "navigator" ! "geolocation"+  cb1 <- asyncCallback1 successful+  cb2 <- asyncCallback1 errorful+  void $ geo # "getCurrentPosition" $ (cb1, cb2)+-----------------------------------------------------------------------------+-- | [File](https://developer.mozilla.org/en-US/docs/Web/API/File)+newtype File = File JSVal+  deriving (ToJSVal, ToObject, Eq)+-----------------------------------------------------------------------------+instance FromJSVal File where+  fromJSVal = pure . pure . File+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+-- | [Uint8Array](https://developer.mozilla.org/en-US/docs/Web/API/Uint8Array)+newtype Uint8Array = Uint8Array JSVal+  deriving ToJSVal+-----------------------------------------------------------------------------+instance FromJSVal Uint8Array where+  fromJSVal = pure . pure . Uint8Array+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+-- | [FileReader](https://developer.mozilla.org/en-US/docs/Web/API/FileReader)+newtype FileReader = FileReader JSVal+  deriving (ToJSVal, ToObject, Eq)+-----------------------------------------------------------------------------+instance FromJSVal FileReader where+  fromJSVal = pure . pure . FileReader+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+-- | [URLSearchParams](https://developer.mozilla.org/en-US/docs/Web/API/URLSearchParams)+newtype URLSearchParams = URLSearchParams JSVal+  deriving (ToJSVal, ToObject, Eq)+-----------------------------------------------------------------------------+instance FromJSVal URLSearchParams where+  fromJSVal = pure . pure . URLSearchParams+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+-- | Smart constructor for building a t'FileReader'+newFileReader :: IO FileReader+{-# INLINABLE newFileReader #-}+newFileReader = do+  reader <- new (jsg "FileReader") ([] :: [MisoString])+  pure (FileReader reader)+-----------------------------------------------------------------------------+-- | Type returned from a 'fetch' request+data Response body+  = Response+  { status :: Maybe Int+    -- ^ HTTP status code+  , headers :: Map MisoString MisoString+    -- ^ Response headers+  , errorMessage :: Maybe MisoString+    -- ^ Optional error message+  , body :: body+    -- ^ Response body+  }+-----------------------------------------------------------------------------+instance Functor Response where+  fmap f response@Response { body } = response { body = f body }+  {-# INLINE fmap #-}+-----------------------------------------------------------------------------+instance FromJSVal body => FromJSVal (Response body) where+  fromJSVal o = do+    status_ <- fromJSVal =<< getProp "status" (Object o)+    headers_ <- fromJSVal =<< getProp "headers" (Object o)+    errorMessage_ <- fromJSVal =<< getProp "error" (Object o)+    body_ <- fromJSVal =<< getProp "body" (Object o)+    pure (Response <$> status_ <*> headers_ <*> errorMessage_ <*> body_)+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+-- | [Event](https://developer.mozilla.org/en-US/docs/Web/API/Event/Event)+newtype Event = Event JSVal+  deriving (ToJSVal, Eq)+-----------------------------------------------------------------------------+instance FromJSVal Event where+  fromJSVal = pure . Just . Event+  {-# INLINE fromJSVal #-}+-----------------------------------------------------------------------------+-- | Invokes [document.dispatchEvent](https://developer.mozilla.org/en-US/docs/Web/API/EventTarget/dispatchEvent)+--+-- @+--   update ChangeTheme = io_ $ do+--     themeEvent <- newEvent "basecoat:theme"+--     dispatchEvent themeEvent+-- @+--+dispatchEvent :: Event -> IO ()+{-# INLINABLE dispatchEvent #-}+dispatchEvent event = do+  doc <- getDocument+  _ <- doc # "dispatchEvent" $ [event]+  pure ()+-----------------------------------------------------------------------------+-- | Creates a new [Event](https://developer.mozilla.org/en-US/docs/Web/API/Event/Event)+--+-- @+--   update ChangeTheme = io_ $ do+--     themeEvent <- newEvent "basecoat:theme"+--     dispatchEvent themeEvent+-- @+--+newEvent :: ToArgs args => args -> IO Event+{-# INLINABLE newEvent #-}+newEvent args = Event <$> new (jsg "Event") args+-----------------------------------------------------------------------------+-- | Creates a new [Event](https://developer.mozilla.org/en-US/docs/Web/API/Event/CustomEvent)+--+-- @+--   update ToggleSidebar = io_ $ do+--     themeEvent <- newCustomEvent "basecoat:sidebar"+--     dispatchEvent themeEvent+-- @+--+newCustomEvent :: ToArgs args => args -> IO Event+{-# INLINABLE newCustomEvent #-}+newCustomEvent args = Event <$> new (jsg "CustomEvent") args+-----------------------------------------------------------------------------+-- | Uses the 'splitmix' function to generate a PRNG.+--+splitmix32 :: Double -> IO JSVal+{-# INLINABLE splitmix32 #-}+splitmix32 x = jsg "miso" # "splitmix32" $ [x]+-----------------------------------------------------------------------------+-- | Uses the 'Math.random()' function.+--+mathRandom :: IO Double+{-# INLINABLE mathRandom #-}+mathRandom = fromJSValUnchecked =<< do+  jsg "miso" # "mathRandom" $ ()+-----------------------------------------------------------------------------+-- | Uses the first element of 'crypto.getRandomValues()'.+--+getRandomValue :: IO Double+{-# INLINABLE getRandomValue #-}+getRandomValue = fromJSValUnchecked =<< do+  jsg "miso" # "getRandomValues" $ ()+-----------------------------------------------------------------------------+-- | Abstract over model hydration+modelHydration :: Int -> Object -> IO ()+{-# INLINABLE modelHydration #-}+modelHydration vcompId model_ = do+  comp <- getComponentContext+  void $ comp # "modelHydration" $ (vcompId, model_)+-----------------------------------------------------------------------------+-- | Abstract over Component mounting+mountComponent :: Int -> Object -> IO ()+{-# INLINABLE mountComponent #-}+mountComponent vcompId model_ = do+  comp <- getComponentContext+  void $ comp # "mountComponent" $ (vcompId, model_)+-----------------------------------------------------------------------------+-- | Abstract over Component unmounting+unmountComponent :: Int -> IO ()+{-# INLINABLE unmountComponent #-}+unmountComponent vcompId = do+  comp <- getComponentContext+  void $ comp # "unmountComponent" $ [vcompId]+-----------------------------------------------------------------------------
+ src/Miso/FFI/QQ.hs view
@@ -0,0 +1,187 @@+-----------------------------------------------------------------------------+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DeriveLift            #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE QuasiQuotes           #-}+{-# LANGUAGE ViewPatterns          #-}+{-# LANGUAGE BlockArguments        #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE TypeSynonymInstances  #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -Wno-duplicate-exports #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.FFI.QQ+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = 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'.+--+-- Enable the extension and import the quoter:+--+-- @+-- {-\# LANGUAGE QuasiQuotes \#-}+-- import "Miso.FFI.QQ" ('js')+-- @+--+-- = Quick start+--+-- @+-- -- Compute a factorial entirely in JavaScript+-- fac :: Int -> IO Int+-- fac n = ['js'|+--   let x = 1;+--   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+----------------------------------------------------------------------------+import           Control.Applicative+import           Data.Data+import           Control.Monad+import           System.IO.Unsafe (unsafePerformIO)+import           Language.Haskell.TH.Lib+import           Language.Haskell.TH.Quote+import           Language.Haskell.TH.Syntax+----------------------------------------------------------------------------+import           Miso.String (MisoString)+import           Miso.Util.Lexer+import           Miso.DSL+import qualified Miso.String as MS+import qualified Miso.FFI as FFI+----------------------------------------------------------------------------+-- | QuasiQuoter for specifying inline JavaScript.+--+js :: QuasiQuoter+js = QuasiQuoter+  { quoteExp  = \s -> dataToExpQ (withString `extQ` inlineJS) s+  , quotePat  = \_ -> fail "quotePat: not implemented"+  , quoteType = \_ -> fail "quoteType: not implemented"+  , quoteDec  = \_ -> fail "quoteDec: not implemented"+  }+----------------------------------------------------------------------------+inlineJS :: String -> Maybe (Q Exp)+inlineJS jsString = pure $ do+  found <- typeCheck vars+  kvs <- forM found $ \(var, key) -> do+    k <- [| MS.pack $(stringE (MS.unpack key)) |]+    let v = mkName (MS.unpack var)+    val <- [| unsafePerformIO (toJSVal $(varE v)) :: JSVal |]+    pure $ tupE [ pure k, pure val ]+  [| do o <- createWith ($(listE kvs) :: [(MisoString, JSVal)])+        FFI.inline $(stringE (MS.unpack (formatVars (MS.pack jsString) found)))+          o+   |] where+        vars = getVariables (MS.pack jsString)+----------------------------------------------------------------------------+extQ :: (Typeable a, Typeable b) => (a -> c) -> (b -> c) -> a -> c+extQ f g a = maybe (f a) g (cast a)+----------------------------------------------------------------------------+withString :: (Quote m, Typeable a) => a -> Maybe (m Exp)+withString a = liftString <$> cast a+----------------------------------------------------------------------------+-- | Use `isPrefixOf` as you traverse the string in lex order and do a replace+formatVars :: MisoString -> [(MisoString, MisoString)] -> MisoString+formatVars s [] = s+formatVars s table@((var,key):xs) =+  case MS.uncons s of+    Nothing ->+      mempty+    Just ('$', cs) -> do+      let needle = "{" <> var <> "}"+      if needle `MS.isPrefixOf` cs+        then+          formatVars (key <> MS.drop (MS.length needle) cs) xs+        else+          formatVars cs table+    Just (c,cs) ->+      MS.cons c (formatVars cs table)+----------------------------------------------------------------------------+keys :: [MisoString]+keys = do+  (x,y) <- (,) <$> ['a'..'z'] <*> ['0'..'9']+  pure (MS.pack [x,y])+----------------------------------------------------------------------------+typeCheck :: [MisoString] -> Q [(MisoString, MisoString)]+typeCheck vars = do+  forM (Prelude.zip vars keys) $ \(var, key) ->+    lookupValueName (MS.unpack var) >>= \case+      Nothing -> fail (MS.unpack var <> " is not in scope")+      Just _ -> pure (var, key)+---------------------------------------------------------------------------+getVariables :: MisoString -> [MisoString]+getVariables s =+  case runLexer lexer (mkStream s) of+    Left _ -> mempty+    Right (xs,_) -> xs+  where+    varLexer :: Lexer MisoString+    varLexer = do+      void (string "${")+      xs <- some $ satisfy (/= '}')+      void (char '}')+      pure (MS.pack xs)++    anything :: Lexer MisoString+    anything = mempty <$ satisfy (const True)++    lexer :: Lexer [MisoString]+    lexer = Prelude.filter (/="") <$>+      many (varLexer <|> anything)+----------------------------------------------------------------------------
+ src/Miso/Fetch.hs view
@@ -0,0 +1,703 @@+-----------------------------------------------------------------------------+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Fetch+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Interface to the browser's+-- <https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API Fetch API>+-- for making HTTP requests inside Miso's 'Effect' monad.+--+-- 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+    getJSON+  , postJSON+  , postJSON'+  , putJSON+  -- ** Text+  , getText+  , postText+  , putText+  -- ** Blob+  , getBlob+  , postBlob+  , putBlob+  -- ** FormData+  , getFormData+  , postFormData+  , putFormData+  -- ** Uint8Array+  , getUint8Array+  , postUint8Array+  , putUint8Array+  -- ** Image+  , postImage+  , putImage+  -- ** ArrayBuffer+  , getArrayBuffer+  , postArrayBuffer+  , putArrayBuffer+    -- ** Header helpers+  , accept+  , contentType+  , applicationJSON+  , textPlain+  , formData+    -- ** Types+  , Body+  , Response (..)+  , CONTENT_TYPE (..)+    -- ** Internal+  , fetch+  ) where+----------------------------------------------------------------------------+import           Miso.JSON+import qualified Data.Map.Strict as M+----------------------------------------------------------------------------+import           Miso.DSL (toJSVal, FromJSVal(..), JSVal)+import qualified Miso.FFI.Internal as FFI+import           Miso.Effect (Effect, withSink)+import           Miso.String (MisoString, ms)+import           Miso.Util ((=:))+import           Miso.FFI.Internal (Response(..), Blob, FormData, ArrayBuffer, Uint8Array, Image, fetch, CONTENT_TYPE(..))+----------------------------------------------------------------------------+-- | Retrieve a JSON resource via GET.+--+-- @+-- data Action+--  = FetchGitHub+--  | SetGitHub GitHub+--  | ErrorHandler MisoString+--  deriving (Show, Eq)+--+-- updateModel :: Action -> Effect Model Action+-- updateModel = \case+--   FetchGitHub -> getJSON "https://api.github.com" [] SetGitHub ErrorHandler+--   SetGitHub apiInfo -> info ?= apiInfo+--   ErrorHandler msg -> io_ (consoleError msg)+-- @+--+getJSON+  :: (FromJSON body, FromJSVal error)+  => MisoString+  -- ^ url+  -> [(MisoString, MisoString)]+  -- ^ headers+  -> (Response body -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+getJSON url headers_ successful errorful =+  withSink $ \sink ->+    FFI.fetch url "GET" Nothing jsonHeaders+      (handleJSON sink)+      (sink . errorful)+      JSON -- dmj: expected return type+  where+    jsonHeaders = biasHeaders headers_ [accept =: applicationJSON]+    handleJSON sink resp@Response {..} =+      fmap fromJSON <$> fromJSVal body >>= \case+        Nothing -> do+          err <- fromJSValUnchecked body+          sink $ errorful $ Response+            { body = err+            , errorMessage = Just "Not a valid JSON object"+            , ..+            }+        Just (Success result) ->+          sink $ successful resp { body = result }+        Just (Error msg) -> do+          err <- fromJSValUnchecked body+          sink $ errorful $ Response+            { body = err+            , errorMessage = Just (ms msg)+            , ..+            }+----------------------------------------------------------------------------+-- | 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+  -- ^ url+  -> body+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+postJSON url body_ headers_ successful errorful =+  withSink $ \sink -> do+    bodyVal <- toJSVal (encode body_)+    FFI.fetch url "POST" (Just bodyVal) jsonHeaders_+      (sink . successful)+      (sink . errorful)+      NONE+  where+    jsonHeaders_ = biasHeaders headers_ [contentType =: applicationJSON]+----------------------------------------------------------------------------+-- | 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+  -- ^ url+  -> body+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response return -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+postJSON' url body_ headers_ successful errorful =+  withSink $ \sink -> do+    bodyVal <- toJSVal (encode body_)+    FFI.fetch url "POST" (Just bodyVal) jsonHeaders_+      (handleJSON sink)+      (sink . errorful)+      JSON+  where+    jsonHeaders_ = biasHeaders headers_ [contentType =: applicationJSON, accept =: applicationJSON]+    handleJSON sink resp@Response {..} =+      fmap fromJSON <$> fromJSVal body >>= \case+        Nothing -> do+          err <- fromJSValUnchecked body+          sink $ errorful $ Response+            { body = err+            , errorMessage = Just "Not a valid JSON object"+            , ..+            }+        Just (Success result) ->+          sink $ successful resp { body = result }+        Just (Error msg) -> do+          err <- fromJSValUnchecked body+          sink $ errorful $ Response+            { body = err+            , errorMessage = Just (ms msg)+            , ..+            }+----------------------------------------------------------------------------+-- | 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+  -- ^ url+  -> body+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+putJSON url body_ headers_ successful errorful =+  withSink $ \sink -> do+    bodyVal <- toJSVal (encode body_)+    FFI.fetch url "PUT" (Just bodyVal) jsonHeaders_+      (sink . successful)+      (sink . errorful)+      NONE+  where+    jsonHeaders_ = biasHeaders headers_ [contentType =: applicationJSON]+----------------------------------------------------------------------------+-- | Retrieve a plain-text resource via GET.+--+-- Sets @Accept: text\/plain@ automatically. The response body is delivered as+-- a 'MisoString'.+getText+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response MisoString -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+getText url headers_ successful errorful =+  withSink $ \sink ->+    FFI.fetch url "GET" Nothing textHeaders_+      (sink . successful)+      (sink . errorful)+      TEXT -- dmj: expected return type+  where+    textHeaders_ = biasHeaders headers_ [accept =: textPlain]+----------------------------------------------------------------------------+-- | Send a POST request with a plain-text body; ignores the response body.+--+-- Sets @Content-Type: text\/plain@ automatically.+postText+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> MisoString+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+postText url body_ headers_ successful errorful =+  withSink $ \sink -> do+    bodyVal <- toJSVal (encode body_)+    FFI.fetch url "POST" (Just bodyVal) textHeaders_+      (sink . successful)+      (sink . errorful)+      NONE+  where+    textHeaders_ = biasHeaders headers_ [contentType =: textPlain]+----------------------------------------------------------------------------+-- | Send a PUT request with a plain-text body; ignores the response body.+--+-- Sets @Content-Type: text\/plain@ automatically.+putText+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> MisoString+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+putText url imageBody headers_ successful errorful =+  withSink $ \sink -> do+    body_ <- toJSVal imageBody+    FFI.fetch url "PUT" (Just body_) textHeaders_+      (sink . successful)+      (sink . errorful)+      NONE+  where+    textHeaders_ = biasHeaders headers_ [contentType =: textPlain]+----------------------------------------------------------------------------+-- | Retrieve a binary resource as a 'Blob' via GET.+--+-- Sets @Accept: application\/octet-stream@ automatically.+getBlob+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response Blob -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+getBlob url headers_ successful errorful =+  withSink $ \sink ->+    FFI.fetch url "GET" Nothing blobHeaders_+      (sink . successful)+      (sink . errorful)+      BLOB -- dmj: expected return type+  where+    blobHeaders_ = biasHeaders headers_ [accept =: octetStream]+----------------------------------------------------------------------------+-- | Send a POST request with a 'Blob' body; ignores the response body.+--+-- Sets @Content-Type: application\/octet-stream@ automatically.+postBlob+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> Blob+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+postBlob url body_ headers_ successful errorful =+  withSink $ \sink -> do+    bodyVal <- toJSVal body_+    FFI.fetch url "POST" (Just bodyVal) blobHeaders_+      (sink . successful)+      (sink . errorful)+      NONE+  where+    blobHeaders_ = biasHeaders headers_ [contentType =: octetStream]+----------------------------------------------------------------------------+-- | Send a PUT request with a 'Blob' body; ignores the response body.+--+-- Sets @Content-Type: application\/octet-stream@ automatically.+putBlob+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> Blob+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+putBlob url imageBody headers_ successful errorful =+  withSink $ \sink -> do+    body_ <- toJSVal imageBody+    FFI.fetch url "PUT" (Just body_) blobHeaders_+      (sink . successful)+      (sink . errorful)+      NONE+  where+    blobHeaders_ = biasHeaders headers_ [contentType =: octetStream]+----------------------------------------------------------------------------+-- | Retrieve a multipart resource as 'FormData' via GET.+--+-- Sets @Accept: multipart\/form-data@ automatically.+getFormData+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response FormData -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+getFormData url headers_ successful errorful =+  withSink $ \sink ->+    FFI.fetch url "GET" Nothing formDataHeaders_+      (sink . successful)+      (sink . errorful)+      FORM_DATA -- dmj: expected return type+  where+    formDataHeaders_ = biasHeaders headers_ [accept =: formData]+----------------------------------------------------------------------------+-- | Send a POST request with a 'FormData' body; ignores the response body.+--+-- Sets @Content-Type: multipart\/form-data@ automatically.+postFormData+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> FormData+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action +postFormData url body_ headers_ successful errorful =+  withSink $ \sink -> do+    bodyVal <- toJSVal body_+    FFI.fetch url "POST" (Just bodyVal) formDataHeaders_+      (sink . successful)+      (sink . errorful)+      NONE+  where+    formDataHeaders_ = biasHeaders headers_ [contentType =: formData]+----------------------------------------------------------------------------+-- | Send a PUT request with a 'FormData' body; ignores the response body.+--+-- Sets @Content-Type: multipart\/form-data@ automatically.+putFormData+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> FormData+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error  -> action)+  -- ^ errorful callback+  -> Effect parent props model action+putFormData url imageBody headers_ successful errorful =+  withSink $ \sink -> do+    body_ <- toJSVal imageBody+    FFI.fetch url "PUT" (Just body_) formDataHeaders_+      (sink . successful)+      (sink . errorful)+      NONE+  where+    formDataHeaders_ = biasHeaders headers_ [contentType =: formData]+----------------------------------------------------------------------------+-- | Retrieve a binary resource as an 'ArrayBuffer' via GET.+--+-- Sets @Accept: application\/octet-stream@ automatically.+getArrayBuffer+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response ArrayBuffer -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+getArrayBuffer url headers_ successful errorful =+  withSink $ \sink ->+    FFI.fetch url "GET" Nothing arrayBufferHeaders_+      (sink . successful)+      (sink . errorful)+      ARRAY_BUFFER -- dmj: expected return type+  where+    arrayBufferHeaders_ = biasHeaders headers_ [accept =: octetStream]+----------------------------------------------------------------------------+-- | Send a POST request with an 'ArrayBuffer' body; ignores the response body.+--+-- Sets @Content-Type: application\/octet-stream@ automatically.+postArrayBuffer+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> ArrayBuffer+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+postArrayBuffer url body_ headers_ successful errorful =+  withSink $ \sink -> do+    bodyVal <- toJSVal body_+    FFI.fetch url "POST" (Just bodyVal) arrayBufferHeaders_+      (sink . successful)+      (sink . errorful)+      NONE+  where+    arrayBufferHeaders_ = biasHeaders headers_ [contentType =: octetStream]+----------------------------------------------------------------------------+-- | Send a PUT request with an 'ArrayBuffer' body; ignores the response body.+--+-- Sets @Content-Type: application\/octet-stream@ automatically.+putArrayBuffer+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> ArrayBuffer+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+putArrayBuffer url arrayBuffer_ headers_ successful errorful =+  withSink $ \sink -> do+    body_ <- toJSVal arrayBuffer_+    FFI.fetch url "PUT" (Just body_) arrayBufferHeaders_+      (sink . successful)+      (sink . errorful)+      NONE+  where+    arrayBufferHeaders_ = biasHeaders headers_ [contentType =: octetStream]+----------------------------------------------------------------------------+-- | Retrieve a binary resource as a 'Uint8Array' via GET.+--+-- Sets @Accept: application\/octet-stream@ automatically.+getUint8Array+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response Uint8Array -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+getUint8Array url headers_ successful errorful =+  withSink $ \sink ->+    FFI.fetch url "GET" Nothing uint8ArrayHeaders_+      (sink . successful)+      (sink . errorful)+      BYTES -- expected return type+  where+    uint8ArrayHeaders_ = biasHeaders headers_ [accept =: octetStream]+----------------------------------------------------------------------------+-- | Send a POST request with a 'Uint8Array' body; ignores the response body.+--+-- Sets @Content-Type: application\/octet-stream@ automatically.+postUint8Array+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> Uint8Array+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+postUint8Array url body_ headers_ successful errorful =+  withSink $ \sink -> do+    bodyVal <- toJSVal body_+    FFI.fetch url "POST" (Just bodyVal) uint8ArrayHeaders_+      (sink . successful)+      (sink . errorful)+      NONE+  where+    uint8ArrayHeaders_ = biasHeaders headers_ [contentType =: octetStream]+----------------------------------------------------------------------------+-- | Send a PUT request with a 'Uint8Array' body; ignores the response body.+--+-- Sets @Content-Type: application\/octet-stream@ automatically.+putUint8Array+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> Uint8Array+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+putUint8Array url uint8Array_ headers_ successful errorful =+  withSink $ \sink -> do+    body_ <- toJSVal uint8Array_+    FFI.fetch url "PUT" (Just body_) uint8ArrayHeaders_+      (sink . successful)+      (sink . errorful)+      NONE+  where+    uint8ArrayHeaders_ = biasHeaders headers_ [contentType =: octetStream]+----------------------------------------------------------------------------+-- | Send a POST request with an 'Image' body; ignores the response body.+postImage+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> Image+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+postImage url body_ headers_ successful errorful =+  withSink $ \sink -> do+    bodyVal <- toJSVal body_+    FFI.fetch url "POST" (Just bodyVal) headers_+      (sink . successful)+      (sink . errorful)+      NONE+----------------------------------------------------------------------------+-- | Send a PUT request with an 'Image' body; ignores the response body.+putImage+  :: FromJSVal error+  => MisoString+  -- ^ url+  -> Image+  -- ^ Body+  -> [(MisoString, MisoString)]+  -- ^ headers_+  -> (Response () -> action)+  -- ^ successful callback+  -> (Response error -> action)+  -- ^ errorful callback+  -> Effect parent props model action+putImage url imageBody headers_ successful errorful =+  withSink $ \sink -> do+    body_ <- toJSVal imageBody+    FFI.fetch url "PUT" (Just body_) headers_+      (sink . successful)+      (sink . errorful)+      NONE+----------------------------------------------------------------------------+-- | Type synonym for a raw JavaScript request body.+type Body = JSVal+----------------------------------------------------------------------------+-- | HTTP header name @\"Accept\"@.+-- Use with '=:' to build request headers, e.g. @accept =: applicationJSON@.+accept :: MisoString+accept = "Accept"+----------------------------------------------------------------------------+-- | HTTP header name @\"Content-Type\"@.+-- Use with '=:' to build request headers, e.g. @contentType =: textPlain@.+contentType :: MisoString+contentType = "Content-Type"+----------------------------------------------------------------------------+-- | MIME type @\"application\/json\"@.+applicationJSON :: MisoString+applicationJSON = "application/json"+----------------------------------------------------------------------------+-- | MIME type @\"text\/plain\"@.+textPlain :: MisoString+textPlain = "text/plain"+----------------------------------------------------------------------------+-- | MIME type @\"application\/octet-stream\"@. Used for binary payloads.+octetStream :: MisoString+octetStream = "application/octet-stream"+----------------------------------------------------------------------------+-- | MIME type @\"multipart\/form-data\"@.+formData :: MisoString+formData = "multipart/form-data"+----------------------------------------------------------------------------+-- | 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+  $ M.fromList userDefined <> M.fromList contentSpecific+----------------------------------------------------------------------------
src/Miso/Html.hs view
@@ -1,40 +1,89 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Miso.Html--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- 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"+-- import "Miso.Html.Property" ('Miso.Html.Property.class_') ----- data IntAction = Add | Subtract+-- data Action = Increment | Decrement | Reset ----- intView :: Int -> View IntAction--- intView n = div_ [ class_ "main" ] [---    btn_ [ onClick Add ] [ text_ "+" ]---  , text_ $ pack (show n)---  , btn_ [ 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 ----- <http://github.com/dmjio/miso>+-- ["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 <http://github.com/dmjio/miso>.+-- ---------------------------------------------------------------------------- module Miso.Html-   ( module Miso.Html.Element+   ( -- * Elements+     module Miso.Html.Element+     -- * Events    , module Miso.Html.Event-   , module Miso.Html.Internal-   , module Miso.Html.Property+     -- * Rendering+   , module Miso.Html.Render    ) where--import Miso.Html.Element hiding (style_)+-----------------------------------------------------------------------------+import Miso.Html.Element import Miso.Html.Event-import Miso.Html.Internal hiding (textRaw)-import Miso.Html.Property hiding (form_)+import Miso.Html.Render+-----------------------------------------------------------------------------
src/Miso/Html/Element.hs view
@@ -1,508 +1,653 @@+-----------------------------------------------------------------------------+{-# LANGUAGE CPP               #-}+{-# LANGUAGE LambdaCase        #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module      :  Miso.Html.Element--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- Stability   :  experimental -- Portability :  non-portable-----------------------------------------------------------------------------+--+-- = Overview+--+-- "Miso.Html.Element" provides smart constructors for every+-- <https://developer.mozilla.org/en-US/docs/Web/HTML/Element HTML element>.+-- 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-  ( -- * Construct an Element+  ( -- ** Smart constructors       nodeHtml-    , nodeHtmlKeyed-    -- * Headers+    -- ** Document metadata+    , html_+    , doctype_+    , base_+    , head_+    , link_+    , meta_+    , style_+    , title_+    -- ** Sectioning root+    , body_+    -- ** Content sectioning+    , address_+    , article_+    , aside_+    , footer_+    , header_     , h1_     , h2_     , h3_     , h4_     , h5_     , h6_-    -- * Grouping Content+    , hgroup_+    , main_+    , nav_+    , section_+    , search_+    -- ** Text content+    , blockquote_+    , dd_     , div_-    , p_+    , dl_+    , dt_+    , figcaption_+    , figure_     , hr_+    , li_+    , menu_+    , ol_+    , p_     , pre_-    , blockquote_-    -- * Text+    , ul_+    -- ** Inline text semantics+    , a_+    , abbr_+    , b_+    , bdi_+    , bdo_+    , br_+    , cite_     , code_+    , data_+    , dfn_     , em_+    , i_+    , kbd_+    , mark_+    , q_+    , rp_+    , rt_+    , ruby_+    , s_+    , samp_+    , small_     , span_-    , a_     , strong_-    , i_-    , b_-    , u_     , sub_     , sup_-    , br_-    -- * Lists-    , ol_-    , ul_-    , li_-    , liKeyed_-    , dl_-    , dt_-    , dd_-    -- * Embedded Content+    , time_+    , u_+    , var_+    , wbr_+    -- ** Image and multimedia+    , area_+    , audio_     , img_+    , map_+    , track_+    , video_+    -- ** Embedded content+    , embed_+    , fencedframe_     , iframe_+    , object_+    , picture_+    , source_+    -- ** Scripting     , canvas_-    , math_+    , noscript_     , script_-    , link_-    , Miso.Html.Element.style_-    -- * Inputs-    , select_-    , option_-    , textarea_-    , form_-    , input_-    , button_-    -- * Sections-    , section_-    , header_-    , footer_-    , nav_-    , article_-    , aside_-    , address_-    , main_-    , body_-    -- * Figures-    , figure_-    , figcaption_-    -- * Tables-    , table_+    -- ** Demarcating edits+    , del_+    , ins_+    -- ** Table content     , caption_-    , colgroup_     , col_+    , colgroup_+    , table_     , tbody_-    , thead_-    , tfoot_-    , tr_-    , trKeyed_     , td_+    , tfoot_     , th_-    -- * Less common elements-    , label_+    , thead_+    , tr_+    -- ** Forms+    , button_+    , datalist_     , fieldset_+    , form_+    , input_+    , label_     , legend_-    , datalist_+    , meter_     , optgroup_-    , keygen_+    , option_     , output_     , progress_-    , meter_-    , center_-    -- * Audio and Video-    , audio_-    , video_-    , source_-    , track_-    -- * Embedded objects-    , embed_-    , object_-    , param_-    -- * Text edits-    , ins_-    , del_-    -- * Semantic text-    , small_-    , cite_-    , dfn_-    , abbr_-    , time_-    , var_-    , samp_-    , kbd_-    , q_-    , s_-    -- * Less common tags-    , mark_-    , ruby_-    , rt_-    , rp_-    , bdi_-    , bdo_-    , wbr_-    -- * Interactive elements+    , select_+    , textarea_+    -- ** Interactive elements     , details_+    , dialog_     , summary_-    , menuitem_-    , menu_+    -- ** Web components+    , slot_+    , template_+    -- * SVG+    , svg_     ) where--import           Miso.Html.Internal-import           Miso.String (MisoString)---- | Used to construct `VNode`'s in `View`-nodeHtml :: MisoString -> [Attribute action] -> [View action] -> View action-nodeHtml = flip (node HTML) Nothing---- | Construct a node with a `Key`-nodeHtmlKeyed :: MisoString -> Key -> [Attribute action] -> [View action] -> View action-nodeHtmlKeyed name = node HTML name . pure---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/div-div_ :: [Attribute action] -> [View action] -> View action-div_  = nodeHtml "div"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/table-table_ :: [Attribute action] -> [View action] -> View action-table_  = nodeHtml "table"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/thead-thead_ :: [Attribute action] -> [View action] -> View action-thead_  = nodeHtml "thead"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/tbody-tbody_ :: [Attribute action] -> [View action] -> View action-tbody_  = nodeHtml "tbody"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/tr-tr_ :: [Attribute action] -> [View action] -> View action-tr_  = nodeHtml "tr"---- | Contains `Key`, inteded to be used for child replacement patch------ <https://developer.mozilla.org/en-US/docs/Web/HTML/Element/tr>--trKeyed_ :: Key -> [Attribute action] -> [View action] -> View action-trKeyed_ = node HTML "tr" . pure---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/th-th_ :: [Attribute action] -> [View action] -> View action-th_  = nodeHtml "th"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/td-td_ :: [Attribute action] -> [View action] -> View action-td_  = nodeHtml "td"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/tfoot-tfoot_ :: [Attribute action] -> [View action] -> View action-tfoot_  = nodeHtml "tfoot"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/section-section_ :: [Attribute action] -> [View action] -> View action-section_  = nodeHtml "section"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/header-header_ :: [Attribute action] -> [View action] -> View action-header_  = nodeHtml "header"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/footer-footer_ :: [Attribute action] -> [View action] -> View action-footer_  = nodeHtml "footer"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/button-button_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+#ifdef VANILLA+import           Miso.JSON (Value(String))+#endif+import           Miso.Types+-----------------------------------------------------------------------------+import           Miso.Svg.Element (svg_)+-----------------------------------------------------------------------------+-- | Low-level helper used to construct 'HTML' 'node' in 'Miso.Types.View'.+-- Almost all functions in this module, like 'div_', 'table_' etc. are defined in terms of it.+nodeHtml :: MisoString -> [Attribute action] -> [View model action] -> View model action+nodeHtml nodeName = node HTML nodeName+-----------------------------------------------------------------------------+-- | [\<div\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/div)+div_ :: [Attribute action] -> [View model action] -> View model action+div_ = nodeHtml "div"+-----------------------------------------------------------------------------+-- | [\<table\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/table)+table_ :: [Attribute action] -> [View model action] -> View model action+table_ = nodeHtml "table"+-----------------------------------------------------------------------------+-- | [\<thead\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/thead)+thead_ :: [Attribute action] -> [View model action] -> View model action+thead_ = nodeHtml "thead"+-----------------------------------------------------------------------------+-- | [\<tbody\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/tbody)+tbody_ :: [Attribute action] -> [View model action] -> View model action+tbody_ = nodeHtml "tbody"+-----------------------------------------------------------------------------+-- | [\<tr\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/tr)+tr_ :: [Attribute action] -> [View model action] -> View model action+tr_ = nodeHtml "tr"+-----------------------------------------------------------------------------+-- | [\<th\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/th)+th_ :: [Attribute action] -> [View model action] -> View model action+th_ = nodeHtml "th"+-----------------------------------------------------------------------------+-- | [\<td\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/td)+td_ :: [Attribute action] -> [View model action] -> View model action+td_ = nodeHtml "td"+-----------------------------------------------------------------------------+-- | [\<tfoot\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/tfoot)+tfoot_ :: [Attribute action] -> [View model action] -> View model action+tfoot_ = nodeHtml "tfoot"+-----------------------------------------------------------------------------+-- | [\<section\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/section)+section_ :: [Attribute action] -> [View model action] -> View model action+section_ = nodeHtml "section"+-----------------------------------------------------------------------------+-- | [\<header\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/header)+header_ :: [Attribute action] -> [View model action] -> View model action+header_ = nodeHtml "header"+-----------------------------------------------------------------------------+-- | [\<footer\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/footer)+footer_ :: [Attribute action] -> [View model action] -> View model action+footer_ = nodeHtml "footer"+-----------------------------------------------------------------------------+-- | [\<button\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/button)+button_ :: [Attribute action] -> [View model action] -> View model action button_ = nodeHtml "button"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/form-form_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<form\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/form)+--+-- For usage in a real-world application with the @onSubmit@ event.+--+-- > view :: Model -> View model action+-- > view model = form_ [ onSubmit NoOp ] [ input [ type_ "submit" ] ]+--+-- Note: @onSubmit@ will use @preventDefault = True@. This will keep+-- the form from submitting to the server.+--+form_ :: [Attribute action] -> [View model action] -> View model action form_ = nodeHtml "form"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/p-p_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<p\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/p)+p_ :: [Attribute action] -> [View model action] -> View model action p_ = nodeHtml "p"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/s-s_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<s\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/s)+s_ :: [Attribute action] -> [View model action] -> View model action s_ = nodeHtml "s"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/ul-ul_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<ul\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/ul)+ul_ :: [Attribute action] -> [View model action] -> View model action ul_ = nodeHtml "ul"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/span-span_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<span\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/span)+span_ :: [Attribute action] -> [View model action] -> View model action span_ = nodeHtml "span"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/strong-strong_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<strong\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/strong)+strong_ :: [Attribute action] -> [View model action] -> View model action strong_ = nodeHtml "strong"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/li-li_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<li\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/li)+li_ :: [Attribute action] -> [View model action] -> View model action li_ = nodeHtml "li"---- | Contains `Key`, inteded to be used for child replacement patch------ <https://developer.mozilla.org/en-US/docs/Web/HTML/Element/li>----liKeyed_ :: Key -> [Attribute action] -> [View action] -> View action-liKeyed_ = node HTML "li" . pure---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h1-h1_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<h1\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/Heading_Elements)+h1_ :: [Attribute action] -> [View model action] -> View model action h1_ = nodeHtml "h1"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h2-h2_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<h2\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/Heading_Elements)+h2_ :: [Attribute action] -> [View model action] -> View model action h2_ = nodeHtml "h2"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h3-h3_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<h3\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/Heading_Elements)+h3_ :: [Attribute action] -> [View model action] -> View model action h3_ = nodeHtml "h3"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h4-h4_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<h4\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/Heading_Elements)+h4_ :: [Attribute action] -> [View model action] -> View model action h4_ = nodeHtml "h4"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h5-h5_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<h5\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/Heading_Elements)+h5_ :: [Attribute action] -> [View model action] -> View model action h5_ = nodeHtml "h5"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h6-h6_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<h6\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/Heading_Elements)+h6_ :: [Attribute action] -> [View model action] -> View model action h6_ = nodeHtml "h6"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/hr-hr_ :: [Attribute action] -> View action+-----------------------------------------------------------------------------+-- | [\<hr\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/hr)+hr_ :: [Attribute action] -> View model action hr_ = flip (nodeHtml "hr") []---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/pre-pre_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<pre\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/pre)+pre_ :: [Attribute action] -> [View model action] -> View model action pre_ = nodeHtml "pre"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input-input_ :: [Attribute action] -> View action+-----------------------------------------------------------------------------+-- | [\<input\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/input)+input_ :: [Attribute action] -> View model action input_ = flip (nodeHtml "input") []---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/label-label_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<label\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/label)+label_ :: [Attribute action] -> [View model action] -> View model action label_ = nodeHtml "label"---- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/a-a_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<a\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/a)+a_ :: [Attribute action] -> [View model action] -> View model action a_ = nodeHtml "a"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/mark-mark_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<mark\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/mark)+mark_ :: [Attribute action] -> [View model action] -> View model action mark_ = nodeHtml "mark"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/ruby-ruby_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<ruby\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/ruby)+ruby_ :: [Attribute action] -> [View model action] -> View model action ruby_ = nodeHtml "ruby"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/rt-rt_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<rt\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/rt)+rt_ :: [Attribute action] -> [View model action] -> View model action rt_ = nodeHtml "rt"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/rp-rp_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<rp\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/rp)+rp_ :: [Attribute action] -> [View model action] -> View model action rp_ = nodeHtml "rp"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/bdi-bdi_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<bdi\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/bdi)+bdi_ :: [Attribute action] -> [View model action] -> View model action bdi_ = nodeHtml "bdi"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/bdo-bdo_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<bdo\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/bdo)+bdo_ :: [Attribute action] -> [View model action] -> View model action bdo_ = nodeHtml "bdo"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/wbr-wbr_ :: [Attribute action] -> View action+-----------------------------------------------------------------------------+-- | [\<wbr\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/wbr)+wbr_ :: [Attribute action] -> View model action wbr_ = flip (nodeHtml "wbr") []--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details-details_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<details\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/details)+details_ :: [Attribute action] -> [View model action] -> View model action details_ = nodeHtml "details"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/summary-summary_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<summary\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/summary)+summary_ :: [Attribute action] -> [View model action] -> View model action summary_ = nodeHtml "summary"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/menuitem-menuitem_ :: [Attribute action] -> [View action] -> View action-menuitem_ = nodeHtml "menuitem"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/menu-menu_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<menu\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/menu)+menu_ :: [Attribute action] -> [View model action] -> View model action menu_ = nodeHtml "menu"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/fieldset-fieldset_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<fieldset\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/fieldset)+fieldset_ :: [Attribute action] -> [View model action] -> View model action fieldset_ = nodeHtml "fieldset"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/legend-legend_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<legend\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/legend)+legend_ :: [Attribute action] -> [View model action] -> View model action legend_ = nodeHtml "legend"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/datalist-datalist_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<datalist\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/datalist)+datalist_ :: [Attribute action] -> [View model action] -> View model action datalist_ = nodeHtml "datalist"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/optgroup-optgroup_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<optgroup\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/optgroup)+optgroup_ :: [Attribute action] -> [View model action] -> View model action optgroup_ = nodeHtml "optgroup"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/keygen-keygen_ :: [Attribute action] -> [View action] -> View action-keygen_ = nodeHtml "keygen"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/output-output_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<output\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/output)+output_ :: [Attribute action] -> [View model action] -> View model action output_ = nodeHtml "output"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/progress-progress_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<progress\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/progress)+progress_ :: [Attribute action] -> [View model action] -> View model action progress_ = nodeHtml "progress"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/meter-meter_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<meter\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/meter)+meter_ :: [Attribute action] -> [View model action] -> View model action meter_ = nodeHtml "meter"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/center-center_ :: [Attribute action] -> [View action] -> View action-center_ = nodeHtml "center"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/audio-audio_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<audio\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/audio)+audio_ :: [Attribute action] -> [View model action] -> View model action audio_ = nodeHtml "audio"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/video-video_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<video\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/video)+video_ :: [Attribute action] -> [View model action] -> View model action video_ = nodeHtml "video"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/source-source_ :: [Attribute action] -> View action+-----------------------------------------------------------------------------+-- | [\<source\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/source)+source_ :: [Attribute action] -> View model action source_ = flip (nodeHtml "source") []--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/track-track_ :: [Attribute action] -> View action+-----------------------------------------------------------------------------+-- | [\<track\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/track)+track_ :: [Attribute action] -> View model action track_ = flip (nodeHtml "track") []--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/embed-embed_ :: [Attribute action] -> View action+-----------------------------------------------------------------------------+-- | [\<embed\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/embed)+embed_ :: [Attribute action] -> View model action embed_ = flip (nodeHtml "embed") []--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/object-object_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<object\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/object)+object_ :: [Attribute action] -> [View model action] -> View model action object_ = nodeHtml "object"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/param-param_ :: [Attribute action] -> View action-param_ = flip (nodeHtml "param") []--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/ins-ins_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<ins\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/ins)+ins_ :: [Attribute action] -> [View model action] -> View model action ins_ = nodeHtml "ins"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/del-del_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<del\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/del)+del_ :: [Attribute action] -> [View model action] -> View model action del_ = nodeHtml "del"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/small-small_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<small\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/small)+small_ :: [Attribute action] -> [View model action] -> View model action small_ = nodeHtml "small"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/cite-cite_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<cite\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/cite)+cite_ :: [Attribute action] -> [View model action] -> View model action cite_ = nodeHtml "cite"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/dfn-dfn_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<dfn\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/dfn)+dfn_ :: [Attribute action] -> [View model action] -> View model action dfn_ = nodeHtml "dfn"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/abbr-abbr_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<abbr\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/abbr)+abbr_ :: [Attribute action] -> [View model action] -> View model action abbr_ = nodeHtml "abbr"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/time-time_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<time\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/time)+time_ :: [Attribute action] -> [View model action] -> View model action time_ = nodeHtml "time"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/var-var_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<var\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/var)+var_ :: [Attribute action] -> [View model action] -> View model action var_ = nodeHtml "var"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/samp-samp_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<samp\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/samp)+samp_ :: [Attribute action] -> [View model action] -> View model action samp_ = nodeHtml "samp"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/kbd-kbd_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<kbd\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/kbd)+kbd_ :: [Attribute action] -> [View model action] -> View model action kbd_ = nodeHtml "kbd"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/caption-caption_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<caption\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/caption)+caption_ :: [Attribute action] -> [View model action] -> View model action caption_ = nodeHtml "caption"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/colgroup-colgroup_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<colgroup\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/colgroup)+colgroup_ :: [Attribute action] -> [View model action] -> View model action colgroup_ = nodeHtml "colgroup"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/col-col_ :: [Attribute action] -> View action+-----------------------------------------------------------------------------+-- | [\<col\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/col)+col_ :: [Attribute action] -> View model action col_ = flip (nodeHtml "col") []--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/nav-nav_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<nav\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/nav)+nav_ :: [Attribute action] -> [View model action] -> View model action nav_ = nodeHtml "nav"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/article-article_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<article\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/article)+article_ :: [Attribute action] -> [View model action] -> View model action article_ = nodeHtml "article"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/aside-aside_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<aside\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/aside)+aside_ :: [Attribute action] -> [View model action] -> View model action aside_ = nodeHtml "aside"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/address-address_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<address\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/address)+address_ :: [Attribute action] -> [View model action] -> View model action address_ = nodeHtml "address"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/main-main_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<main\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/main)+main_ :: [Attribute action] -> [View model action] -> View model action main_ = nodeHtml "main"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/body-body_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<body\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/body)+body_ :: [Attribute action] -> [View model action] -> View model action body_ = nodeHtml "body"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/figure-figure_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<figure\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/figure)+figure_ :: [Attribute action] -> [View model action] -> View model action figure_ = nodeHtml "figure"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/figcaption-figcaption_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<figcaption\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/figcaption)+figcaption_ :: [Attribute action] -> [View model action] -> View model action figcaption_ = nodeHtml "figcaption"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/dl-dl_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<dl\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/dl)+dl_ :: [Attribute action] -> [View model action] -> View model action dl_ = nodeHtml "dl"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/dt-dt_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<dt\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/dt)+dt_ :: [Attribute action] -> [View model action] -> View model action dt_ = nodeHtml "dt"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/dd-dd_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<dd\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/dd)+dd_ :: [Attribute action] -> [View model action] -> View model action dd_ = nodeHtml "dd"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/img-img_ :: [Attribute action] -> View action+-----------------------------------------------------------------------------+-- | [\<img\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/img)+img_ :: [Attribute action] -> View model action img_ = flip (nodeHtml "img") []--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/iframe-iframe_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<iframe\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/iframe)+iframe_ :: [Attribute action] -> [View model action] -> View model action iframe_ = nodeHtml "iframe"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/canvas-canvas_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<canvas\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/canvas)+--+-- Note this just renders a canvas element.+-- See also 'Miso.Canvas.canvas_' which supports canvas drawing DSL.+canvas_ :: [Attribute action] -> [View model action] -> View model action canvas_ = nodeHtml "canvas"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/math-math_ :: [Attribute action] -> [View action] -> View action-math_ = nodeHtml "math"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/select-select_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<select\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/select)+select_ :: [Attribute action] -> [View model action] -> View model action select_ = nodeHtml "select"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/option-option_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<option\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/option)+option_ :: [Attribute action] -> [View model action] -> View model action option_ = nodeHtml "option"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/textarea-textarea_ :: [Attribute action] -> [View action] -> View action-textarea_ = nodeHtml "textarea"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/sub-sub_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<textarea\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/textarea)+--+-- @+-- textarea_ [ id_ "txt", P.value_ (model ^. txt) ]+-- @+--+-- When compiling on the server, this combinator will render HTML as \<textarea\>text\<\/textarea\>.+--+-- @since 1.9.0.0+textarea_ :: [Attribute action] -> View model action+#ifdef VANILLA+textarea_ attrs = nodeHtml "textarea" newAttrs+  [ text x+  | Property "value" (String x) <- attrs+  ] where+      newAttrs = flip filter attrs $ \case+        Property "value" _ -> False+        _ -> True+#else+textarea_ = flip (nodeHtml "textarea") []+#endif+-----------------------------------------------------------------------------+-- | [\<sub\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/sub)+sub_ :: [Attribute action] -> [View model action] -> View model action sub_ = nodeHtml "sub"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/sup-sup_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<sup\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/sup)+sup_ :: [Attribute action] -> [View model action] -> View model action sup_ = nodeHtml "sup"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/br-br_ :: [Attribute action] -> View action+-----------------------------------------------------------------------------+-- | [\<br\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/br)+br_ :: [Attribute action] -> View model action br_ = flip (nodeHtml "br") []--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/ol-ol_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<ol\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/ol)+ol_ :: [Attribute action] -> [View model action] -> View model action ol_ = nodeHtml "ol"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/blockquote-blockquote_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<blockquote\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/blockquote)+blockquote_ :: [Attribute action] -> [View model action] -> View model action blockquote_ = nodeHtml "blockquote"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/code-code_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<code\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/code)+code_ :: [Attribute action] -> [View model action] -> View model action code_ = nodeHtml "code"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/em-em_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<em\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/em)+em_ :: [Attribute action] -> [View model action] -> View model action em_ = nodeHtml "em"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/i-i_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<i\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/i)+i_ :: [Attribute action] -> [View model action] -> View model action i_ = nodeHtml "i"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/b-b_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<b\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/b)+b_ :: [Attribute action] -> [View model action] -> View model action b_ = nodeHtml "b"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/u-u_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<u\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/u)+u_ :: [Attribute action] -> [View model action] -> View model action u_ = nodeHtml "u"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/q-q_ :: [Attribute action] -> [View action] -> View action+-----------------------------------------------------------------------------+-- | [\<q\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/q)+q_ :: [Attribute action] -> [View model action] -> View model action q_ = nodeHtml "q"--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/link-link_ :: [Attribute action] -> View action+-----------------------------------------------------------------------------+-- | [\<link\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/link)+link_ :: [Attribute action] -> View model action link_ = flip (nodeHtml "link") []--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/style+-----------------------------------------------------------------------------+-- | [\<style\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/style) -- -- This takes the raw text to be put in the style tag. -- -- That means that if any part of the text is not trusted there's--- a potential CSS injection. Read more at--- https://owasp.org/www-project-web-security-testing-guide/latest/4-Web_Application_Security_Testing/11-Client_Side_Testing/05-Testing_for_CSS_Injection+-- a potential [CSS injection](https://owasp.org/www-project-web-security-testing-guide/stable/4-Web_Application_Security_Testing/11-Client-side_Testing/05-Testing_for_CSS_Injection). -- -- You can also easily shoot yourself in the foot with something like: ----- @'style_' [] "\</style\>"@-style_ :: [Attribute action] -> MisoString -> View action-style_ attrs rawText = node HTML "style" Nothing attrs [textRaw rawText]--- | https://developer.mozilla.org/en-US/docs/Web/HTML/Element/script+-- @+-- style_ [] "\</style\>"+-- @ --+-- You can use 'Miso.CSS.style_' as a safer anternative.+style_ :: [Attribute action] -> MisoString -> View model action+style_ attrs rawText = node HTML "style" attrs [text rawText]+-----------------------------------------------------------------------------+-- | [\<script\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/script)+-- -- This takes the raw text to be put in the script tag. -- -- That means that if any part of the text is not trusted there's@@ -512,5 +657,100 @@ -- You can also easily shoot yourself in the foot with something like: -- -- @'script_' [] "\</script\>"@-script_ :: [Attribute action] -> MisoString -> View action-script_ attrs rawText = node HTML "script" Nothing attrs [textRaw rawText]+script_ :: [Attribute action] -> MisoString -> View model action+script_ attrs rawText = node HTML "script" attrs [textRaw rawText]+-----------------------------------------------------------------------------+-- | [\<doctype\>](https://developer.mozilla.org/en-US/docs/Glossary/Doctype)+doctype_ :: View model action+doctype_ = nodeHtml "doctype" [] []+-----------------------------------------------------------------------------+-- | [\<html\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/html)+html_ :: [Attribute action] -> [View model action] -> View model action+html_ = nodeHtml "html"+-----------------------------------------------------------------------------+-- | [\<head\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/head)+head_ :: [Attribute action] -> [View model action] -> View model action+head_ = nodeHtml "head"+-----------------------------------------------------------------------------+-- | [\<meta\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/meta)+meta_ :: [Attribute action] -> View model action+meta_ = flip (nodeHtml "meta") []+-----------------------------------------------------------------------------+-- | [\<area\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/area)+--+-- @since 1.9.0.0+area_ :: [Attribute action] -> View model action+area_ = flip (nodeHtml "area") []+-----------------------------------------------------------------------------+-- | [\<base\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/base)+--+-- @since 1.9.0.0+base_ :: [Attribute action] -> View model action+base_ = flip (nodeHtml "base") []+-----------------------------------------------------------------------------+-- | [\<data\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/data)+--+-- @since 1.9.0.0+data_ :: [Attribute action] -> [View model action] -> View model action+data_ = nodeHtml "data"+-----------------------------------------------------------------------------+-- | [\<dialog\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/dialog)+--+-- @since 1.9.0.0+dialog_ :: [Attribute action] -> [View model action] -> View model action+dialog_ = nodeHtml "dialog"+-----------------------------------------------------------------------------+-- | [\<fencedframe\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/fencedframe)+--+-- @since 1.9.0.0+fencedframe_ :: [Attribute action] -> [View model action] -> View model action+fencedframe_ = nodeHtml "fencedframe"+-----------------------------------------------------------------------------+-- | [\<hgroup\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/hgroup)+--+-- @since 1.9.0.0+hgroup_ :: [Attribute action] -> [View model action] -> View model action+hgroup_ = nodeHtml "hgroup"+-----------------------------------------------------------------------------+-- | [\<map\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/map)+--+-- @since 1.9.0.0+map_ :: [Attribute action] -> [View model action] -> View model action+map_ = nodeHtml "map"+-----------------------------------------------------------------------------+-- | [\<noscript\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/noscript)+--+-- @since 1.9.0.0+noscript_ :: [Attribute action] -> [View model action] -> View model action+noscript_ = nodeHtml "noscript"+-----------------------------------------------------------------------------+-- | [\<picture\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/picture)+--+-- @since 1.9.0.0+picture_ :: [Attribute action] -> [View model action] -> View model action+picture_ = nodeHtml "picture"+-----------------------------------------------------------------------------+-- | [\<search\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/search)+--+-- @since 1.9.0.0+search_ :: [Attribute action] -> [View model action] -> View model action+search_ = nodeHtml "search"+-----------------------------------------------------------------------------+-- | [\<slot\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/slot)+--+-- @since 1.9.0.0+slot_ :: [Attribute action] -> [View model action] -> View model action+slot_ = nodeHtml "slot"+-----------------------------------------------------------------------------+-- | [\<template\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/template)+--+-- @since 1.9.0.0+template_ :: [Attribute action] -> [View model action] -> View model action+template_ = nodeHtml "template"+-----------------------------------------------------------------------------+-- | [\<title\>](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/title)+--+-- @since 1.9.0.0+title_ :: [Attribute action] -> [View model action] -> View model action+title_ = nodeHtml "title"+-----------------------------------------------------------------------------
src/Miso/Html/Event.hs view
@@ -1,169 +1,798 @@-{-# LANGUAGE RankNTypes                #-}-{-# LANGUAGE OverloadedStrings         #-}-{-# LANGUAGE FlexibleContexts          #-}-{-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE MultiParamTypeClasses     #-}-{-# LANGUAGE DataKinds                 #-}-{-# LANGUAGE KindSignatures            #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE CPP                       #-}-{-# LANGUAGE TypeFamilies              #-} -----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+----------------------------------------------------------------------------- -- | -- Module      :  Miso.Html.Event--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- 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-  ( -- * Custom event handlers-    on-  , onWithOptions-  , Options (..)-  , defaultOptions-   -- * Mouse events-  , onClick+  ( -- *** Mouse+    onClick+  , onClickPrevent+  , onClickCapture+  , onClickWith+  , onClickWithOptions   , onDoubleClick+  , onDoubleClickWith+  , onDoubleClickWithOptions   , onMouseDown   , onMouseUp   , onMouseEnter   , onMouseLeave   , onMouseOver   , onMouseOut-  -- * Keyboard events+  , onContextMenuWithOptions+  -- *** Keyboard   , onKeyDown   , onKeyDownWithInfo   , onKeyPress   , onKeyUp-  -- * Form events+  , onEnter+  -- *** Form   , onInput+  , onInputWith   , onChange+  , onChangeWith   , onChecked   , onSubmit-  -- * Focus events+  -- *** Focus   , onBlur   , onFocus-  -- * Drag events+  -- *** Drag   , onDrag+  , onDragWithOptions   , onDragLeave+  , onDragLeaveWithOptions   , onDragEnter+  , onDragEnterWithOptions   , onDragEnd+  , onDragEndWithOptions   , onDragStart+  , onDragStartWithOptions   , onDragOver-  -- * Drop events+  , onDragOverWithOptions+  -- *** Drop   , onDrop+  , onDropWithOptions+  -- *** Select+  , onSelect+  -- *** Pointer+  , onPointerDown+  , onPointerUp+  , onPointerEnter+  , onPointerLeave+  , onPointerOver+  , onPointerOut+  , onPointerCancel+  , onPointerMove+  -- *** Media+  , onAbort+  , onAbortWith+  , onCanPlay+  , onCanPlayWith+  , onCanPlayThrough+  , onCanPlayThroughWith+  , onDurationChange+  , onDurationChangeWith+  , onEmptied+  , onEmptiedWith+  , onEnded+  , onEndedWith+  , onError+  , onErrorWith+  , onLoad+  , onUnload+  , onLoadedData+  , onLoadedDataWith+  , onLoadedMetadata+  , onLoadedMetadataWith+  , onLoadStart+  , onLoadStartWith+  , onPause+  , onPauseWith+  , onPlay+  , onPlayWith+  , onPlaying+  , onPlayingWith+  , onProgress+  , onProgressWith+  , onRateChange+  , onRateChangeWith+  , onSeeked+  , onSeekedWith+  , onSeeking+  , onSeekingWith+  , onStalled+  , onStalledWith+  , onSuspend+  , onSuspendWith+  , onTimeUpdate+  , onTimeUpdateWith+  , onVolumeChange+  , onVolumeChangeWith+  , onWaiting+  , onWaitingWith+  -- *** Touch+  , onTouchStart+  , onTouchStartWithOptions+  , onTouchEnd+  , onTouchEndWithOptions+  , onTouchMove+  , onTouchMoveWithOptions+  , onTouchCancel+  , onTouchCancelWithOptions   ) where--import Miso.Html.Internal ( Attribute, on, onWithOptions )-import Miso.Event-import Miso.String (MisoString)---- | `blur` event defined with custom options+-----------------------------------------------------------------------------+import           Data.Bool (bool)+-----------------------------------------------------------------------------+import           Miso.Event+import           Miso.Media (Media(..))+import           Miso.Types (Attribute, DOMRef)+import           Miso.String (MisoString)+-----------------------------------------------------------------------------+-- | blur event defined with custom options -- -- <https://developer.mozilla.org/en-US/docs/Web/Events/blur> -- onBlur :: action -> Attribute action-onBlur action = on "blur" emptyDecoder $ \() -> action-+onBlur action = on "blur" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/change onChecked :: (Checked -> action) -> Attribute action-onChecked = on "change" checkedDecoder-+onChecked f = on "change" checkedDecoder (\action _ -> f action)+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/contextmenu+--+-- This can be used to disable right-click context menu from appearing+--+-- @+-- div_ [ onContextMenuWithOptions NoOp defaultOptions { preventDefault = False } ] [ ]+-- @+--+-- @since 1.9.0.0+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+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/click onClick :: action -> Attribute action-onClick action = on "click" emptyDecoder $ \() -> action-+onClick action = on "click" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/click+onClickCapture :: action -> Attribute action+onClickCapture action = onCapture "click" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/click+-- Like 'onClick', but passes the DOM reference along (akin to @getElementById@).+onClickWith :: (DOMRef -> action) -> Attribute action+onClickWith action = on "click" emptyDecoder $ \() domRef -> action domRef+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/click+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+onClickPrevent :: action -> Attribute action+onClickPrevent = onClickWithOptions preventDefault+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/focus onFocus :: action -> Attribute action-onFocus action = on "focus" emptyDecoder $ \() -> action-+onFocus action = on "focus" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/dblclick onDoubleClick :: action -> Attribute action-onDoubleClick action = on "dblclick" emptyDecoder $ \() -> action-+onDoubleClick action = on "dblclick" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/dblclick+onDoubleClickWith :: (DOMRef -> action) -> Attribute action+onDoubleClickWith f = on "dblclick" emptyDecoder $ \() domRef -> f domRef+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/dblclick+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 = on "input" valueDecoder-+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)+  -- ^ 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 = on "change" valueDecoder-+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)+  -- ^ 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)+  -- ^ 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 = on "keydown" keyInfoDecoder-+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 = on "keydown" keycodeDecoder-+onKeyDown+  :: (KeyCode -> action)+  -- ^ Callback receiving the numeric key code of the pressed key+  -> Attribute action+onKeyDown f = on "keydown" keycodeDecoder (\action _ -> f action)+-----------------------------------------------------------------------------+-- | 'onEnter'+--+-- A convenience function for processing the @Enter@ key.+--+-- @+--+-- data Action = NoOp | OnEnter+--+-- type Model = Int+--+-- view :: Model -> View model Action+-- view entryId = input_ [ onEnter NoOp OnEnter ]+-- @+--+-- @since 1.9.0.0+onEnter+  :: action+  -- ^ The action to call when the keydown *is not* 13 (typically @NoOp@ or @Id@)+  -> action+  -- ^ The action to call when keydown *is* 13.+  -> Attribute action+onEnter nothing action = onKeyDown $ bool nothing action . (==13)+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/keypress-onKeyPress :: (KeyCode -> action) -> Attribute action-onKeyPress = on "keypress" keycodeDecoder-+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 = on "keyup" keycodeDecoder-+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 onMouseUp :: action -> Attribute action-onMouseUp action = on "mouseup" emptyDecoder $ \() -> action-+onMouseUp action = on "mouseup" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/mousedown onMouseDown :: action -> Attribute action-onMouseDown action = on "mousedown" emptyDecoder $ \() -> action-+onMouseDown action = on "mousedown" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/mouseenter onMouseEnter :: action -> Attribute action-onMouseEnter action = on "mouseenter" emptyDecoder $ \() -> action-+onMouseEnter action = on "mouseenter" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/mouseleave onMouseLeave :: action -> Attribute action-onMouseLeave action = on "mouseleave" emptyDecoder $ \() -> action-+onMouseLeave action = on "mouseleave" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/mouseover onMouseOver :: action -> Attribute action-onMouseOver action = on "mouseover" emptyDecoder $ \() -> action-+onMouseOver action = on "mouseover" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/mouseout onMouseOut :: action -> Attribute action-onMouseOut action = on "mouseout" emptyDecoder $ \() -> action-+onMouseOut action = on "mouseout" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/dragstart onDragStart :: action -> Attribute action-onDragStart action = on "dragstart" emptyDecoder $ \() -> action-+onDragStart action = on "dragstart" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/dragstart+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+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/dragover onDragOver :: action -> Attribute action-onDragOver action = on "dragover" emptyDecoder $ \() -> action-+onDragOver action = on "dragover" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/dragover+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+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/dragend onDragEnd :: action -> Attribute action-onDragEnd action = on "dragend" emptyDecoder $ \() -> action-+onDragEnd action = on "dragend" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/dragend+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+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/dragenter onDragEnter :: action -> Attribute action-onDragEnter action = on "dragenter" emptyDecoder $ \() -> action-+onDragEnter action = on "dragenter" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/dragenter+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+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/dragleave onDragLeave :: action -> Attribute action-onDragLeave action = on "dragleave" emptyDecoder $ \() -> action-+onDragLeave action = on "dragleave" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/dragleave+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+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/drag onDrag :: action -> Attribute action-onDrag action = on "drag" emptyDecoder $ \() -> action-+onDrag action = on "drag" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/drag+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 :: AllowDrop -> action -> Attribute action-onDrop (AllowDrop allowDrop) action =-  onWithOptions defaultOptions { preventDefault = allowDrop }-    "drop" emptyDecoder (\() -> 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+  -- ^ Propagation options (@preventDefault@, @stopPropagation@)+  -> action+  -- ^ Action to dispatch on drop+  -> Attribute action+onDropWithOptions options action =+  onWithOptions BUBBLE options "drop" emptyDecoder (\() _ -> action)+----------------------------------------------------------------------------- -- | https://developer.mozilla.org/en-US/docs/Web/Events/submit+--+-- Note: This has `preventDefault` enabled by default.+-- onSubmit :: action -> Attribute action onSubmit action =-  onWithOptions defaultOptions { preventDefault = True }-    "submit" emptyDecoder $ \() -> action+  onWithOptions BUBBLE preventDefault+    "submit" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/pointerup+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)+  -- ^ 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)+  -- ^ 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)+  -- ^ 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)+  -- ^ 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)+  -- ^ 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)+  -- ^ 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)+  -- ^ Callback receiving the full 'PointerEvent'+  -> Attribute action+onPointerMove f = on "pointermove" pointerDecoder (\action _ -> f action)+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_abort.asp+onAbort :: action -> Attribute action+onAbort action = on "abort" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_abort.asp+onAbortWith :: (Media -> action) -> Attribute action+onAbortWith action = on "abort" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_canplay.asp+onCanPlay :: action -> Attribute action+onCanPlay action = on "canplay" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_canplay.asp+onCanPlayWith :: (Media -> action) -> Attribute action+onCanPlayWith action = on "canplay" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_canplaythrough.asp+onCanPlayThrough :: action -> Attribute action+onCanPlayThrough action = on "canplaythrough" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_canplaythrough.asp+onCanPlayThroughWith :: (Media -> action) -> Attribute action+onCanPlayThroughWith action = on "canplaythrough" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_durationchange.asp+onDurationChange :: action -> Attribute action+onDurationChange action = on "durationchange" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_durationchange.asp+onDurationChangeWith :: (Media -> action) -> Attribute action+onDurationChangeWith action = on "durationchange" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/jsref/event_onemptied.asp+onEmptied :: action -> Attribute action+onEmptied action = on "emptied" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/jsref/event_onemptied.asp+onEmptiedWith :: (Media -> action) -> Attribute action+onEmptiedWith action = on "emptied" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_ended.asp+onEnded :: action -> Attribute action+onEnded action = on "ended" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_ended.asp+onEndedWith :: (Media -> action) -> Attribute action+onEndedWith action = on "ended" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_error.asp+onError :: action -> Attribute action+onError action = on "error" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_error.asp+onErrorWith :: (Media -> action) -> Attribute action+onErrorWith action = on "error" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/jsref/event_onload.asp+onLoad :: action -> Attribute action+onLoad action = on "load" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | onUnload event+onUnload :: action -> Attribute action+onUnload action = on "unload" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_loadeddata.asp+onLoadedData :: action -> Attribute action+onLoadedData action = on "loadeddata" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_loadeddata.asp+onLoadedDataWith :: (Media -> action) -> Attribute action+onLoadedDataWith action = on "loadeddata" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_loadedmetadata.asp+onLoadedMetadata :: action -> Attribute action+onLoadedMetadata action = on "loadedmetadata" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_loadedmetadata.asp+onLoadedMetadataWith :: (Media -> action) -> Attribute action+onLoadedMetadataWith action = on "loadedmetadata" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_loadstart.asp+onLoadStart :: action -> Attribute action+onLoadStart action = on "loadstart" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_loadstart.asp+onLoadStartWith :: (Media -> action) -> Attribute action+onLoadStartWith action = on "loadstart" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_pause.asp+onPause :: action -> Attribute action+onPause action = on "pause" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_pause.asp+onPauseWith :: (Media -> action) -> Attribute action+onPauseWith action = on "pause" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_play.asp+onPlay :: action -> Attribute action+onPlay action = on "play" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_play.asp+onPlayWith :: (Media -> action) -> Attribute action+onPlayWith action = on "play" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_playing.asp+onPlaying :: action -> Attribute action+onPlaying action = on "playing" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_playing.asp+onPlayingWith :: (Media -> action) -> Attribute action+onPlayingWith action = on "playing" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_progress.asp+onProgress :: action -> Attribute action+onProgress action = on "progress" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_progress.asp+onProgressWith :: (Media -> action) -> Attribute action+onProgressWith action = on "progress" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_ratechange.asp+onRateChange :: action -> Attribute action+onRateChange action = on "ratechange" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_ratechange.asp+onRateChangeWith :: (Media -> action) -> Attribute action+onRateChangeWith action = on "ratechange" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_seeked.asp+onSeeked :: action -> Attribute action+onSeeked action = on "seeked" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_seeked.asp+onSeekedWith :: (Media -> action) -> Attribute action+onSeekedWith action = on "seeked" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_seeking.asp+onSeeking :: action -> Attribute action+onSeeking action = on "seeking" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_seeking.asp+onSeekingWith :: (Media -> action) -> Attribute action+onSeekingWith action = on "seeking" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_stalled.asp+onStalled :: action -> Attribute action+onStalled action = on "stalled" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_stalled.asp+onStalledWith :: (Media -> action) -> Attribute action+onStalledWith action = on "stalled" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_suspend.asp+onSuspend :: action -> Attribute action+onSuspend action = on "suspend" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_suspend.asp+onSuspendWith :: (Media -> action) -> Attribute action+onSuspendWith action = on "suspend" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_timeupdate.asp+onTimeUpdate :: action -> Attribute action+onTimeUpdate action = on "timeupdate" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_timeupdate.asp+onTimeUpdateWith :: (Media -> action) -> Attribute action+onTimeUpdateWith action = on "timeupdate" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_volumechange.asp+onVolumeChange :: action -> Attribute action+onVolumeChange action = on "volumechange" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_volumechange.asp+onVolumeChangeWith :: (Media -> action) -> Attribute action+onVolumeChangeWith action = on "volumechange" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_waiting.asp+onWaiting :: action -> Attribute action+onWaiting action = on "waiting" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://www.w3schools.com/tags/av_event_waiting.asp+onWaitingWith :: (Media -> action) -> Attribute action+onWaitingWith action = on "waiting" emptyDecoder $ \() -> action . Media+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/touchstart+onTouchStart :: action -> Attribute action+onTouchStart action = on "touchstart" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/touchstart+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+onTouchEnd :: action -> Attribute action+onTouchEnd action = on "touchend" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/touchend+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+onTouchMove :: action -> Attribute action+onTouchMove action = on "touchmove" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/touchmove+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+onTouchCancel :: action -> Attribute action+onTouchCancel action = on "touchcancel" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------+-- | https://developer.mozilla.org/en-US/docs/Web/Events/touchcancel+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+-----------------------------------------------------------------------------
src/Miso/Html/Property.hs view
@@ -1,41 +1,112 @@+----------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module      :  Miso.Html.Property--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- Stability   :  experimental -- Portability :  non-portable ----- Construct custom properties on DOM elements+-- = Overview ----- > div_ [ prop "id" "foo" ] [ ]+-- "Miso.Html.Property" provides smart constructors for+-- <https://developer.mozilla.org/en-US/docs/Web/API/Element#properties DOM properties>+-- and+-- <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes HTML attributes>.+-- 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_'+-- * __\<script\> \/ \<meta\>__: 'async_', 'defer_', 'charset_', 'content_',+--   'httpEquiv_', 'language_', 'scoped_'+-- * __\<iframe\>__: '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- (   -- * Construction-     textProp-   , stringProp-   , boolProp-   , intProp-   , integerProp-   , doubleProp-    -- * Common attributes-   , class_+  ( -- *** Combinators+     class_+   , className+   , classes_    , classList_    , id_    , title_    , hidden_-   -- * Inputs+   , inert_+   , lang_    , type_    , value_    , defaultValue_    , checked_    , placeholder_    , selected_-   -- * Input Helpers    , accept_    , acceptCharset_    , action_@@ -51,7 +122,7 @@    , method_    , multiple_    , name_-   , novalidate_+   , noValidate_    , pattern_    , readonly_    , required_@@ -59,15 +130,12 @@    , for_    , ref_    , form_-   -- * Input Ranges    , max_    , min_    , step_-   -- * Input Text areas    , cols_    , rows_    , wrap_-   -- * Links and areas    , href_    , target_    , download_@@ -76,39 +144,40 @@    , media_    , ping_    , rel_-   -- * Maps    , ismap_    , usemap_    , shape_    , coords_-   -- * Embedded Content    , src_    , height_    , width_    , alt_-   -- * Audio and Video+   , loading_    , autoplay_+   , currentTime_+   , defaultMuted_+   , volume_    , controls_    , loop_+   , defaultPlaybackRate_+   , mediaGroup_+   , muted_+   , playbackRate_+   , seeking_    , preload_    , poster_    , default_    , kind_    , srclang_-   -- * iframes    , sandbox_    , seamless_    , srcdoc_-   -- * Ordered lists    , reversed_-   , start_-   -- * Tables    , align_    , colspan_    , rowspan_    , headers_    , scope_-   -- * Headers    , async_    , charset_    , content_@@ -116,285 +185,451 @@    , httpEquiv_    , language_    , scoped_-   -- * Data    , data_+   , autocorrect_+   , spellcheck_+   , role_+   , xmlns_+   , aria_+   , label_+   , draggable_+   , frameborder_+   , scrolling_+   , tabindex_+   , open_    ) where--import           Miso.Html.Internal-import           Miso.String (MisoString, intercalate)--#if __GLASGOW_HASKELL__ < 841-import           Data.Monoid ((<>))-#endif---- | Set field to `Bool` value-boolProp :: MisoString -> Bool -> Attribute action-boolProp = prop--- | Set field to `String` value-stringProp ::  MisoString -> String -> Attribute action-stringProp = prop--- | Set field to `Text` value-textProp ::  MisoString -> MisoString -> Attribute action-textProp = prop--- | Set field to `Int` value-intProp ::  MisoString -> Int -> Attribute action-intProp = prop--- | Set field to `Integer` value-integerProp ::  MisoString -> Int -> Attribute action-integerProp = prop--- | Set field to `Double` value-doubleProp ::  MisoString -> Double -> Attribute action-doubleProp = prop+-----------------------------------------------------------------------------+import           Miso.Types+import           Miso.Property+----------------------------------------------------------------------------- -- | Define multiple classes conditionally -- -- > div_ [ classList_ [ ("empty", null items) ] [ ] ---classList_ ::  [(MisoString, Bool)] -> Attribute action-classList_ xs =-  textProp "class" $ intercalate (" " :: MisoString) [ t | (t, True) <- xs ]--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/title>-title_ ::  MisoString -> Attribute action+classList_ :: [(MisoString, Bool)] -> Attribute action+classList_ xs = classList [ t | (t, True) <- xs ]+-----------------------------------------------------------------------------+-- | Define multiple classes+--+-- > div_ [ classes_ [ "red", "warning" ] ] []+--+classes_ :: [MisoString] -> Attribute action+classes_ = classList+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/title>+title_ :: MisoString -> Attribute action title_ = textProp "title"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/selected>-selected_ ::  Bool -> Attribute action+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Element/option#selected>+selected_ :: Bool -> Attribute action selected_ = boolProp "selected"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/hidden>-hidden_ ::  Bool -> Attribute action-hidden_             = boolProp "hidden"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/value>-value_ ::  MisoString -> Attribute action-value_             = textProp "value"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/defaultValue>-defaultValue_ ::  MisoString -> Attribute action-defaultValue_      = textProp "defaultValue"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/accept>-accept_ ::  MisoString -> Attribute action-accept_            = textProp "accept"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/acceptCharset>-acceptCharset_ ::  MisoString -> Attribute action-acceptCharset_     = textProp "acceptCharset"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/action>-action_ ::  MisoString -> Attribute action-action_            = textProp "action"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/autocomplete>-autocomplete_ ::  Bool -> Attribute action+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/hidden>+hidden_ :: Bool -> Attribute action+hidden_ = boolProp "hidden"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/inert>+inert_ :: Bool -> Attribute action+inert_ = boolProp "inert"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/lang>+lang_ :: MisoString -> Attribute action+lang_ = textProp "lang"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLInputElement/value>+value_ :: MisoString -> Attribute action+value_ = textProp "value"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLInputElement/defaultValue>+defaultValue_ :: MisoString -> Attribute action+defaultValue_    = textProp "defaultValue"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/accept>+accept_ :: MisoString -> Attribute action+accept_  = textProp "accept"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLFormElement/acceptCharset>+acceptCharset_ :: MisoString -> Attribute action+acceptCharset_   = textProp "acceptCharset"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLFormElement/action>+action_ :: MisoString -> Attribute action+action_  = textProp "action"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/autocomplete>+autocomplete_ :: Bool -> Attribute action autocomplete_ b = textProp "autocomplete" (if b then "on" else "off")--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/autosave>-autosave_ ::  MisoString -> Attribute action-autosave_          = textProp "autosave"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/disabled>-disabled_ ::  Bool -> Attribute action-disabled_          = boolProp "disabled"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/enctype>-enctype_ ::  MisoString -> Attribute action-enctype_           = textProp "enctype"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/formation>-formation_ ::  MisoString -> Attribute action-formation_         = textProp "formation"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/list>-list_ ::  MisoString -> Attribute action-list_              = textProp "list"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/maxlength>-maxlength_ ::  MisoString -> Attribute action-maxlength_         = textProp "maxlength"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/minlength>-minlength_ ::  MisoString -> Attribute action-minlength_         = textProp "minlength"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/method>-method_ ::  MisoString -> Attribute action-method_            = textProp "method"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/multiple>-multiple_ ::  Bool -> Attribute action-multiple_          = boolProp "multiple"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/novalidate>-novalidate_ ::  Bool -> Attribute action-novalidate_        = boolProp "noValidate"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/pattern>-pattern_ ::  MisoString -> Attribute action-pattern_           = textProp "pattern"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/readonly>-readonly_ ::  Bool -> Attribute action-readonly_          = boolProp "readOnly"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/required>-required_ ::  Bool -> Attribute action-required_          = boolProp "required"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/size>-size_ ::  MisoString -> Attribute action-size_              = textProp "size"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/for>-for_ ::  MisoString -> Attribute action-for_               = textProp "for"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/ref>-ref_ ::  MisoString -> Attribute action-ref_               = textProp "ref"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/form>-form_ ::  MisoString -> Attribute action-form_               = textProp "form"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/max>-max_ ::  MisoString -> Attribute action-max_               = textProp "max"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/min>-min_ ::  MisoString -> Attribute action-min_               = textProp "min"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/step>-step_ ::  MisoString -> Attribute action-step_              = textProp "step"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/cols>-cols_ ::  MisoString -> Attribute action-cols_              = textProp "cols"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/rows>-rows_ ::  MisoString -> Attribute action-rows_              = textProp "rows"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/wrap>-wrap_ ::  MisoString -> Attribute action-wrap_              = textProp "wrap"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/target>-target_ ::  MisoString -> Attribute action-target_            = textProp "target"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/download>-download_ ::  MisoString -> Attribute action-download_          = textProp "download"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/downloadAs>-downloadAs_ ::  MisoString -> Attribute action-downloadAs_        = textProp "downloadAs"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/hreflang>-hreflang_ ::  MisoString -> Attribute action-hreflang_          = textProp "hreflang"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/media>-media_ ::  MisoString -> Attribute action-media_             = textProp "media"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/ping>-ping_ ::  MisoString -> Attribute action-ping_              = textProp "ping"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/rel>-rel_ ::  MisoString -> Attribute action-rel_               = textProp "rel"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/ismap>-ismap_ ::  MisoString -> Attribute action-ismap_             = textProp "ismap"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/usemap>-usemap_ ::  MisoString -> Attribute action-usemap_            = textProp "usemap"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/shape>-shape_ ::  MisoString -> Attribute action-shape_             = textProp "shape"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/coords>-coords_ ::  MisoString -> Attribute action-coords_            = textProp "coords"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/src>-src_ ::  MisoString -> Attribute action-src_               = textProp "src"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/height>-height_ ::  MisoString -> Attribute action-height_            = textProp "height"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/width>-width_ ::  MisoString -> Attribute action-width_             = textProp "width"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/alt>-alt_ ::  MisoString -> Attribute action-alt_               = textProp "alt"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/autoplay>-autoplay_ ::  Bool -> Attribute action-autoplay_          = boolProp "autoplay"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/controls>-controls_ ::  Bool -> Attribute action-controls_          = boolProp "controls"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/loop>-loop_ ::  Bool -> Attribute action-loop_              = boolProp "loop"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/preload>-preload_ ::  MisoString -> Attribute action-preload_           = textProp "preload"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/poster>-poster_ ::  MisoString -> Attribute action-poster_            = textProp "poster"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/default>-default_ ::  Bool -> Attribute action-default_           = boolProp "default"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/kind>-kind_ ::  MisoString -> Attribute action-kind_              = textProp "kind"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/srclang>-srclang_ ::  MisoString -> Attribute action-srclang_           = textProp "srclang"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/sandbox>-sandbox_ ::  MisoString -> Attribute action-sandbox_           = textProp "sandbox"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/seamless>-seamless_ ::  MisoString -> Attribute action-seamless_          = textProp "seamless"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/srcdoc>-srcdoc_ ::  MisoString -> Attribute action-srcdoc_            = textProp "srcdoc"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/reversed>-reversed_ ::  MisoString -> Attribute action-reversed_          = textProp "reversed"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/start>-start_ ::  MisoString -> Attribute action-start_             = textProp "start"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/align>-align_ ::  MisoString -> Attribute action-align_             = textProp "align"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/colspan>-colspan_ ::  MisoString -> Attribute action-colspan_           = textProp "colspan"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/rowspan>-rowspan_ ::  MisoString -> Attribute action-rowspan_           = textProp "rowspan"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/headers>-headers_ ::  MisoString -> Attribute action-headers_           = textProp "headers"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/scope>-scope_ ::  MisoString -> Attribute action-scope_             = textProp "scope"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/async>-async_ ::  MisoString -> Attribute action-async_             = textProp "async"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/charset>-charset_ ::  MisoString -> Attribute action-charset_           = textProp "charset"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/content>-content_ ::  MisoString -> Attribute action-content_           = textProp "content"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/defer>-defer_ ::  MisoString -> Attribute action-defer_             = textProp "defer"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/httpEquiv>-httpEquiv_ ::  MisoString -> Attribute action-httpEquiv_         = textProp "httpEquiv"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/language>-language_ ::  MisoString -> Attribute action-language_          = textProp "language"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/scoped>-scoped_ ::  MisoString -> Attribute action-scoped_            = textProp "scoped"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/type>-type_ ::  MisoString -> Attribute action+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/autosave>+autosave_ :: MisoString -> Attribute action+autosave_ = textProp "autosave"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/autocorrect>+autocorrect_ :: Bool -> Attribute action+autocorrect_ b = textProp "autocomplete" (if b then "on" else "off")+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/spellcheck>+spellcheck_ :: Bool -> Attribute action+spellcheck_ b = textProp "autocomplete" (if b then "on" else "off")+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/role>+role_ :: MisoString -> Attribute action+role_ = textProp "role"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/disabled>+disabled_ :: Attribute action+disabled_ = boolProp "disabled" True+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLFormElement/enctype>+enctype_ :: MisoString -> Attribute action+enctype_ = textProp "enctype"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/formation>+formation_ :: MisoString -> Attribute action+formation_ = textProp "formation"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/list>+list_ :: MisoString -> Attribute action+list_  = textProp "list"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/maxlength>+maxlength_ :: MisoString -> Attribute action+maxlength_ = textProp "maxlength"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/minlength>+minlength_ :: MisoString -> Attribute action+minlength_ = textProp "minlength"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/method>+method_ :: MisoString -> Attribute action+method_  = textProp "method"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Attributes/multiple>+multiple_ :: Bool -> Attribute action+multiple_ = boolProp "multiple"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLFormElement/noValidate>+noValidate_ :: Bool -> Attribute action+noValidate_      = boolProp "noValidate"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/pattern>+pattern_ :: MisoString -> Attribute action+pattern_ = textProp "pattern"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/details#open>+open_ :: Bool -> Attribute action+open_ = boolProp "open"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/readonly>+readonly_ :: Bool -> Attribute action+readonly_ = boolProp "readOnly"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Attributes/required>+required_ :: Bool -> Attribute action+required_ = boolProp "required"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/size>+size_ :: MisoString -> Attribute action+size_  = textProp "size"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/for>+for_ :: MisoString -> Attribute action+for_ = textProp "for"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/ref>+ref_ :: MisoString -> Attribute action+ref_ = textProp "ref"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/form>+form_ :: MisoString -> Attribute action+form_ = textProp "form"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/max>+max_ :: MisoString -> Attribute action+max_ = textProp "max"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/min>+min_ :: MisoString -> Attribute action+min_ = textProp "min"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/step>+step_ :: MisoString -> Attribute action+step_  = textProp "step"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/cols>+cols_ :: MisoString -> Attribute action+cols_  = textProp "cols"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/rows>+rows_ :: MisoString -> Attribute action+rows_  = textProp "rows"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/wrap>+wrap_ :: MisoString -> Attribute action+wrap_  = textProp "wrap"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/target>+target_ :: MisoString -> Attribute action+target_  = textProp "target"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/download>+download_ :: MisoString -> Attribute action+download_ = textProp "download"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/downloadAs>+downloadAs_ :: MisoString -> Attribute action+downloadAs_      = textProp "downloadAs"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/hreflang>+hreflang_ :: MisoString -> Attribute action+hreflang_ = textProp "hreflang"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/media>+media_ :: MisoString -> Attribute action+media_ = textProp "media"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/ping>+ping_ :: MisoString -> Attribute action+ping_  = textProp "ping"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/rel>+rel_ :: MisoString -> Attribute action+rel_ = textProp "rel"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLImageElement/isMap>+ismap_ :: Bool -> Attribute action+ismap_ = boolProp "ismap"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/usemap>+usemap_ :: MisoString -> Attribute action+usemap_  = textProp "usemap"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/shape>+shape_ :: MisoString -> Attribute action+shape_ = textProp "shape"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/coords>+coords_ :: MisoString -> Attribute action+coords_  = textProp "coords"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/src>+src_ :: MisoString -> Attribute action+src_ = textProp "src"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/height>+height_ :: MisoString -> Attribute action+height_  = textProp "height"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/width>+width_ :: MisoString -> Attribute action+width_ = textProp "width"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/alt>+alt_ :: MisoString -> Attribute action+alt_ = textProp "alt"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/loading>+loading_ :: MisoString -> Attribute action+loading_ = textProp "loading"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement/autoplay>+autoplay_ :: Bool -> Attribute action+autoplay_ = boolProp "autoplay"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement/currentTime>+currentTime_ :: Double -> Attribute action+currentTime_ = doubleProp "currentTime"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement/defaultMuted>+defaultMuted_ :: Bool -> Attribute action+defaultMuted_ = boolProp "defaultMuted"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement/defaultPlaybackRate>+defaultPlaybackRate_ :: Double -> Attribute action+defaultPlaybackRate_ = doubleProp "defaultPlaybackRate"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement/mediaGroup>+mediaGroup_ :: MisoString -> Attribute action+mediaGroup_ = textProp "mediaGroup"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement/muted>+muted_ :: Bool -> Attribute action+muted_ = boolProp "muted"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement/playbackRate>+playbackRate_ :: Double -> Attribute action+playbackRate_ = doubleProp "playbackRate"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement/preload>+preload_ :: MisoString -> Attribute action+preload_ = textProp "preload"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement/seeking>+seeking_ :: Bool -> Attribute action+seeking_ = boolProp "seeking"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement/volume>+volume_ :: Double -> Attribute action+volume_ = doubleProp "volume"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement/controls>+controls_ :: Bool -> Attribute action+controls_ = boolProp "controls"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement/loop>+loop_ :: Bool -> Attribute action+loop_  = boolProp "loop"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLVideoElement/poster>+poster_ :: MisoString -> Attribute action+poster_  = textProp "poster"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/default>+default_ :: Bool -> Attribute action+default_ = boolProp "default"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/kind>+kind_ :: MisoString -> Attribute action+kind_  = textProp "kind"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/srclang>+srclang_ :: MisoString -> Attribute action+srclang_ = textProp "srclang"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/sandbox>+sandbox_ :: MisoString -> Attribute action+sandbox_ = textProp "sandbox"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/seamless>+seamless_ :: MisoString -> Attribute action+seamless_ = textProp "seamless"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/srcdoc>+srcdoc_ :: MisoString -> Attribute action+srcdoc_  = textProp "srcdoc"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/ol#reversed>+reversed_ :: Bool -> Attribute action+reversed_ = boolProp "reversed"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/align>+align_ :: MisoString -> Attribute action+align_ = textProp "align"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/colspan>+colspan_ :: MisoString -> Attribute action+colspan_ = textProp "colspan"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/rowspan>+rowspan_ :: MisoString -> Attribute action+rowspan_ = textProp "rowspan"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/headers>+headers_ :: MisoString -> Attribute action+headers_ = textProp "headers"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/scope>+scope_ :: MisoString -> Attribute action+scope_ = textProp "scope"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/async>+async_ :: Bool -> Attribute action+async_ = boolProp "async"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/charset>+charset_ :: MisoString -> Attribute action+charset_ = textProp "charset"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/content>+content_ :: MisoString -> Attribute action+content_ = textProp "content"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLScriptElement/defer>+defer_ :: Bool -> Attribute action+defer_ = boolProp "defer"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/httpEquiv>+httpEquiv_ :: MisoString -> Attribute action+httpEquiv_ = textProp "httpEquiv"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/language>+language_ :: MisoString -> Attribute action+language_ = textProp "language"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/scoped>+scoped_ :: MisoString -> Attribute action+scoped_  = textProp "scoped"+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/type>+type_ :: MisoString -> Attribute action type_ = textProp "type"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/name>-name_ ::  MisoString -> Attribute action+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLLinkElement/name>+name_ :: MisoString -> Attribute action name_ = textProp "name"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/href>-href_ ::  MisoString -> Attribute action+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLLinkElement/href>+href_ :: MisoString -> Attribute action href_ = textProp "href"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/id>-id_ ::  MisoString -> Attribute action+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/id>+id_ :: MisoString -> Attribute action id_ = textProp "id"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/placeholder>-placeholder_ ::  MisoString -> Attribute action+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLInputElement/placeholder>+placeholder_ :: MisoString -> Attribute action placeholder_ = textProp "placeholder"--- | <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/checked>-checked_ ::  Bool -> Attribute action+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLInputElement/checked>+checked_ :: Bool -> Attribute action checked_ = boolProp "checked"--- | Set "autofocus" property--- <https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XUL/Attribute/autofocus>-autofocus_ ::  Bool -> Attribute action+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/autofocus>+autofocus_ :: Bool -> Attribute action autofocus_ = boolProp "autofocus"+----------------------------------------------------------------------------- -- | Set "className" property -- <https://developer.mozilla.org/en-US/docs/Web/API/Element/className>-class_ ::  MisoString -> Attribute action-class_ = textProp "class"+class_ :: MisoString -> Attribute action+class_ = className+-----------------------------------------------------------------------------+-- | Set "className" property+-- <https://developer.mozilla.org/en-US/docs/Web/API/Element/className>+className :: MisoString -> Attribute action+className name = classList [name]+----------------------------------------------------------------------------- -- | Set "data-*" property -- https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/data-*-data_ ::  MisoString -> MisoString -> Attribute action+data_ :: MisoString -> MisoString -> Attribute action data_ k v = textProp ("data-" <> k) v+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+xmlns_ :: MisoString -> Attribute action+xmlns_ = textProp "xmlns"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+aria_ :: MisoString -> MisoString -> Attribute action+aria_ k = textProp ("aria-" <> k)+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+label_ :: MisoString -> Attribute action+label_ = textProp "label"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+draggable_ :: Bool -> Attribute action+draggable_ = boolProp "draggable"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+scrolling_ :: MisoString -> Attribute action+scrolling_ = textProp "scrolling"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+frameborder_ :: MisoString -> Attribute action+frameborder_ = textProp "frameborder"+-----------------------------------------------------------------------------+-- | [tabindex](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/tabindex) attribute+--+-- @since 1.9.0.0+tabindex_ ::  MisoString -> Attribute action+tabindex_ = textProp "tabindex"+-----------------------------------------------------------------------------
+ src/Miso/Html/Render.hs view
@@ -0,0 +1,272 @@+-----------------------------------------------------------------------------+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE CPP                   #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Html.Render+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = 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+-- <https://en.wikipedia.org/wiki/Server-side_scripting server-side rendering (SSR)>+-- 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 @\<tag attrs\>children\<\/tag\>@.+--   Self-closing elements (@\<br\/\>@, @\<img\/\>@, @\<input\/\>@, …) 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 (..)+  ) where+----------------------------------------------------------------------------+import qualified Data.Set as S+import           Data.Set (Set)+import           Data.ByteString.Builder+import qualified Data.ByteString.Lazy as L+import qualified Data.Map.Strict as M+import           Unsafe.Coerce (unsafeCoerce)+#ifdef SSR+import           Control.Exception (SomeException, catch)+import           System.IO.Unsafe (unsafePerformIO)+#endif+----------------------------------------------------------------------------+import           Miso.JSON+import           Miso.String hiding (intercalate)+import qualified Miso.String as MS+import           Miso.Types+----------------------------------------------------------------------------+-- | Class for rendering HTML+class ToHtml a where+  toHtml :: a -> L.ByteString+----------------------------------------------------------------------------+-- | Render a @Miso.Types.View@ to a @L.ByteString@+instance ToHtml (Miso.Types.View m a) where+  toHtml = renderView+----------------------------------------------------------------------------+-- | Render a @[Miso.Types.View]@ to a @L.ByteString@+instance ToHtml [Miso.Types.View m a] where+  toHtml = foldMap renderView+----------------------------------------------------------------------------+renderView :: View m a -> L.ByteString+renderView = toLazyByteString . renderBuilder+----------------------------------------------------------------------------+intercalate :: Builder -> [Builder] -> Builder+intercalate _ [] = ""+intercalate _ [x] = x+intercalate sep (x:xs) =+  mconcat+  [ x+  , sep+  , intercalate sep xs+  ]+----------------------------------------------------------------------------+booleanProperties :: Set MisoString+booleanProperties = S.fromList+  [ "allowfullscreen"+  , "allowpaymentrequest"+  , "allowusermedia"+  , "async"+  , "autofocus"+  , "autoplay"+  , "checked"+  , "controls"+  , "default"+  , "defer"+  , "disabled"+  , "download"+  , "formnovalidate"+  , "hidden"+  , "inert"+  , "ismap"+  , "itemscope"+  , "loop"+  , "multiple"+  , "muted"+  , "nomodule"+  , "novalidate"+  , "open"+  , "playsinline"+  , "readonly"+  , "required"+  , "reversed"+  , "selected"+  , "truespeed"+  ]+----------------------------------------------------------------------------+renderBuilder :: forall m a . Miso.Types.View m a -> Builder+renderBuilder (VText _ "")    = fromMisoString " "+renderBuilder (VText _ s)     = fromMisoString s+renderBuilder (VNode _ "doctype" [] []) = "<!doctype html>"+renderBuilder (VNode ns tag attrs children) = mconcat+  [ "<"+  , fromMisoString tag+  , mconcat [ " " <> intercalate " " (renderAttrs <$> attrs)+            | not (Prelude.null attrs)+            ]+  , if tag `elem` selfClosing then "/>" else ">"+  , mconcat+    [ mconcat+      [ foldMap renderBuilder (collapseSiblingTextNodes children)+      , "</" <> fromMisoString tag <> ">"+      ]+    | tag `notElem` selfClosing+    ]+  ] where+      selfClosing = htmls <> svgs <> mathmls+      htmls = [ x+              | ns == HTML+              , x <- [ "area", "base", "col", "embed", "img", "input", "br", "hr", "meta", "link", "param", "source", "track", "wbr" ]+              ]+      svgs  = [ x+              | ns == SVG+              , x <- [ "circle", "line", "rect", "path", "ellipse", "polygon", "polyline", "use", "image"]+              ]+      mathmls =+              [ x+              | 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_) ]+#else+      vkids = [ unsafeCoerce $ view vcomp_ props (model vcomp_) ]+#endif+renderBuilder (VFrag _ kids) = foldMap renderBuilder kids+----------------------------------------------------------------------------+renderAttrs :: Attribute action -> Builder+renderAttrs (ClassList classes) =+  mconcat+  [ "class"+  , stringUtf8 "=\""+  , fromMisoString (MS.unwords classes)+  , stringUtf8 "\""+  ]+renderAttrs (Property key (Bool enabled)) -- dmj: account for boolean properties+  | S.member key booleanProperties, enabled = fromMisoString key+  | S.member key booleanProperties, not enabled = mempty+  | otherwise = mconcat+      [ fromMisoString key+      , stringUtf8 "=\""+      , toHtmlFromJSON (Bool enabled)+      , stringUtf8 "\""+      ]+renderAttrs (Property "key" _) = mempty+renderAttrs (Property key value) =+  mconcat+  [ fromMisoString key+  , stringUtf8 "=\""+  , toHtmlFromJSON value+  , stringUtf8 "\""+  ]+renderAttrs (On _) = mempty+renderAttrs (Styles styles_) =+  mconcat+  [ "style"+  , stringUtf8 "=\""+  , mconcat+    [ mconcat+      [ fromMisoString k+      , charUtf8 ':'+      , fromMisoString v+      , charUtf8 ';'+      ]+    | (k,v) <- M.toList styles_+    ]+  , stringUtf8 "\""+  ]+----------------------------------------------------------------------------+-- | The browser can't distinguish between multiple text nodes+-- and a single text node. So it will always parse a single text node+-- this means we must collapse adjacent text nodes during hydration.+collapseSiblingTextNodes :: [View m a] -> [View m a]+collapseSiblingTextNodes [] = []+collapseSiblingTextNodes (VText _ x : VText k y : xs) =+  collapseSiblingTextNodes (VText k (x <> y) : xs)+collapseSiblingTextNodes (x:xs) =+  x : collapseSiblingTextNodes xs+----------------------------------------------------------------------------+-- | Helper for turning JSON into Text+-- Object, Array and Null are kind of non-sensical here+toHtmlFromJSON :: Value -> Builder+toHtmlFromJSON (String t)   = fromMisoString (ms t)+toHtmlFromJSON (Number t)   = fromMisoString $ ms (show t)+toHtmlFromJSON (Bool True)  = "true"+toHtmlFromJSON (Bool False) = "false"+toHtmlFromJSON Null         = "null"+toHtmlFromJSON (Object o)   = fromMisoString $ ms (show o)+toHtmlFromJSON (Array a)    = fromMisoString $ ms (show a)+-----------------------------------------------------------------------------+#ifdef SSR+-- | Used for server-side model hydration, internally only in 'renderView'.+--+-- We use 'unsafePerformIO' here because @servant@'s 'MimeRender' is a pure function+-- yet we need to allow the users to hydrate in 'IO'.+--+getInitialComponentModel :: Component parent model action -> model+getInitialComponentModel Component {..} =+  case hydrateModel of+    Nothing -> model+    Just action -> unsafePerformIO $+      action `catch` (\(e :: SomeException) -> do+        putStrLn "Encountered exception during model hydration, falling back to default model"+        print e+        pure model)+----------------------------------------------------------------------------+#endif
+ src/Miso/Hydrate.hs view
@@ -0,0 +1,27 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Hydrate+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Functions and helpers for Virtual DOM hydration.+--+----------------------------------------------------------------------------+module Miso.Hydrate+  ( hydrate+  ) where+-----------------------------------------------------------------------------+import qualified Miso.FFI.Internal as FFI+import           Miso.Types+import           Miso.DSL+-----------------------------------------------------------------------------+-- | Hydration of a t'VTree'+hydrate :: LogLevel -> DOMRef -> VTree -> IO Bool+hydrate loggingLevel domRef vtree = do+  jval <- toJSVal vtree+  fromJSValUnchecked =<<+    FFI.hydrate (loggingLevel `elem` [DebugHydrate, DebugAll]) domRef jval+-----------------------------------------------------------------------------
+ src/Miso/JSON.hs view
@@ -0,0 +1,1400 @@+-----------------------------------------------------------------------------+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE KindSignatures             #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE DefaultSignatures          #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TypeApplications           #-}+{-# LANGUAGE AllowAmbiguousTypes        #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE UndecidableInstances       #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -Wno-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.JSON+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.JSON" is a JSON library tailored to 'MisoString', modelled after+-- <https://hackage.haskell.org/package/aeson aeson> and inspired by+-- <https://hackage.haskell.org/package/microaeson microaeson>. 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+    -- ** Core JSON types+    Value(..)+  , Object+  , Pair+  , Result (..)+    -- ** Constructors+  , (.=)+  , object+  , emptyArray+  , emptyObject+    -- ** Accessors+  , (.:)+  , (.:?)+  , (.:!)+  , (.!=)+    -- * Encoding and decoding+  , encode+  , encodePure+  , decode+  , Parser.decodePure+    -- * Prism-style parsers+  , withObject+  , withText+  , withArray+  , withNumber+  , withBool+    -- * Type conversion+  , FromJSON(parseJSON)+  , Parser (..)+  , parseMaybe+  , ToJSON(toJSON)+  -- * Misc.+  , fromJSON+  , parseEither+  , eitherDecode+  , typeMismatch+  -- * Pretty+  , encodePretty+  , encodePretty'+  , defConfig+  , Config (..)+  -- * FFI+  , fromJSVal_Value+  , toJSVal_Value+  , jsonStringify+  , jsonParse+  -- * Options+  , Options (..)+  , defaultOptions+  -- * Generics+  , GToJSON (..)+  , GToFields (..)+  , GToJSONSum (..)+  , GAllNullary (..)+  , Fields (..)+  , GFromJSON (..)+  , GFromFields (..)+  , GFromJSONSum (..)+  , genericToJSON+  , genericParseJSON+  -- * Modifiers+  , camelTo2+  ) where+----------------------------------------------------------------------------+#ifdef GHCJS_BOTH+import qualified GHCJS.Marshal as Marshal+#endif+----------------------------------------------------------------------------+import           Control.Applicative+import           Control.Monad+#if __GLASGOW_HASKELL__ <= 865+import           Control.Monad.Fail+import           GHC.Natural (Natural)+#endif+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+import qualified Data.Text.Lazy as LT+import           Data.Word+import           GHC.Generics+----------------------------------------------------------------------------+import           Miso.DSL.FFI+import           Miso.String (FromMisoString, ToMisoString, MisoString, ms, singleton, pack)+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)+----------------------------------------------------------------------------+-- | Create a 'Value' from a list of name\/value 'Pair's.+object :: [Pair] -> Value+object = Object . M.fromList+----------------------------------------------------------------------------+-- | The empty JSON 'Object' (i.e. @{}@).+emptyObject :: Value+emptyObject = Object mempty+----------------------------------------------------------------------------+-- | The empty JSON 'Array' (i.e. @[]@).+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 (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+----------------------------------------------------------------------------+-- | 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+  -- ^ 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+  -- ^ When 'True' (the default, matching aeson) and every constructor of a+  -- sum type is nullary, encode/decode each constructor as a bare JSON+  -- 'String' (e.g. @\"Red\"@) rather than a tagged object+  -- (e.g. @{\"tag\":\"Red\"}@).+  , omitNothingFields :: Bool+  -- ^ When 'True', record fields whose value is 'Nothing' are omitted from+  -- the encoded object entirely. When 'False' (the default, matching aeson)+  -- 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+  , constructorTagModifier = \x -> x+  , allNullaryToStringTag  = True+  , omitNothingFields      = False+  }+----------------------------------------------------------------------------+-- | 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+          go1 (x:xs) = x : go1 xs+          go2 "" = ""+          go2 (l:u:xs) | isLower l && isUpper u = l : c : u : go2 xs+          go2 (x:xs) = x : go2 xs+----------------------------------------------------------------------------+-- | Intermediate representation of a constructor's fields after encoding.+--+-- 'RecordFields' is produced when every selector has a name (record syntax);+-- 'PositionalFields' is produced for all other constructors.+data Fields+  = RecordFields   [(MisoString, Value)]+  -- ^ Named fields (record constructor)+  | PositionalFields [Value]+  -- ^ Positional fields (non-record constructor)+----------------------------------------------------------------------------+combineFields :: Fields -> Fields -> Fields+combineFields (RecordFields   xs) (RecordFields   ys) = RecordFields   (xs <> ys)+combineFields (PositionalFields xs) (PositionalFields ys) = PositionalFields (xs <> ys)+combineFields _ _ = PositionalFields []  -- mixed; shouldn't occur in valid GHC Generics+----------------------------------------------------------------------------+-- | Collect a constructor's fields into 'Fields'.+class GToFields (f :: Type -> Type) where+  gToFields :: Options -> f a -> Fields+----------------------------------------------------------------------------+instance GToFields U1 where+  gToFields _ _ = PositionalFields []+----------------------------------------------------------------------------+instance GToFields V1 where+  gToFields _ v = v `seq` PositionalFields []+----------------------------------------------------------------------------+instance (GToFields f, GToFields g) => GToFields (f :*: g) where+  gToFields opts (x :*: y) = combineFields (gToFields opts x) (gToFields opts y)+----------------------------------------------------------------------------+instance (Selector m, GToFields f) => GToFields (S1 m f) where+  gToFields opts (M1 x) =+    let n = selName (M1 undefined :: S1 m f ())+    in if null n+       then gToFields opts x+       else case gToFields opts x of+              PositionalFields [v] -> RecordFields [(ms (fieldLabelModifier opts n), v)]+              fs                   -> fs  -- shouldn't happen+----------------------------------------------------------------------------+instance ToJSON a => GToFields (K1 r a) where+  gToFields _ (K1 x) = PositionalFields [toJSON x]+----------------------------------------------------------------------------+-- | Special 'GToFields' instance for @'Maybe' a@ fields that honours+-- 'omitNothingFields': when the option is 'True' and the value is+-- 'Nothing', the field is omitted from the encoded object entirely.+instance {-# OVERLAPPING #-} (Selector m, ToJSON a)+    => GToFields (S1 m (K1 r (Maybe a))) where+  gToFields opts (M1 (K1 mx)) =+    let n   = selName (M1 undefined :: S1 m (K1 r (Maybe a)) ())+        key = ms (fieldLabelModifier opts n)+    in if null n+       then PositionalFields [toJSON mx]+       else case mx of+              Nothing | omitNothingFields opts -> RecordFields []+              _                                -> RecordFields [(key, toJSON mx)]+----------------------------------------------------------------------------+-- | Determine at the type level whether every constructor of a sum type+-- is nullary (has no fields). Used to implement 'allNullaryToStringTag'.+class GAllNullary (f :: Type -> Type) where+  gAllNullary :: Bool+----------------------------------------------------------------------------+instance GAllNullary U1 where+  gAllNullary = True+----------------------------------------------------------------------------+instance GAllNullary (K1 r a) where+  gAllNullary = False+----------------------------------------------------------------------------+instance (GAllNullary f, GAllNullary g) => GAllNullary (f :*: g) where+  gAllNullary = False  -- has multiple fields, definitely not nullary+----------------------------------------------------------------------------+instance GAllNullary f => GAllNullary (S1 m f) where+  gAllNullary = gAllNullary @f+----------------------------------------------------------------------------+instance GAllNullary f => GAllNullary (C1 m f) where+  gAllNullary = gAllNullary @f+----------------------------------------------------------------------------+instance (GAllNullary f, GAllNullary g) => GAllNullary (f :+: g) where+  gAllNullary = gAllNullary @f && gAllNullary @g+----------------------------------------------------------------------------+-- | Encode a single-constructor (product) type. No tag is added.+--+-- * Record:       @{"field1": v, ...}@+-- * 0 fields:     @[]@+-- * 1 field:      the value itself (unwrapped, like a newtype)+-- * 2+ fields:    @[v1, v2, ...]@+encodeProduct :: Fields -> Value+encodeProduct = \case+  RecordFields   kvs  -> Object (M.fromList kvs)+  PositionalFields []  -> Array []+  PositionalFields [v] -> v+  PositionalFields vs  -> Array vs+----------------------------------------------------------------------------+-- | Encode a sum constructor. Adds a @\"tag\"@ key.+--+-- * Record:       @{\"tag\": \"C\", \"field1\": v, ...}@+-- * 0 fields:     @{\"tag\": \"C\"}@+-- * 1 field:      @{\"tag\": \"C\", \"contents\": v}@+-- * 2+ fields:    @{\"tag\": \"C\", \"contents\": [v1, v2, ...]}@+encodeTaggedCon :: MisoString -> Fields -> Value+encodeTaggedCon tag = \case+  RecordFields   kvs  -> Object (M.fromList (("tag", String tag) : kvs))+  PositionalFields []  -> Object (M.singleton "tag" (String tag))+  PositionalFields [v] -> object [("tag", String tag), ("contents", v)]+  PositionalFields vs  -> object [("tag", String tag), ("contents", Array vs)]+----------------------------------------------------------------------------+-- | Top-level generic encoding class.+--+-- Encoding rules match aeson's defaults:+--+-- * All-nullary sum + 'allNullaryToStringTag':  @\"C\"@+-- * Single-constructor record:                  @{\"field1\": v1, ...}@+-- * Single-constructor positional:              @v@ (1 field), @[v1,v2,...]@ (n>1), @[]@ (0)+-- * Sum record constructor:                     @{\"tag\": \"C\", \"field1\": v1, ...}@+-- * Sum nullary constructor:                    @{\"tag\": \"C\"}@+-- * Sum positional constructor:                 @{\"tag\": \"C\", \"contents\": v}@ or @[...]@+class GToJSON (f :: Type -> Type) where+  gToJSON :: Options -> f a -> Value+----------------------------------------------------------------------------+instance GToJSONRep f => GToJSON (D1 m f) where+  gToJSON opts (M1 x) = gToJSONRep opts x+----------------------------------------------------------------------------+-- Internal: dispatches single-constructor vs sum at the child of D1.+class GToJSONRep (f :: Type -> Type) where+  gToJSONRep :: Options -> f a -> Value+-- Single constructor: no tag+instance GToFields f => GToJSONRep (C1 m f) where+  gToJSONRep opts (M1 x) = encodeProduct (gToFields opts x)+-- Sum: branch on allNullaryToStringTag+instance (GToJSONSum f, GToJSONSum g, GToJSONSumNullary f, GToJSONSumNullary g, GAllNullary f, GAllNullary g)+    => GToJSONRep (f :+: g) where+  gToJSONRep opts x+    | allNullaryToStringTag opts && gAllNullary @f && gAllNullary @g+    = gToJSONSumNullary opts x+    | otherwise+    = gToJSONSum opts x+----------------------------------------------------------------------------+-- | Encode all-nullary sum constructors as bare 'String' values.+class GToJSONSumNullary (f :: Type -> Type) where+  gToJSONSumNullary :: Options -> f a -> Value+----------------------------------------------------------------------------+instance (GToJSONSumNullary f, GToJSONSumNullary g) => GToJSONSumNullary (f :+: g) where+  gToJSONSumNullary opts (L1 x) = gToJSONSumNullary opts x+  gToJSONSumNullary opts (R1 x) = gToJSONSumNullary opts x+----------------------------------------------------------------------------+instance Constructor m => GToJSONSumNullary (C1 m U1) where+  gToJSONSumNullary opts _ =+    String (ms (constructorTagModifier opts (conName (undefined :: C1 m U1 ()))))+----------------------------------------------------------------------------+-- | Catch-all for non-nullary constructors — unreachable when 'gAllNullary'+-- guards are in place, but required for instance resolution.+instance {-# OVERLAPPABLE #-} Constructor m => GToJSONSumNullary (C1 m f) where+  gToJSONSumNullary _ _ = error "GToJSONSumNullary: non-nullary constructor (impossible)"+----------------------------------------------------------------------------+-- | Encode sum constructors with a @\"tag\"@ key.+class GToJSONSum (f :: Type -> Type) where+  gToJSONSum :: Options -> f a -> Value+----------------------------------------------------------------------------+instance (GToJSONSum f, GToJSONSum g) => GToJSONSum (f :+: g) where+  gToJSONSum opts (L1 x) = gToJSONSum opts x+  gToJSONSum opts (R1 x) = gToJSONSum opts x+----------------------------------------------------------------------------+instance (Constructor m, GToFields f) => GToJSONSum (C1 m f) where+  gToJSONSum opts (M1 x) =+    encodeTaggedCon+      (ms (constructorTagModifier opts (conName (undefined :: C1 m f ()))))+      (gToFields opts x)+----------------------------------------------------------------------------+instance ToJSON () where+  toJSON () = Array []+----------------------------------------------------------------------------+instance ToJSON Value where+  toJSON = id+----------------------------------------------------------------------------+instance ToJSON Char where+  toJSON c = String (singleton c)+  toJSONList = String . MS.pack+----------------------------------------------------------------------------+instance ToJSON Bool where+  toJSON = Bool+----------------------------------------------------------------------------+instance ToJSON a => ToJSON [a] where+  toJSON = toJSONList+----------------------------------------------------------------------------+instance ToJSON v => ToJSON (M.Map MisoString v) where+  toJSON = Object . M.map toJSON+----------------------------------------------------------------------------+instance ToJSON a => ToJSON (Maybe a) where+  toJSON = \case+    Nothing -> Null+    Just a -> toJSON a+----------------------------------------------------------------------------+instance (ToJSON a,ToJSON b) => ToJSON (a,b) where+  toJSON (a,b) = Array [toJSON a, toJSON b]+----------------------------------------------------------------------------+instance (ToJSON a,ToJSON b,ToJSON c) => ToJSON (a,b,c) where+  toJSON (a,b,c) = Array [toJSON a, toJSON b, toJSON c]+----------------------------------------------------------------------------+instance (ToJSON a,ToJSON b,ToJSON c, ToJSON d) => ToJSON (a,b,c,d) where+  toJSON (a,b,c,d) = Array [toJSON a, toJSON b, toJSON c, toJSON d]+----------------------------------------------------------------------------+instance ToJSON MisoString where+  toJSON = String+----------------------------------------------------------------------------+#ifndef VANILLA+instance ToJSON T.Text where+  toJSON = toJSON . ms+#endif+----------------------------------------------------------------------------+instance ToJSON LT.Text where+  toJSON = toJSON . ms+----------------------------------------------------------------------------+instance ToJSON Float where+  toJSON = Number . realToFrac+----------------------------------------------------------------------------+instance ToJSON Double where+  toJSON = Number+----------------------------------------------------------------------------+instance ToJSON Int    where  toJSON = Number . realToFrac+instance ToJSON Int8   where  toJSON = Number . realToFrac+instance ToJSON Int16  where  toJSON = Number . realToFrac+instance ToJSON Int32  where  toJSON = Number . realToFrac+----------------------------------------------------------------------------+instance ToJSON Word   where  toJSON = Number . realToFrac+instance ToJSON Word8  where  toJSON = Number . realToFrac+instance ToJSON Word16 where  toJSON = Number . realToFrac+instance ToJSON Word32 where  toJSON = Number . realToFrac+----------------------------------------------------------------------------+-- | Possibly lossy due to conversion to 'Double'+instance ToJSON Int64  where  toJSON = Number . realToFrac+----------------------------------------------------------------------------+-- | Possibly lossy due to conversion to 'Double'+instance ToJSON Word64 where  toJSON = Number . realToFrac+----------------------------------------------------------------------------+-- | Possibly lossy due to conversion to 'Double'+instance ToJSON Integer where toJSON = Number . fromInteger+----------------------------------------------------------------------------+-- | Possibly lossy due to conversion to 'Double'+instance ToJSON Natural where toJSON = Number . fromInteger . naturalToInteger+----------------------------------------------------------------------------+-- | 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+----------------------------------------------------------------------------+instance Alternative Parser where+  empty = Parser (Left mempty)+  Parser (Left _) <|> r = r+  l <|> _ = l+----------------------------------------------------------------------------+instance MonadPlus Parser+----------------------------------------------------------------------------+-- | 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+----------------------------------------------------------------------------+-- | 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+----------------------------------------------------------------------------+-- | Top-level generic decoding class. Symmetric with 'GToJSON'.+--+-- Decoding rules match aeson's defaults (see 'Options' and 'defaultOptions').+class GFromJSON (f :: Type -> Type) where+  gParseJSON :: Options -> Value -> Parser (f 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+  gParseJSON opts v = M1 <$> gFromJSONRep opts v+----------------------------------------------------------------------------+-- Internal: dispatches single-constructor vs sum at the child of D1.+class GFromJSONRep (f :: Type -> Type) where+  gFromJSONRep :: Options -> Value -> Parser (f a)+-- Single constructor+instance GFromFields f => GFromJSONRep (C1 m f) where+  gFromJSONRep opts v = M1 <$> parseProd opts v+-- Sum type: branch on allNullaryToStringTag+instance (GFromJSONSum f, GFromJSONSum g, GFromJSONSumNullary f, GFromJSONSumNullary g, GAllNullary f, GAllNullary g)+    => GFromJSONRep (f :+: g) where+  gFromJSONRep opts v+    | allNullaryToStringTag opts && gAllNullary @f && gAllNullary @g+    = gFromJSONSumNullary opts v+    | otherwise+    = gFromJSONSum opts v+----------------------------------------------------------------------------+-- | Parse all-nullary sum constructors from bare 'String' values.+class GFromJSONSumNullary (f :: Type -> Type) where+  gFromJSONSumNullary :: Options -> Value -> Parser (f a)+----------------------------------------------------------------------------+instance (GFromJSONSumNullary f, GFromJSONSumNullary g) => GFromJSONSumNullary (f :+: g) where+  gFromJSONSumNullary opts v =+    (L1 <$> gFromJSONSumNullary opts v) <|> (R1 <$> gFromJSONSumNullary opts v)+----------------------------------------------------------------------------+instance Constructor m => GFromJSONSumNullary (C1 m U1) where+  gFromJSONSumNullary opts v =+    let tag = ms (constructorTagModifier opts (conName (undefined :: C1 m U1 ())))+    in case v of+         String t | t == tag  -> pure (M1 U1)+                  | otherwise -> pfail ("expected \"" <> tag <> "\" got \"" <> t <> "\"")+         _        -> pfail ("expected String for nullary constructor " <> tag)+----------------------------------------------------------------------------+-- | Catch-all for non-nullary constructors — unreachable when 'gAllNullary'+-- guards are in place, but required for instance resolution.+instance {-# OVERLAPPABLE #-} Constructor m => GFromJSONSumNullary (C1 m f) where+  gFromJSONSumNullary _ _ = pfail "GFromJSONSumNullary: non-nullary constructor (impossible)"+----------------------------------------------------------------------------+-- | Parse sum constructors, trying each branch left-to-right.+class GFromJSONSum (f :: Type -> Type) where+  gFromJSONSum :: Options -> Value -> Parser (f a)+----------------------------------------------------------------------------+instance (GFromJSONSum f, GFromJSONSum g) => GFromJSONSum (f :+: g) where+  gFromJSONSum opts v = (L1 <$> gFromJSONSum opts v) <|> (R1 <$> gFromJSONSum opts v)+----------------------------------------------------------------------------+instance (Constructor m, GFromFields f) => GFromJSONSum (C1 m f) where+  gFromJSONSum opts v = M1 <$> parseTaggedCon tag opts v+    where tag = ms (constructorTagModifier opts (conName (undefined :: C1 m f ())))+----------------------------------------------------------------------------+-- | Parse a single-constructor (product) type from a 'Value'.+parseProd :: forall f a. GFromFields f => Options -> Value -> Parser (f a)+parseProd opts v+  | gIsRecord @f = withObject "generic record" (gFromRecord opts) v+  | otherwise    = case v of+      Array vs+        | gFieldCount @f == 1 -> gFromPositional opts [Array vs]+        | otherwise           -> gFromPositional opts vs+      _+        | gFieldCount @f == 0 -> pfail "expected Array [] for 0-field constructor"+        | gFieldCount @f == 1 -> gFromPositional opts [v]  -- single-field shorthand+        | otherwise           -> pfail "expected JSON Array for multi-field constructor"+----------------------------------------------------------------------------+-- | Parse a tagged sum constructor from an Object envelope.+parseTaggedCon :: forall f a. GFromFields f => MisoString -> Options -> Value -> Parser (f a)+parseTaggedCon tag opts = \case+  Object o -> do+    t <- case M.lookup "tag" o of+           Just (String t) -> pure t+           Just _          -> pfail "\"tag\" field is not a string"+           Nothing         -> pfail "missing \"tag\" field"+    if t /= tag+      then pfail ("expected tag " <> ms (show tag) <> ", got " <> ms (show t))+      else if gIsRecord @f+           then gFromRecord opts o+           else case M.lookup "contents" o of+                  Just (Array vs)+                    | gFieldCount @f == 1 -> gFromPositional opts [Array vs]+                    | otherwise           -> gFromPositional opts vs+                  Just single     -> gFromPositional opts [single]+                  Nothing         -> gFromPositional opts []+  _ -> pfail ("expected JSON object for constructor " <> ms (show tag))+----------------------------------------------------------------------------+-- | Field-level decoder. Knows whether the constructor is a record and+-- how many fields it has; can decode from a JSON 'Object' (record mode)+-- or a positional '[Value]' list.+class GFromFields (f :: Type -> Type) where+  -- | Is this a record constructor (all selectors have names)?+  gIsRecord      :: Bool+  -- | Number of fields.+  gFieldCount    :: Int+  -- | Decode from a JSON 'Object' (record mode: look up by field name).+  gFromRecord    :: Options -> Object -> Parser (f a)+  -- | Decode from a positional list of 'Value'.+  gFromPositional :: Options -> [Value] -> Parser (f a)+----------------------------------------------------------------------------+instance GFromFields U1 where+  gIsRecord       = False+  gFieldCount     = 0+  gFromRecord   _ _ = pure U1+  gFromPositional _ _ = pure U1+----------------------------------------------------------------------------+instance GFromFields V1 where+  gIsRecord       = False+  gFieldCount     = 0+  gFromRecord   _ _ = pfail "V1"+  gFromPositional _ _ = pfail "V1"+----------------------------------------------------------------------------+instance (GFromFields f, GFromFields g) => GFromFields (f :*: g) where+  gIsRecord       = gIsRecord @f+  gFieldCount     = gFieldCount @f + gFieldCount @g+  gFromRecord opts o =+    (:*:) <$> gFromRecord opts o+          <*> gFromRecord opts o+  gFromPositional opts vs =+    let n = gFieldCount @f+    in (:*:) <$> gFromPositional opts (take n vs)+             <*> gFromPositional opts (drop n vs)+----------------------------------------------------------------------------+-- | Selector with a 'Maybe' field: uses '.:?' so missing keys decode as Nothing.+instance {-# OVERLAPPING #-} (Selector m, FromJSON a)+    => GFromFields (S1 m (K1 r (Maybe a))) where+  gIsRecord       = not (null name)+    where name = selName (M1 undefined :: S1 m (K1 r (Maybe a)) ())+  gFieldCount     = 1+  gFromRecord opts o =+    M1 . K1 <$> o .:? ms (fieldLabelModifier opts+                    (selName (M1 undefined :: S1 m (K1 r (Maybe a)) ())))+  gFromPositional _ vs = case vs of+    (v:_) -> M1 . K1 <$> parseJSON v+    []    -> pure (M1 (K1 Nothing))+----------------------------------------------------------------------------+-- | General selector.+instance {-# OVERLAPPABLE #-} (Selector m, FromJSON a)+    => GFromFields (S1 m (K1 r a)) where+  gIsRecord       = not (null name)+    where name = selName (M1 undefined :: S1 m (K1 r a) ())+  gFieldCount     = 1+  gFromRecord opts o =+    M1 . K1 <$> o .: ms (fieldLabelModifier opts+                    (selName (M1 undefined :: S1 m (K1 r a) ())))+  gFromPositional _ vs = case vs of+    (v:_) -> M1 . K1 <$> parseJSON v+    []    -> pfail "gFromPositional: unexpected end of fields"+----------------------------------------------------------------------------+instance FromJSON Value where+  parseJSON = pure+----------------------------------------------------------------------------+instance FromJSON Bool where+  parseJSON = withBool "Bool" pure+----------------------------------------------------------------------------+instance FromJSON MisoString where+  parseJSON = withText "MisoString" pure+----------------------------------------------------------------------------+#ifndef VANILLA+instance FromJSON T.Text where+  parseJSON = withText "Text" go+    where+      go s =+        case MS.fromMisoStringEither s of+          Right lt -> pure lt+          Left e -> pfail $ ms e+#endif+----------------------------------------------------------------------------+instance FromJSON LT.Text where+  parseJSON = withText "LText" go+    where+      go s =+        case MS.fromMisoStringEither s of+          Right lt -> pure lt+          Left e -> pfail $ ms e+----------------------------------------------------------------------------+instance {-# OVERLAPPING #-} FromJSON String where+  parseJSON = withText "String" (pure . MS.unpack)+----------------------------------------------------------------------------+instance FromJSON a => FromJSON [a] where+  parseJSON = withArray "[a]" (mapM parseJSON)+----------------------------------------------------------------------------+instance FromJSON Double where+  parseJSON Null = pure (0/0)+  parseJSON j    = withNumber "Double" pure j+----------------------------------------------------------------------------+instance FromJSON Float where+  parseJSON Null = pure (0/0)+  parseJSON j    = withNumber "Float" (pure . realToFrac) j+----------------------------------------------------------------------------+instance FromJSON Integer where+  parseJSON = withNumber "Integer" (pure . round)+----------------------------------------------------------------------------+instance FromJSON Natural where+  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+----------------------------------------------------------------------------+instance FromJSON Int where+  parseJSON = withNumber "Int" (pure . fromInteger . round)+----------------------------------------------------------------------------+instance FromJSON Int8 where+  parseJSON = withNumber "Int8" (pure . fromInteger . round)+----------------------------------------------------------------------------+instance FromJSON Int16 where+  parseJSON = withNumber "Int16" (pure . fromInteger . round)+----------------------------------------------------------------------------+instance FromJSON Int32 where+  parseJSON = withNumber "Int32" (pure . fromInteger . round)+----------------------------------------------------------------------------+instance FromJSON Int64 where+  parseJSON = withNumber "Int64" (pure . fromInteger . round)+----------------------------------------------------------------------------+instance FromJSON Word where+  parseJSON = withNumber "Word" (pure . fromInteger . round)+----------------------------------------------------------------------------+instance FromJSON Word8 where+  parseJSON = withNumber "Word8" (pure . fromInteger . round)+----------------------------------------------------------------------------+instance FromJSON Word16 where+  parseJSON = withNumber "Word16" (pure . fromInteger . round)+----------------------------------------------------------------------------+instance FromJSON Word32 where+  parseJSON = withNumber "Word32" (pure . fromInteger . round)+----------------------------------------------------------------------------+instance FromJSON Word64 where+  parseJSON = withNumber "Word64" (pure . fromInteger . round)+----------------------------------------------------------------------------+instance FromJSON () where+  parseJSON = withArray "()" $ \lst ->+    case lst of+      [] -> pure ()+      _  -> pfail "expected ()"+----------------------------------------------------------------------------+instance (FromJSON a, FromJSON b) => FromJSON (a,b) where+  parseJSON = withArray "(a,b)" $ \lst ->+    case lst of+      [a,b] -> liftM2 (,) (parseJSON a) (parseJSON b)+      _     -> pfail "expected (a,b)"+----------------------------------------------------------------------------+instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where+  parseJSON = withArray "(a,b,c)" $ \lst ->+    case lst of+      [a,b,c] -> liftM3 (,,) (parseJSON a) (parseJSON b) (parseJSON c)+      _       -> pfail "expected (a,b,c)"+----------------------------------------------------------------------------+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a,b,c,d) where+  parseJSON = withArray "(a,b,c,d)" $ \lst ->+    case lst of+      [a,b,c,d] -> liftM4 (,,,) (parseJSON a) (parseJSON b) (parseJSON c) (parseJSON d)+      _         -> pfail "expected (a,b,c,d)"+----------------------------------------------------------------------------+instance FromJSON a => FromJSON (Maybe a) where+  parseJSON Null = pure Nothing+  parseJSON j    = Just <$> parseJSON j+----------------------------------------------------------------------------+instance FromJSON Ordering where+  parseJSON = withText "{'LT','EQ','GT'}" $ \s ->+    case s of+      "LT" -> pure LT+      "EQ" -> pure EQ+      "GT" -> pure GT+      _    -> pfail "expected {'LT','EQ','GT'}"+----------------------------------------------------------------------------+instance FromJSON Char where+  parseJSON = withText "Char" $ \xs ->+    case xs of+     x | MS.length x == 1 -> pure (MS.head x)+       | otherwise -> pfail ("expected Char, received: " <> x)+----------------------------------------------------------------------------+instance FromJSON v => FromJSON (Map MisoString v) where+  parseJSON = withObject "FromJSON v => Map MisoString v" $ mapM parseJSON+----------------------------------------------------------------------------+-- | 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+----------------------------------------------------------------------------+-- | 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+----------------------------------------------------------------------------+-- | 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+----------------------------------------------------------------------------+-- | 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+----------------------------------------------------------------------------+-- | 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+----------------------------------------------------------------------------+-- | 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+        Object _ -> "Object"+        Array _ -> "Array"+        String _ -> "String"+        Number _ -> "Number"+        Bool _ -> "Boolean"+        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+#else+encode :: ToJSON a => a -> MisoString+encode x = unsafePerformIO $ jsonStringify =<< toJSVal_Value (toJSON x)+#endif+----------------------------------------------------------------------------+-- | Relies on the pure implementation of JSON parsing / serialization.+--+-- This can be used on the server or the client, it is more efficient to+-- use 'encode' on the client (since it relies on @JSON.stringify()@).+--+encodePure :: ToJSON a => a -> MisoString+encodePure = ms . toJSON+----------------------------------------------------------------------------+instance FromMisoString Value where+  fromMisoStringEither = Parser.decodePure+----------------------------------------------------------------------------+-- | Escape special characters in a string for JSON serialization+-- Handles: \, ", and all JSON control characters per RFC 8259+escapeJSONString :: MisoString -> MisoString+escapeJSONString = MS.concatMap escapeChar+  where+    escapeChar :: Char -> MisoString+    escapeChar '\\' = "\\\\"   -- Backslash+    escapeChar '"'  = "\\\""   -- Double quote+    escapeChar '\b' = "\\b"    -- Backspace+    escapeChar '\f' = "\\f"    -- Form feed+    escapeChar '\n' = "\\n"    -- Newline+    escapeChar '\r' = "\\r"    -- Carriage return+    escapeChar '\t' = "\\t"    -- Tab+    escapeChar c+      | isControl c = ms ("\\u" <> padHex (ord c))  -- Other control chars as \uXXXX+      | otherwise   = singleton c++    padHex :: Int -> MisoString+    padHex n = MS.pack $ replicate (4 - length h) '0' ++ h+      where h = showHex n ""+----------------------------------------------------------------------------+instance ToMisoString Value where+  toMisoString = \case+    String s -> "\"" <> escapeJSONString s <> "\""+    Number n+      | (i, 0.0) <- properFraction n -> ms @Int i+      | otherwise -> ms n+    Null ->+      "null"+    Array xs ->+      "[" <> MS.intercalate "," (fmap ms xs) <> "]"+    Bool True ->+      "true"+    Bool False ->+      "false"+    Object o ->+      "{" <>+        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+  | Right x <- Parser.decodePure s+  , Success v <- fromJSON x = Just v+  | otherwise = Nothing+#else+decode :: FromJSON a => MisoString -> Maybe a+decode s+  | Right x <- eitherDecode s = Just x+  | otherwise = Nothing+#endif+-----------------------------------------------------------------------------+#ifdef GHCJS_OLD+foreign import javascript unsafe+  "$r = JSON.stringify($1, null, $2)"+  encodePretty_ffi :: JSVal -> Int -> IO MisoString+#endif+-----------------------------------------------------------------------------+#ifdef GHCJS_NEW+foreign import javascript unsafe+  "(($1) => { return JSON.stringify($1, null, $2); })"+  encodePretty_ffi :: JSVal -> Int -> IO MisoString+#endif+-----------------------------------------------------------------------------+#ifdef WASM+foreign import javascript unsafe+  "return JSON.stringify($1, null, $2);"+  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"+-----------------------------------------------------------------------------+#else+-----------------------------------------------------------------------------+encodePretty' :: ToJSON a => Config -> a -> MisoString+encodePretty' (Config s) x = unsafePerformIO (flip encodePretty_ffi s =<< toJSVal_Value (toJSON x))+-----------------------------------------------------------------------------+encodePretty :: ToJSON a => a -> MisoString+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)"+  jsonStringify :: JSVal -> IO MisoString+#endif+-----------------------------------------------------------------------------+#ifdef GHCJS_NEW+foreign import javascript unsafe+  "(($1) => { return JSON.stringify($1); })"+  jsonStringify :: JSVal -> IO MisoString+#endif+-----------------------------------------------------------------------------+#ifdef WASM+foreign import javascript unsafe+  "return JSON.stringify($1);"+  jsonStringify :: JSVal -> IO MisoString+#endif+-----------------------------------------------------------------------------+#ifdef VANILLA+jsonStringify :: JSVal -> IO MisoString+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)"+  jsonParse :: MisoString -> IO JSVal+#endif+-----------------------------------------------------------------------------+#ifdef GHCJS_NEW+foreign import javascript unsafe+  "(($1) => { return JSON.parse($1); })"+  jsonParse :: MisoString -> IO JSVal+#endif+-----------------------------------------------------------------------------+#ifdef WASM+foreign import javascript unsafe+  "return JSON.parse($1);"+  jsonParse :: MisoString -> IO JSVal+#endif+-----------------------------------------------------------------------------+#ifdef VANILLA+jsonParse :: MisoString -> IO JSVal+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 =+  case Parser.decodePure string of+    Left s ->+      Left (pack s)+    Right v ->+      parseEither parseJSON v+#else+eitherDecode :: FromJSON a => MisoString -> Either MisoString a+eitherDecode string = unsafePerformIO $ do+  (jsonParse string >>= fromJSVal_Value) >>= \case+    Nothing ->+      pure $ Left ("eitherDecode: " <> string)+    Just result ->+      pure (case fromJSON result of+        Success x -> Right x+        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+  Null ->+    pure jsNull+  Bool bool_ ->+    Marshal.toJSVal bool_+  String string ->+    Marshal.toJSVal string+  Number double ->+    Marshal.toJSVal double+  Array arr ->+    toJSVal_List =<< mapM toJSVal_Value arr+  Object hms -> do+    o <- create_ffi+    forM_ (M.toList hms) $ \(k,v) -> do+      v' <- toJSVal_Value v+      setProp_ffi k v' o+    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+  typeof jsval_ >>= \case+    0 -> return (Just Null)+    1 -> Just . Number <$> Marshal.fromJSValUnchecked jsval_+    2 -> Just . String <$> Marshal.fromJSValUnchecked jsval_+    3 -> fromJSValUnchecked_Int jsval_ >>= \case+      0 -> pure $ Just (Bool False)+      1 -> pure $ Just (Bool True)+      _ -> pure Nothing+    4 -> do xs <- Marshal.fromJSValUnchecked jsval_+            values <- forM xs fromJSVal_Value+            pure (Array <$> sequence values)+    5 -> do keys <- Marshal.fromJSValUnchecked =<< listProps_ffi jsval_+            result <-+              runMaybeT $ forM keys $ \k -> do+                key <- MaybeT (Marshal.fromJSVal k)+                raw <- MaybeT $ Just <$> getProp_ffi key jsval_+                value <- MaybeT (fromJSVal_Value raw)+                pure (key, value)+            pure (toObject <$> result)+    _ -> error "fromJSVal_Value: Unknown JSON type"+  where+    toObject = Object . M.fromList+#endif+-----------------------------------------------------------------------------+#ifdef WASM+fromJSVal_Value :: JSVal -> IO (Maybe Value)+fromJSVal_Value jsval = do+  typeof jsval >>= \case+    0 -> return (Just Null)+    1 -> Just . Number <$> fromJSValUnchecked_Double jsval+    2 -> pure $ Just $ String $ (JSString jsval)+    3 -> fromJSValUnchecked_Int jsval >>= \case+      0 -> pure $ Just (Bool False)+      1 -> pure $ Just (Bool True)+      _ -> pure Nothing+    4 -> do xs <- fromJSValUnchecked_List jsval+            values <- forM xs fromJSVal_Value+            pure (Array <$> sequence values)+    5 -> do keys <- fromJSValUnchecked_List =<< listProps_ffi jsval+            result <-+              runMaybeT $ forM keys $ \k -> do+                let key = JSString k+                raw <- MaybeT $ Just <$> getProp_ffi key jsval+                value <- MaybeT (fromJSVal_Value raw)+                pure (key, value)+            pure (toObject <$> result)+    _ -> error "fromJSVal_Value: Unknown JSON type"+  where+    toObject = Object . M.fromList+#endif+-----------------------------------------------------------------------------+#ifdef VANILLA+-----------------------------------------------------------------------------+fromJSVal_Value :: JSVal -> IO (Maybe Value)+fromJSVal_Value = error "fromJSVal_Value: not implemented"+-----------------------------------------------------------------------------+toJSVal_Value :: Value -> IO JSVal+toJSVal_Value = error "toJSVal_Value: not implemented"+-----------------------------------------------------------------------------+#endif+-----------------------------------------------------------------------------+#ifdef GHCJS_NEW+foreign import javascript unsafe+  "(($1) => { return globalThis.miso.typeOf($1); })"+  typeof :: JSVal -> IO Int+#endif+-----------------------------------------------------------------------------+#ifdef WASM+foreign import javascript unsafe+ "return globalThis.miso.typeOf($1);"+  typeof :: JSVal -> IO Int+#endif+-----------------------------------------------------------------------------+#ifdef GHCJS_OLD+foreign import javascript unsafe+  "$r = globalThis.miso.typeOf($1);"+  typeof :: JSVal -> IO Int+#endif+-----------------------------------------------------------------------------+#ifdef WASM+toJSVal_Value :: Value -> IO JSVal+toJSVal_Value = \case+  Null ->+    pure jsNull+  Bool bool_ ->+    toJSVal_Bool bool_+  String string ->+    toJSVal_JSString string+  Number double ->+    toJSVal_Double double+  Array arr ->+    toJSVal_List =<< mapM toJSVal_Value arr+  Object hms -> do+    o <- create_ffi+    forM_ (M.toList hms) $ \(k,v) -> do+      v' <- toJSVal_Value v+      setProp_ffi k v' o+    pure o+#endif+-----------------------------------------------------------------------------
+ src/Miso/JSON/Lexer.hs view
@@ -0,0 +1,150 @@+----------------------------------------------------------------------------+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.JSON.Lexer+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "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 <https://github.com/dmjio/json-test> by+-- <https://github.com/ners @ners>.+--+-- = 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+-- <https://www.rfc-editor.org/rfc/rfc8259#section-7 RFC 8259 escape sequences>+-- 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+----------------------------------------------------------------------------+import           Control.Applicative (Alternative (some, many), optional)+import           Control.Monad (replicateM)+import           Data.Char (isHexDigit, chr, isSpace)+import           Data.Foldable (Foldable (fold))+import           Data.Functor (void)+import           Data.Ix (Ix (inRange))+import           Data.Maybe (catMaybes)+import           Numeric (readHex)+import           Prelude hiding (null)+----------------------------------------------------------------------------+import           Miso.String (fromMisoString, ToMisoString (toMisoString), MisoString)+import           Miso.Util (oneOf)+import           Miso.Util.Lexer hiding (string', token)+----------------------------------------------------------------------------+#if __GLASGOW_HASKELL__ <= 881+import Control.Applicative (liftA2)+#endif+----------------------------------------------------------------------------+data Token+  = TokenPunctuator Char+  | TokenNumber Double+  | TokenBool Bool+  | TokenString MisoString+  | TokenNull+  deriving (Eq, Show)+----------------------------------------------------------------------------+number :: Lexer Double+number = fromMisoString . fold . catMaybes <$> sequence+  [ optional $ string "-"+  , Just <$> int+  , optional $ liftA2 (<>) (string ".") int+  , optional $ liftA2 (<>) (oneOf $ string <$> ["e", "e+", "e-", "E", "E+", "E-"]) int+  ] where+      digit = satisfy $ inRange ('0', '9')+      int = toMisoString <$> some digit+----------------------------------------------------------------------------+bool :: Lexer Bool+bool = oneOf+  [ False <$ string "false"+  , True <$ string "true"+  ]+----------------------------------------------------------------------------+string' :: Lexer MisoString+string' = char '"' *> (toMisoString <$> many character) <* char '"'+  where+    character = oneOf+      [ satisfy $ \c -> c /= '"' && c /= '\\'+      , escapedCharacter+      ]+    hexDigit = satisfy isHexDigit+    escaped = (char '\\' *>)+    escapedCharacter = escaped $ oneOf+      [ char '"'+      , char '\\'+      , char '/'+      , '\b' <$ char 'b'+      , '\f' <$ char 'f'+      , '\n' <$ char 'n'+      , '\r' <$ char 'r'+      , '\t' <$ char 't'+      , unicodeHexQuad >>= \high -> do+          if inRange highSurrogateRange high+            then do+              low <- escaped unicodeHexQuad+              if inRange lowSurrogateRange low+                then+                  pure . chr . sum $+                    [ (high - fst highSurrogateRange) * 0x400+                    , low - fst lowSurrogateRange+                    , 0x10000+                    ]+                else oops+            else+              pure $ chr high+      ]+    highSurrogateRange = (0xD800, 0xDBFF)+    lowSurrogateRange = (0xDC00, 0xDFFF)+    unicodeHexQuad = char 'u' *> do+        [(num, "")] <- readHex <$> replicateM 4 hexDigit+        pure num+----------------------------------------------------------------------------+null :: Lexer ()+null = void (string "null")+----------------------------------------------------------------------------+punctuator :: Lexer Char+punctuator = oneOf (char <$> "[]{},:")+----------------------------------------------------------------------------+whitespace :: Lexer ()+whitespace = void (satisfy isSpace)+----------------------------------------------------------------------------+token :: Lexer Token+token = oneOf+  [ TokenPunctuator <$> punctuator+  , TokenNumber <$> number+  , TokenBool <$> bool+  , TokenString <$> string'+  , TokenNull <$ null+  ]+----------------------------------------------------------------------------+tokens :: Lexer [Token]+tokens = some (many whitespace *> token)+----------------------------------------------------------------------------
+ src/Miso/JSON/Parser.hs view
@@ -0,0 +1,104 @@+----------------------------------------------------------------------------+-- |+-- Module      :  Miso.JSON.Parser+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "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 <https://github.com/dmjio/json-test> by+-- <https://github.com/ners @ners>.+--+-- = 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+----------------------------------------------------------------------------+import           Data.Bifunctor (Bifunctor(first))+import           Data.Functor (void)+import           Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import           Prelude hiding (null)+----------------------------------------------------------------------------+import           Miso.JSON.Types+import           Miso.JSON.Lexer (Token (..), tokens)+import           Miso.String (MisoString)+import           Miso.Util (sepBy, oneOf)+import           Miso.Util.Parser+import           Miso.Util.Lexer (runLexer, mkStream)+----------------------------------------------------------------------------+number :: Parser Token Double+number = do+  TokenNumber d <- anyToken+  pure d+----------------------------------------------------------------------------+bool :: Parser Token Bool+bool = do+  TokenBool b <- anyToken+  pure b+----------------------------------------------------------------------------+string' :: Parser Token MisoString+string' = do+  TokenString s <- anyToken+  pure s+----------------------------------------------------------------------------+array :: Parser Token [Value]+array = do+  void . token_ $ TokenPunctuator '['+  values <- sepBy (token_ $ TokenPunctuator ',') value+  void . token_ $ TokenPunctuator ']'+  pure values+----------------------------------------------------------------------------+object :: Parser Token (Map MisoString Value)+object = do+  void . token_ $ TokenPunctuator '{'+  fields <- sepBy (token_ $ TokenPunctuator ',') $ do+    key <- string'+    void . token_ $ TokenPunctuator ':'+    val <- value+    pure (key, val)+  void . token_ $ TokenPunctuator '}'+  pure $ Map.fromList fields+----------------------------------------------------------------------------+null :: Parser Token ()+null = void $ token_ TokenNull+----------------------------------------------------------------------------+value :: Parser Token Value+value = oneOf+  [ Number <$> number+  , Bool <$> bool+  , String <$> string'+  , Array <$> array+  , Object <$> object+  , Null <$ null+  ]+----------------------------------------------------------------------------+decodePure :: MisoString -> Either String Value+decodePure = first show+  . either (Left . LexicalError) (parse value . fst)+  . runLexer tokens+  . mkStream+----------------------------------------------------------------------------
+ src/Miso/JSON/Types.hs view
@@ -0,0 +1,149 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.JSON.Types+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.JSON.Types" defines the two core types used throughout miso's JSON+-- support:+--+-- * 'Value' — an+--   <https://www.json.org/ RFC 8259>-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 <https://github.com/dmjio/json-test> by+-- <https://github.com/ners @ners>.+--+-- = 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+  ( -- * Types+    Value (..)+  , Result (..)+  , Pair+  , Object+  ) where+----------------------------------------------------------------------------+import Control.Applicative (Alternative (..))+import Control.Monad (MonadPlus(..), ap)+import Data.Map.Strict (Map)+----------------------------------------------------------------------------+import Data.String (IsString(fromString))+import Miso.String (MisoString, toMisoString)+----------------------------------------------------------------------------+#if __GLASGOW_HASKELL__ <= 881+import Prelude hiding (fail)+import Control.Monad.Fail (MonadFail (..))+#endif+----------------------------------------------------------------------------+data Value+  = Number Double+  | Bool Bool+  | String MisoString+  | Array [Value]+  | Object (Map MisoString Value)+  | Null+  deriving (Show, Eq)+----------------------------------------------------------------------------+instance IsString Value where+  fromString = String . fromString+----------------------------------------------------------------------------+type Pair = (MisoString, Value)+----------------------------------------------------------------------------+type Object = Map MisoString Value+----------------------------------------------------------------------------+data Result a+  = Success a+  | Error MisoString+  deriving (Show, Eq)+----------------------------------------------------------------------------+instance Functor Result where+  fmap f (Success a) = Success (f a)+  fmap _ (Error err) = Error err+  {-# INLINE fmap #-}+----------------------------------------------------------------------------+instance Applicative Result where+  pure  = Success+  {-# INLINE pure #-}+  (<*>) = ap+  {-# INLINE (<*>) #-}+----------------------------------------------------------------------------+instance Monad Result where+  return = pure+  {-# INLINE return #-}+  Success a >>= k = k a+  Error err >>= _ = Error err+  {-# INLINE (>>=) #-}+----------------------------------------------------------------------------+instance MonadFail Result where+  fail err = Error $ toMisoString err+  {-# INLINE fail #-}+----------------------------------------------------------------------------+instance Alternative Result where+  empty = mzero+  {-# INLINE empty #-}+  (<|>) = mplus+  {-# INLINE (<|>) #-}+----------------------------------------------------------------------------+instance MonadPlus Result where+  mzero = fail "mzero"+  {-# INLINE mzero #-}+  mplus a@(Success _) _ = a+  mplus _ b             = b+  {-# INLINE mplus #-}+----------------------------------------------------------------------------+instance Semigroup (Result a) where+  (<>) = mplus+  {-# INLINE (<>) #-}+----------------------------------------------------------------------------+instance Monoid (Result a) where+  mempty  = fail "mempty"+  {-# INLINE mempty #-}+  mappend = (<>)+  {-# INLINE mappend #-}+----------------------------------------------------------------------------+instance Foldable Result where+  foldMap _ (Error _)   = mempty+  foldMap f (Success y) = f y+  {-# INLINE foldMap #-}+----------------------------------------------------------------------------+  foldr _ z (Error _)   = z+  foldr f z (Success y) = f y z+  {-# INLINE foldr #-}+----------------------------------------------------------------------------+instance Traversable Result where+  traverse _ (Error err) = pure (Error err)+  traverse f (Success a) = Success <$> f a+  {-# INLINE traverse #-}+----------------------------------------------------------------------------
+ src/Miso/Lens.hs view
@@ -0,0 +1,912 @@+-----------------------------------------------------------------------------+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE TypeFamilies        #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE RankNTypes          #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Lens+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- A simple t'Lens' formulation compatible with @lens@ and @microlens@.+--+-- The t'Lens' type is defined as:+--+-- @+-- data 'Lens' record field+--  = 'Lens'+--  { '_get' :: record -> field+--  , '_set' :: record -> field -> record+--  }+-- @+--+-- Key features:+--+-- * 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 more on the van Laarhoven formulation, see the+-- [lens](https://hackage.haskell.org/package/lens) library.+--+-- === Example: Lenses for a nested record+--+-- @+-- data Person = Person+--   { _name :: String+--   , _address :: Address+--   , _age  :: Int+--   } deriving (Show, Eq, Generic)+--+-- newtype Address+--   = Address+--   { _zipCode :: Zip+--   } deriving (Show, Eq)+--+-- type Zip = String+--+-- name :: Lens Person String+-- name = 'lens' _name $ \\record x -> record { _name = x }+--+-- address :: Lens Person Address+-- address = 'lens' _address $ \\record x -> record { _address = x }+--+-- zipCode :: Lens Address Zip+-- zipCode = 'lens' _zipCode $ \\record x -> record { _zipCode = x }+--+-- -- Lenses compose via '.'+-- personZip :: Lens Person Zip+-- personZip = zipCode . address+--+-- main :: IO ()+-- main = print $ person '&' address '.~' Address "10012"+--   -- Person { _name = "john", _age = 33, _address = Address {_zipCode = "10012"} }+-- @+--+-- === Example: Usage with the @Effect@ monad+--+-- @+-- newtype Model = Model { _value :: Int }+--+-- value :: Lens Model Int+-- value = 'lens' _value $ \\model v -> model { _value = v }+--+-- data Action = AddOne | SubtractOne+--+-- updateModel :: Action -> Effect parent Model Action+-- updateModel = \\case+--   AddOne    -> value '+=' 1+--   SubtractOne -> value '-=' 1+-- @+----------------------------------------------------------------------------+module Miso.Lens+  ( -- ** Types+    Lens+  , LensCore (..)+  , Prism (..)+    -- ** Smart constructor+  , lens+  , prism+    -- ** Re-exports+  , (&)+  , (<&>)+    -- ** Lens Combinators+  , (.~)+  , (?~)+  , set+  , (%~)+  , over+  , (^.)+  , (+~)+  , (*~)+  , (//~)+  , (-~)+  , (%=)+  , (%?=)+  , modifying+  , (+=)+  , (*=)+  , (//=)+  , (-=)+  , (.=)+  , (<~)+  , (<%=)+  , (<.=)+  , (<?=)+  , (<<.=)+  , (<<%=)+  , assign+  , use+  , view+  , (?=)+  , (<>~)+  , _1+  , _2+  , _id+  , this+    -- ** Prism Combinators+  , preview+  , preuse+  , review+  , _Nothing+  , _Just+  , _Left+  , _Right+  , (^?)+  -- *** Containers+  , At (..)+  -- *** Re-exports+  , compose+  -- *** Conversion+  , Lens'+  , toVL+  , fromVL+  ) where+----------------------------------------------------------------------------+import Control.Monad.Reader (MonadReader, asks)+import Control.Monad.State (MonadState, modify, gets)+import Control.Monad.Identity (Identity(..))+import Control.Category (Category (..))+import Control.Arrow ((>>>))+import Data.Functor.Const (Const(..))+import Data.Function ((&))+import Data.Functor((<&>))+import Data.Kind (Type)+import qualified Data.Map.Strict as M+import Data.Map.Strict (Map)+import qualified Data.Set as S+import Data.Set (Set)+import qualified Data.IntMap.Strict as IM+import Data.IntMap.Strict (IntMap)+import qualified Data.IntSet as IS+import Data.IntSet (IntSet)+import Prelude hiding ((.))+----------------------------------------------------------------------------+import Miso.Util (compose)+----------------------------------------------------------------------------+-- | A t'Lens' is a generalized getter and setter.+--+-- Lenses allow both the retrieval of values from fields in a record and the+-- assignment of values to fields in a record. The power of a t'Lens' comes+-- from its ability to be composed with other lenses.+--+-- In the context of building applications with miso, the @model@ is+-- often a deeply nested product type. This makes it highly conducive+-- to t'Lens' operations (as defined below).+--+type Lens s a = LensCore a s+----------------------------------------------------------------------------+-- | t'LensCore' is an internal type used to reverse composition like+-- VL libraries do.+data LensCore field record+  = Lens+  { _get :: record -> field+    -- ^ Retrieves a field from a record+  , _set :: field -> record -> record+    -- ^ Sets a field on a record+  }+----------------------------------------------------------------------------+-- | 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 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 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+    _get record = getConst (lens_ Const record)+    _set field = runIdentity . lens_ (\_ -> Identity field)+----------------------------------------------------------------------------+-- | t'Lens' form a 'Category', and can therefore be composed.+instance Category LensCore where+  id = Lens Prelude.id const+  Lens g1 s1 . Lens g2 s2 = Lens+    { _get = g1 >>> g2+    , _set = \f r -> s1 (s2 f (g1 r)) r+    }+----------------------------------------------------------------------------+-- | Set a field on a record+--+-- @+-- newtype Person = Person { _name :: String }+--+-- name :: Lens Person String+-- name = lens _name $ \\person n -> person { _name = n }+--+-- setName :: Person -> String -> Person+-- setName person newName = person & name .~ newName+-- @+infixr 4 .~+(.~) :: Lens record field -> field -> record -> record+(.~) _lens = _set _lens+----------------------------------------------------------------------------+-- | Synonym for '(.~)'+--+set :: Lens record field -> field -> record -> record+set = (.~)+----------------------------------------------------------------------------+-- | Set an options field on a record+--+-- @+-- newtype Person = Person { _name :: Maybe String }+--+-- name :: Lens Person (Maybe String)+-- name = lens _name $ \\person n -> person { _name = n }+--+-- setName :: Person -> String -> Person+-- setName person newName = person & name ?~ newName+-- @+infixr 4 ?~+(?~) :: Lens record (Maybe field) -> field -> record -> record+(?~) _lens f r = r & _lens .~ Just f+----------------------------------------------------------------------------+-- | Modify a field on a record by applying a function to it.+--+-- @+-- newtype Counter = Counter { _value :: Int }+--+-- value :: Lens Counter Int+-- value = lens _value $ \\counter v -> counter { _value = v }+--+-- increment :: Counter -> Counter+-- increment counter = counter & value %~ (+1)+-- @+infixr 4 %~+(%~) :: Lens record field -> (field -> field) -> record -> record+(%~) _lens f record = _set _lens (f (record ^. _lens)) record+----------------------------------------------------------------------------+-- | Synonym for '(%~)'+over :: Lens record field -> (field -> field) -> record -> record+over = (%~)+----------------------------------------------------------------------------+-- | Read a field from a record using a t'Lens'+--+-- @+-- newtype Person = Person { _name :: String }+--   deriving (Show, Eq)+--+-- name :: Lens Person String+-- name = lens _name $ \\person n -> person { _name = n }+--+-- getName :: Person -> String+-- getName = person ^. name+-- @+infixl 8 ^.+(^.) :: record -> Lens record field -> field+(^.) = flip _get+----------------------------------------------------------------------------+-- | Increment a @Num field => field@ on a record using a t'Lens'+--+-- @+-- newtype Person = Person { _age :: Int }+--+-- age :: Lens Person Int+-- age = lens _age $ \\person a -> person { _age = a }+--+-- birthday :: Person -> Person+-- birthday person = person & age +~ 1+-- @+infixr 4 +~+(+~) :: Num field => Lens record field -> field -> record -> record+(+~) _lens x record = record & _lens %~ (+x)+----------------------------------------------------------------------------+-- | Multiply a @Num@eric field on a record using a t'Lens'+--+-- @+-- newtype Circle = Circle { _radius :: Int }+--+-- radius :: Lens Circle Int+-- radius = lens _radius $ \\circle r -> circle { _radius = r }+--+-- expand :: Circle -> Circle+-- expand circle = circle & radius *~ 10+-- @+infixr 4 *~+(*~) :: Num field => Lens record field -> field -> record -> record+(*~) _lens x record = record & _lens %~ (*x)+----------------------------------------------------------------------------+-- | Divide a @Fractional@ field on a record using a t'Lens'+--+-- @+-- newtype Circle = Circle { _radius :: Int }+--+-- radius :: Lens Circle Int+-- radius = lens _radius $ \\circle r -> circle { _radius = r }+--+-- shrink :: Circle -> Circle+-- shrink circle = circle & radius //~ 10+-- @+infixr 4 //~+(//~) :: Fractional field => Lens record field -> field -> record -> record+(//~) _lens x record = record & _lens %~ (/x)+----------------------------------------------------------------------------+-- | Increment a @Num@eric field on a record using a t'Lens'+--+-- @+-- newtype Person = Person { _age :: Int }+--+-- age :: Lens Person Int+-- age = lens _age $ \\person a -> person { _age = a }+--+-- timeTravel :: Person -> Person+-- timeTravel person = person & age -~ 1+-- @+infixr 4 -~+(-~) :: Num field => Lens record field -> field -> record -> record+(-~) _lens x record = record & _lens %~ subtract x+----------------------------------------------------------------------------+-- | Monoidally append a field in a record using a t'Lens'+--+-- @+-- newtype List = List { _values :: [Int] }+--+-- values :: Lens List [Int]+-- values = lens _values $ \\l vs -> l { _values = vs }+--+-- addElement :: List -> List+-- addElement list = list & values <>~ [2]+--+-- addElement (List [])+-- -- List [2]+-- @+--+infixr 4 <>~+(<>~) :: Monoid field => Lens record field -> field -> record -> record+(<>~) _lens x record = record & _lens %~ (<> x)+----------------------------------------------------------------------------+-- | Execute a monadic action in @MonadState@ that returns a field. Sets the+-- return value equal to the field in the record.+--+-- As a reasonable mnemonic, this lets you store the result of a monadic action in a t'Lens' rather than+-- in a local variable.+--+-- @+-- do foo <- bar+--    ...+-- @+--+-- will store the result in a variable, while+--+-- @+-- do fooLens '<~' bar+--    ...+-- @+--+-- will store the result in field focused by the t'Lens'.+infixr 2 <~+(<~) :: MonadState record m => Lens record field -> m field -> m ()+l <~ mb = do+  b <- mb+  l .= b+----------------------------------------------------------------------------+-- | Modify a record in @MonadState@ monad at a field using a t'Lens'+--+-- @+-- newtype Model = Model { _value :: Int }+--+-- data Action = AddOne | SubtractOne+--+-- value :: Lens Model Int+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update AddOne = do+--   value %= (+1)+-- @+infix 4 %=+(%=) :: MonadState record m => Lens record field -> (field -> field) -> m ()+(%=) _lens f = modify (\r -> r & _lens %~ f)+----------------------------------------------------------------------------+-- | Synonym for '(%=)'+modifying :: MonadState record m => Lens record field -> (field -> field) -> m ()+modifying = (%=)+----------------------------------------------------------------------------+-- | Modify the field of a record in @MonadState@ using a t'Lens', then+-- return the newly modified field from the updated record.+--+-- @+-- import Miso.String (ms)+--+-- newtype Model = Model { _value :: Int }+--   deriving (Show)+--+-- data Action = AddOne+--+-- value :: Lens Model Int+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update AddOne = do+--   result <- value <%= (+1)+--   io_ $ consoleLog (ms result)+-- @+infix 4 <%=+(<%=) :: MonadState record m => Lens record field -> (field -> field) -> m field+l <%= f = do+  l %= f+  use l+----------------------------------------------------------------------------+-- | Assign the field of a record in @MonadState@ to a value using a t'Lens'+-- Return the value after assignment.+--+-- @+-- import Miso.String (ms)+--+-- newtype Model = Model { _value :: Int }+--+-- data Action = Assign Int+--+-- value :: Lens Model Int+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update (Assign x) = do+--   result <- value <.= x+--   io_ $ consoleLog (ms result) -- x+-- @+infix 4 <.=+(<.=) :: MonadState record m => Lens record field -> field -> m field+l <.= b = do+  l .= b+  return b+----------------------------------------------------------------------------+-- | Assign the field of a record in a @MonadState@ to a value (wrapped in a 'Just')+-- using a t'Lens'. Return the value after assignment.+--+-- @+-- import Miso.String (ms)+--+-- newtype Model = Model { _value :: Maybe Int }+--+-- data Action = SetValue Int+--+-- value :: Lens Model (Maybe Int)+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update (SetValue x) = do+--   result <- value <?= x+--   io_ $ consoleLog (ms result) -- Just 1+-- @+infix 4 <?=+(<?=) :: MonadState record m => Lens record (Maybe field) -> field -> m field+l <?= b = do+  l ?= b+  return b+----------------------------------------------------------------------------+-- | Assign the field of a record in a @MonadState@ to a value using a t'Lens'.+-- Returns the /previous/ value, before assignment.+--+-- @+-- import Miso.String (ms)+--+-- newtype Model = Model { _value :: Int }+--   deriving (Show, Eq)+--+-- data Action = Assign Int+--   deriving (Show, Eq)+--+-- value :: Lens Model Int+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update (Assign x) = do+--   value .= x+--   previousValue <- value <<.= 1+--   io_ $ consoleLog $ ms previousValue -- prints value at x+-- @+infix 4 <<.=+(<<.=) :: MonadState record m => Lens record field -> field -> m field+l <<.= b = do+  old <- use l+  l .= b+  return old+----------------------------------------------------------------------------+-- | Retrieves the field associated with a record in @MonadReader@ using a t'Lens'.+--+-- @+-- import Miso.String (ms)+--+-- newtype Model = Model { _value :: Int }+--   deriving (Show, Eq)+--+-- data Action = PrintInt+--+-- value :: Lens Model Int+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update PrintInt = do+--   Model x <- view value+--   io_ $ consoleLog (ms x) -- prints model value+-- @+----------------------------------------------------------------------------+view :: MonadReader record m => Lens record field -> m field+view lens_ = asks (^. lens_)+----------------------------------------------------------------------------+-- | Modifies the field of a record in @MonadState@ using a t'Lens'.+-- Returns the /previous/ value, before modification.+--+-- @+-- import Miso.String (ms)+--+-- newtype Model = Model { _value :: Int }+--   deriving (Show, Eq)+--+-- data Action = Modify (Int -> Int)+--+-- value :: Lens Model Int+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update (Modify f) = do+--   value .= 2+--   result <- value <<%= f+--   io_ $ consoleLog (ms result) -- prints previous value of 2+-- @+infix 4 <<%=+(<<%=) :: MonadState record m => Lens record field -> (field -> field) -> m field+l <<%= f = do+  old <- use l+  l %= f+  return old+----------------------------------------------------------------------------+-- | Sets the value of a field in a record using @MonadState@ and a t'Lens'+--+-- @+-- newtype Model = Model { _value :: Int }+--   deriving (Show, Eq)+--+-- data Action = SetValue Int+--+-- value :: Lens Model Int+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update' :: Action -> Effect parent Model Action+-- update' (SetValue v) = value .= v+-- @+infix 4 .=+(.=) :: MonadState record m => Lens record field -> field -> m ()+(.=) _lens f = modify (\r -> r & _lens .~ f)+----------------------------------------------------------------------------+-- | Synonym for '(.=)'+assign :: MonadState record m => Lens record field -> field -> m ()+assign = (.=)+----------------------------------------------------------------------------+-- | Retrieves the value of a field in a record using a t'Lens' inside @MonadState@+--+-- @+-- import Miso.String (ms)+--+-- newtype Model = Model { _value :: Int }+--   deriving (Show, Eq)+--+-- data Action = SetValue Int+--+-- value :: Lens Model Int+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update (SetValue x) = do+--   value .= x+--   result <- use value+--   io_ $ consoleLog (ms result) -- prints the value of x+-- @+use :: MonadState record m => Lens record field -> m field+use _lens = gets (^. _lens)+----------------------------------------------------------------------------+-- | Sets the value of a field in a record using a t'Lens' inside a @MonadState@+-- The value is wrapped in a @Just@ before being assigned.+--+-- @+-- newtype Model = Model { _value :: Maybe Int }+--   deriving (Show, Eq)+--+-- data Action = AssignValue Int+--+-- value :: Lens Model (Maybe Int)+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update (AssignValue x) = value ?= x+-- @+infix 4 ?=+(?=) :: MonadState record m => Lens record (Maybe field) -> field -> m ()+(?=) _lens value = _lens .= Just value+----------------------------------------------------------------------------+-- | Alters the @Just@ value of a field in a record using a t'Lens' inside a @MonadState@+--+-- @+-- newtype Model = Model { _value :: Maybe Int }+--   deriving (Show, Eq)+--+-- data Action = IncrementIfJust+--+-- value :: Lens Model (Maybe Int)+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update IncrementIfJust = value %?= (+1)+--+-- @+infix 4 %?=+(%?=) :: MonadState record m => Lens record (Maybe field) -> (field -> field) -> m ()+(%?=) _lens f = _lens %= \case+  Nothing -> Nothing+  Just x -> Just (f x)+----------------------------------------------------------------------------+-- | Increments the value of a @Num@eric field of a record using a t'Lens'+-- inside a @State@ Monad.+--+-- @+-- newtype Model = Model { _value :: Int }+--   deriving (Show, Eq)+--+-- data Action = IncrementBy Int+--+-- value :: Lens Model Int+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update (IncrementBy x) = value '+=' x+-- @+infix 4 +=+(+=) :: (MonadState record m, Num field)  => Lens record field -> field -> m ()+(+=) _lens f = modify (\r -> r & _lens +~ f)+----------------------------------------------------------------------------+-- | Multiplies the value of a @Num@eric field of a record using a t'Lens'+-- inside a @State@ Monad.+--+-- @+-- newtype Model = Model { _value :: Int }+--   deriving (Show, Eq)+--+-- data Action = MultiplyBy Int+--+-- value :: Lens Model Int+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update (MultiplyBy x) = value *= x+-- @+infix 4 *=+(*=) :: (MonadState record m, Num field)  => Lens record field -> field -> m ()+(*=) _lens f = modify (\r -> r & _lens *~ f)+----------------------------------------------------------------------------+-- | Divides the value of a @Fractional@ field of a record using a t'Lens'+-- inside a @State@ Monad.+--+-- @+-- newtype Model = Model { _value :: Double }+--   deriving (Show, Eq)+--+-- data Action = DivideBy Double+--+-- value :: Lens Model Double+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update (DivideBy x) = value //= x+-- @+infix 4 //=+(//=) :: (MonadState record m, Fractional field)  => Lens record field -> field -> m ()+(//=) _lens f = modify (\r -> r & _lens %~ (/ f))+----------------------------------------------------------------------------+-- | Subtracts the value of a @Num@eric field of a record using a t'Lens'+-- inside of a @State@ Monad.+--+-- @+-- newtype Model = Model { _value :: Double }+--   deriving (Show, Eq)+--+-- data Action = SubtractBy Double+--+-- value :: Lens Model Double+-- value = lens _value $ \\p x -> p { _value = x }+--+-- update :: Action -> Effect parent Model Action+-- update (SubtractBy x) = value -= x+-- @+infix 4 -=+(-=) :: (MonadState record m, Num field) => Lens record field -> field -> m ()+(-=) _lens f = modify (\r -> r & _lens -~ f)+---------------------------------------------------------------------------------+-- | t'Lens' that operates on the first element of a tuple+--+-- @+-- update AddOne = do+--   _1 'Miso.Lens.+=' 1+-- @+_1 :: Lens (a,b) a+_1 = lens fst $ \(_,b) x -> (x,b)+---------------------------------------------------------------------------------+-- | t'Lens' that operates on the second element of a tuple+--+-- @+-- update AddOne = do+--   _2 'Miso.Lens.+=' 1+-- @+_2 :: Lens (a,b) b+_2 = lens snd $ \(a,_) x -> (a,x)+---------------------------------------------------------------------------------+-- | t'Lens' that operates on itself+--+-- @+-- update AddOne = do+--   _id 'Miso.Lens.+=' 1+-- @+_id :: Lens a a+_id = Control.Category.id+---------------------------------------------------------------------------------+-- | t'Lens' that operates on itself+--+-- @+-- update AddOne = do+--   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 }+--+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+(^?) = flip preview+----------------------------------------------------------------------------+-- | 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.+--+-- > M.singleton 'a' "foo" & at 'a' .~ Just "bar"+-- > -- fromList [('a',"bar")]+--+-- > update (SetValue value)+-- >   at 10 ?= value+--+-- @since 1.9.0.0+class At at where+  type family Index at :: Type+  -- ^ Index of the container+  type family IxValue at :: Type+  -- ^ Indexed value of the container+  at :: Index at -> Lens at (Maybe (IxValue at))+----------------------------------------------------------------------------+instance Ord k => At (Map k v) where+  type Index (Map k v) = k+  type IxValue (Map k v) = v+  at key = lens (M.lookup key) $ \m value ->+    case value of+      Nothing -> M.delete key m+      Just v -> M.insert key v m+----------------------------------------------------------------------------+instance At (IntMap v) where+  type Index (IntMap v) = Int+  type IxValue (IntMap v) = v+  at key = lens (IM.lookup key) $ \m value ->+    case value of+      Nothing -> IM.delete key m+      Just v -> IM.insert key v m+----------------------------------------------------------------------------+instance Ord k => At (Set k) where+  type Index (Set k) = k+  type IxValue (Set k) = ()+  at key = Lens {..}+    where+      _set = \v m ->+        case v of+          Nothing -> S.delete key m+          Just () -> S.insert key m+      _get m+        | S.member key m = Just ()+        | otherwise = Nothing+----------------------------------------------------------------------------+instance At IntSet where+  type Index IntSet = Int+  type IxValue IntSet = ()+  at key = Lens {..}+    where+      _set = \v m ->+        case v of+          Nothing -> IS.delete key m+          Just () -> IS.insert key m+      _get m+        | IS.member key m = Just ()+        | otherwise = Nothing+----------------------------------------------------------------------------+instance At [a] where+  type Index [a] = Int+  type IxValue [a] = a+  at key = Lens {..}+    where+      _set Nothing m+        | key < 0 = m+        | otherwise = splitAt key m & \(lhs, rhs) -> lhs <> drop 1 rhs+      _set (Just v) m+        | key < 0 = m+        | otherwise = splitAt key m & \(lhs, rhs) ->+            case rhs of+              [] -> lhs+              _ : xs -> lhs <> (v : xs)+      _get = lookup key . zip [0..]+----------------------------------------------------------------------------
+ src/Miso/Lens/Generic.hs view
@@ -0,0 +1,155 @@+-----------------------------------------------------------------------------+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-# LANGUAGE UndecidableSuperClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Lens.Generic+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- 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++-----------------------------------------------------------------------------+import Data.Kind (Constraint, Type)+import GHC.Generics (C1, D1, Generic (..), K1 (..), M1 (..), Meta (..), Rec0, S1, (:*:) (..), (:+:) (..))+import GHC.OverloadedLabels (IsLabel (..))+import GHC.Records (HasField (..))+import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError)+-----------------------------------------------------------------------------+import Miso.Lens (Lens, lens)+-----------------------------------------------------------------------------++class Generic s => HasLens (name :: Symbol) s a | name s -> a where +  getLens :: Lens s a++instance +  (HasField name s a, TotalityCheck name s a (GetFieldType name (Rep s)), GSet name a (Rep s), Generic s) => +  HasLens name s a where+  getLens = lens (getField @name) (\s v -> to . gSet @name v . from $ s)+  {-# INLINE getLens #-}++instance HasLens name s a => IsLabel name (Lens s a)+  where fromLabel = getLens @name++{-# INLINE field #-}+field :: forall name s a. HasLens name s a => Lens s a +field = fromLabel @name++class GSet (name :: Symbol) typ f where+  gSet :: typ -> f x -> f x++instance (GSet name typ a, GSet name typ b) => GSet name typ (a :*: b) where+  gSet v (l :*: r) = gSet @name v l :*: gSet @name v r+  {-# INLINE gSet #-}++instance (GSet name typ a, GSet name typ b) => GSet name typ (a :+: b) where+  gSet v (L1 l) = L1 $ gSet @name v l+  gSet v (R1 r) = R1 $ gSet @name v r+  {-# INLINE gSet #-}++instance (GSet name typ f) => GSet name typ (C1 x f) where+  gSet v (M1 f) = M1 $ gSet @name v f+  {-# INLINE gSet #-}++instance (GSet name typ f) => GSet name typ (D1 x f) where+  gSet v (M1 f) = M1 $ gSet @name v f+  {-# INLINE gSet #-}++instance {-# OVERLAPPING #-} GSet name typ (S1 ('MetaSel ('Just name) b c d) (Rec0 typ)) where+  gSet v (M1 (K1 _)) = M1 (K1 v)++instance {-# OVERLAPPABLE #-} GSet name typ (S1 ('MetaSel ('Just anotherName) b c d) x) where+  gSet _ f = f+  {-# INLINE gSet #-}++type family TotalityCheck (name :: Symbol) r a (res :: Maybe Type) :: Constraint where+  TotalityCheck _ _ _ ('Just _) = ()+  TotalityCheck name r a 'Nothing =+    TypeError+      ( 'ShowType r+          ':<>: 'Text ": "+          ':<>: 'Text name+          ':<>: 'Text " field missing or not in all constructors"+      )++type family GetFieldType (field :: Symbol) f :: Maybe Type where+  GetFieldType field (S1 ('MetaSel ('Just field) _ _ _) (Rec0 t)) ='Just t+  GetFieldType field (l :*: r) = Or (GetFieldType field l) (GetFieldType field r)+  GetFieldType field (l :+: r) = And (GetFieldType field l) (GetFieldType field r)+  GetFieldType field (C1 _ f) = GetFieldType field f+  GetFieldType field (D1 _ f) = GetFieldType field f+  GetFieldType field x = 'Nothing++type family And (l :: Maybe Type) (r :: Maybe Type) :: Maybe Type where+  And ('Just a) ('Just a) = 'Just a+  And l r = 'Nothing++type family Or (l :: Maybe Type) (r :: Maybe Type) :: Maybe Type where+  Or ('Just l) _ = 'Just l+  Or _ r = r
+ src/Miso/Lens/TH.hs view
@@ -0,0 +1,213 @@+-----------------------------------------------------------------------------+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Lens.TH+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- 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+    makeLenses+  , makeClassy+    -- ** Re-exports+  , lens+  , compose+  , this+  , Lens+  ) where+-----------------------------------------------------------------------------+import Data.Char+import Data.Maybe+import Language.Haskell.TH+-----------------------------------------------------------------------------+import Miso.Util (compose)+import Miso.Lens (this, lens, Lens)+-----------------------------------------------------------------------------+-- | Automatically generates Haskell lenses via template-haskell.+--+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+      case con of+        RecC _ fieldNames ->+          pure (processFieldNames fieldNames)+        _ -> pure []+    TyConI (DataD _ _ _ _ cons _) ->+      flip concatMapM cons $ \case+        RecC _ fieldNames -> do+          pure (processFieldNames fieldNames)+        _ -> pure []+    _ -> pure []+  where+    processFieldNames fieldNames = concat+      [ mkFields fieldName (ConT name) fieldType+      | (fieldName, _, fieldType) <- fieldNames+      , listToMaybe (nameBase fieldName) == Just '_'+      ]+    mkFields fieldName conType fieldType =+     let -- dmj: drops '_' prefix+       lensName = mkName (drop 1 (nameBase fieldName))+     in+       [ FunD lensName+         [ Clause [] (NormalB (mkLens fieldName)) []+         ]+       , SigD lensName (mkLensType conType fieldType)+       ]+    concatMapM f xs =+      concat <$> mapM f xs+    mkLensType conType =+      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"+        fieldVar = mkName "field"+-----------------------------------------------------------------------------+-- | Automatically generates classy lenses via template-haskell.+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+      case con of+        RecC _ fieldNames ->+          pure (processFieldNames fieldNames)+        _ -> pure []+    TyConI (DataD _ _ _ _ cons _) ->+      flip concatMapM cons $ \case+        RecC _ fieldNames -> do+          pure (processFieldNames fieldNames)+        _ -> pure []+    _ -> pure []+  where+    instanceName =+      AppT (ConT (mkName ("Has" <> baseName))) (ConT name)+    baseName = nameBase name+    baseNameLower+      | x : xs <- baseName = toLower x : xs+      | otherwise = []+    processFieldNames fieldNames =+        [ InstanceD Nothing [] instanceName+          [ 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 fieldName (VarT (mkName baseNameLower)) fieldType+            | (fieldName, _, fieldType) <- fieldNames+            , listToMaybe (nameBase fieldName) == Just '_'+            ] +++            [ SigD+                (mkName baseNameLower)+                (AppT+                   (AppT+                      (ConT ''Lens)+                      (VarT (mkName baseNameLower)))+                      (ConT name))+            ]+        ]+    mkFields fieldName varType fieldType =+      let -- dmj: drops '_' prefix+        lensName = mkName (drop 1 (nameBase fieldName))+      in+        [ FunD lensName+          [ Clause [] (NormalB (wrapMkLens fieldName)) []+          ]+          -- fooX = lens _fooX (\r x -> r { _fooX = x }) . foo+        , SigD lensName (mkLensType varType fieldType)+          -- fooY :: Lens foo Int+        ]+    concatMapM f xs =+      concat <$> mapM f xs+    mkLensType varType x =+      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"+        fieldVar = mkName "field"+-------------------------------------------------------------------------------
src/Miso/Mathml.hs view
@@ -1,24 +1,37 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Miso.Mathml--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- 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\" ]+--         ]+--     ] -- @ ----- More information on how to use `miso` is available on GitHub------ <http://github.com/dmjio/miso>+-- For a more complete example see+-- [miso-mathml](https://github.com/haskell-miso/miso-mathml). -- ---------------------------------------------------------------------------- module Miso.Mathml-   ( module Miso.Mathml.Element+   ( -- * Elements+     module Miso.Mathml.Element    ) where-+----------------------------------------------------------------------------- import Miso.Mathml.Element+-----------------------------------------------------------------------------
src/Miso/Mathml/Element.hs view
@@ -1,23 +1,288 @@+----------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoImplicitPrelude #-} ----------------------------------------------------------------------------- -- | -- Module      :  Miso.Mathml.Element--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- Stability   :  experimental -- Portability :  non-portable-----------------------------------------------------------------------------+--+-- = Overview+--+-- "Miso.Mathml.Element" provides smart constructors for every element in the+-- <https://developer.mozilla.org/en-US/docs/Web/MathML MathML Core>+-- 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-  ( -- * Construct an Element-      nodeMathml+  ( -- ** Combinator+    nodeMathml+   -- ** Elements+  , math_+  , annotationXml_+  , annotation_+  , merror_+  , mfrac_+  , mi_+  , mmultiscripts_+  , mn_+  , mo_+  , mover_+  , mpadded_+  , mphantom_+  , mprescripts_+  , mroot_+  , mrow_+  , ms_+  , mspace_+  , msqrt_+  , mstyle_+  , msub_+  , msubsup_+  , msup_+  , mtable_+  , mtd_+  , mtext_+  , mtr_+  , munder_+  , munderover_+  , semantics_+  , mfenced_   ) where--import           Miso.Html.Internal-import           Miso.String (MisoString)-import qualified Prelude            as P---- | Used to construct `VNode`'s in `View`-nodeMathml :: MisoString -> [Attribute action] -> [View action] -> View action-nodeMathml = P.flip (node MATHML) P.Nothing+-----------------------------------------------------------------------------+import           Miso.Types+-----------------------------------------------------------------------------+-- | Low-level helper used to construct 'MATHML' 'node' in 'Miso.Types.View'.+-- Most View helpers in this module are defined in terms of it.+nodeMathml :: MisoString -> [Attribute action] -> [View model action] -> View model action+nodeMathml nodeName = node MATHML nodeName+-----------------------------------------------------------------------------+-- | [\<annotation-xml\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/annotation-xml)+--+-- @since 1.9.0.0+annotationXml_ :: [Attribute action] -> [View model action] -> View model action+annotationXml_ = nodeMathml "annotation-xml"+-----------------------------------------------------------------------------+-- | [\<annotation\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/annotation)+--+-- @since 1.9.0.0+annotation_ :: [Attribute action] -> [View model action] -> View model action+annotation_ = nodeMathml "annotation"+-----------------------------------------------------------------------------+-- | [\<math\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/math)+--+-- @since 1.9.0.0+math_ :: [Attribute action] -> [View model action] -> View model action+math_ = nodeMathml "math"+-----------------------------------------------------------------------------+-- | [\<merror\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/merror)+--+-- @since 1.9.0.0+merror_ :: [Attribute action] -> [View model action] -> View model action+merror_ = nodeMathml "merror"+-----------------------------------------------------------------------------+-- | [\<mfrac\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mfrac)+--+-- @since 1.9.0.0+mfrac_ :: [Attribute action] -> [View model action] -> View model action+mfrac_ = nodeMathml "mfrac"+-----------------------------------------------------------------------------+-- | [\<mi\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mi)+--+-- @since 1.9.0.0+mi_ :: [Attribute action] -> [View model action] -> View model action+mi_ = nodeMathml "mi"+-----------------------------------------------------------------------------+-- | [\<mmultiscripts\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mmultiscripts)+--+-- @since 1.9.0.0+mmultiscripts_ :: [Attribute action] -> [View model action] -> View model action+mmultiscripts_ = nodeMathml "mmultiscripts"+-----------------------------------------------------------------------------+-- | [\<mn\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mn)+--+-- @since 1.9.0.0+mn_ :: [Attribute action] -> [View model action] -> View model action+mn_ = nodeMathml "mn"+-----------------------------------------------------------------------------+-- | [\<mo\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mo)+--+-- @since 1.9.0.0+mo_ :: [Attribute action] -> [View model action] -> View model action+mo_ = nodeMathml "mo"+-----------------------------------------------------------------------------+-- | [\<mover\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mover)+--+-- @since 1.9.0.0+mover_ :: [Attribute action] -> [View model action] -> View model action+mover_ = nodeMathml "mover"+-----------------------------------------------------------------------------+-- | [\<mpadded\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mpadded)+--+-- @since 1.9.0.0+mpadded_ :: [Attribute action] -> [View model action] -> View model action+mpadded_ = nodeMathml "mpadded"+-----------------------------------------------------------------------------+-- | [\<mphantom\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mphantom)+--+-- @since 1.9.0.0+mphantom_ :: [Attribute action] -> [View model action] -> View model action+mphantom_ = nodeMathml "mphantom"+-----------------------------------------------------------------------------+-- | [\<mprescripts\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mprescripts)+--+-- @since 1.9.0.0+mprescripts_ :: [Attribute action] -> [View model action] -> View model action+mprescripts_ = nodeMathml "mprescripts"+-----------------------------------------------------------------------------+-- | [\<mroot\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mroot)+--+-- @since 1.9.0.0+mroot_ :: [Attribute action] -> [View model action] -> View model action+mroot_ = nodeMathml "mroot"+-----------------------------------------------------------------------------+-- | [\<mrow\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mrow)+--+-- @since 1.9.0.0+mrow_ :: [Attribute action] -> [View model action] -> View model action+mrow_ = nodeMathml "mrow"+-----------------------------------------------------------------------------+-- | [\<ms\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/ms)+--+-- @since 1.9.0.0+ms_ :: [Attribute action] -> [View model action] -> View model action+ms_ = nodeMathml "ms"+-----------------------------------------------------------------------------+-- | [\<mspace\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mspace)+--+-- @since 1.9.0.0+mspace_ :: [Attribute action] -> [View model action] -> View model action+mspace_ = nodeMathml "mspace"+-----------------------------------------------------------------------------+-- | [\<msqrt\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/msqrt)+--+-- @since 1.9.0.0+msqrt_ :: [Attribute action] -> [View model action] -> View model action+msqrt_ = nodeMathml "msqrt"+-----------------------------------------------------------------------------+-- | [\<mstyle\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mstyle)+--+-- @since 1.9.0.0+mstyle_ :: [Attribute action] -> [View model action] -> View model action+mstyle_ = nodeMathml "mstyle"+-----------------------------------------------------------------------------+-- | [\<msub\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/msub)+--+-- @since 1.9.0.0+msub_ :: [Attribute action] -> [View model action] -> View model action+msub_ = nodeMathml "msub"+-----------------------------------------------------------------------------+-- | [\<msubsup\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/msubsup)+--+-- @since 1.9.0.0+msubsup_ :: [Attribute action] -> [View model action] -> View model action+msubsup_ = nodeMathml "msubsup"+-----------------------------------------------------------------------------+-- | [\<msup\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/msup)+--+-- @since 1.9.0.0+msup_ :: [Attribute action] -> [View model action] -> View model action+msup_ = nodeMathml "msup"+-----------------------------------------------------------------------------+-- | [\<mtable\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mtable)+--+-- @since 1.9.0.0+mtable_ :: [Attribute action] -> [View model action] -> View model action+mtable_ = nodeMathml "mtable"+-----------------------------------------------------------------------------+-- | [\<mtd\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mtd)+--+-- @since 1.9.0.0+mtd_ :: [Attribute action] -> [View model action] -> View model action+mtd_ = nodeMathml "mtd"+-----------------------------------------------------------------------------+-- | [\<mtext\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mtext)+--+-- @since 1.9.0.0+mtext_ :: [Attribute action] -> [View model action] -> View model action+mtext_ = nodeMathml "mtext"+-----------------------------------------------------------------------------+-- | [\<mtr\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mtr)+--+-- @since 1.9.0.0+mtr_ :: [Attribute action] -> [View model action] -> View model action+mtr_ = nodeMathml "mtr"+-----------------------------------------------------------------------------+-- | [\<munder\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/munder)+--+-- @since 1.9.0.0+munder_ :: [Attribute action] -> [View model action] -> View model action+munder_ = nodeMathml "munder"+-----------------------------------------------------------------------------+-- | [\<munderover\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/munderover)+--+-- @since 1.9.0.0+munderover_ :: [Attribute action] -> [View model action] -> View model action+munderover_ = nodeMathml "munderover"+-----------------------------------------------------------------------------+-- | [\<semantics\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/semantics)+--+-- @since 1.9.0.0+semantics_ :: [Attribute action] -> [View model action] -> View model action+semantics_ = nodeMathml "semantics"+-----------------------------------------------------------------------------+-- | [\<semantics\>](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Element/mfenced)+--+-- @since 1.9.0.0+mfenced_ :: [Attribute action] -> [View model action] -> View model action+mfenced_ = nodeMathml "mfenced"+-----------------------------------------------------------------------------
+ src/Miso/Mathml/Property.hs view
@@ -0,0 +1,272 @@+-----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Mathml.Property+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Mathml.Property" provides 'Miso.Types.Attribute' smart constructors+-- for+-- <https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Attribute MathML attributes>.+-- 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+-- <https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Attribute MDN MathML attribute reference>.+--+-- = 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_+  , displaystyle_+  , scriptlevel_+  -- * Regular attributes+  , accent_+  , accentunder_+  , align_+  , columnalign_+  , columnlines_+  , columnspacing_+  , columnspan_+  , depth_+  , display_+  , fence_+  , frame_+  , framespacing_+  , height_+  , href_+  , id_+  , linethickness_+  , lspace_+  , mathbackground_+  , mathcolor_+  , mathsize_+  , mathvariant_+  , maxsize_+  , minsize_+  , movablelimits_+  , notation_+  , rowalign_+  , rowlines_+  , rowspacing_+  , rowspan_+  , rspace_+  , separator_+  , stretchy_+  , symmetric_+  , voffset_+  , width_+  , close_+  , open_+  ) where+-----------------------------------------------------------------------------+import           Miso.Types+import           Miso.Property+-----------------------------------------------------------------------------+-- | [dir](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Global_attributes/dir)+--+-- @since 1.9.0.0+dir_ :: MisoString -> Attribute action+dir_ = textProp "dir"+-----------------------------------------------------------------------------+-- | [displaystyle](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Global_attributes/displaystyle)+--+-- @since 1.9.0.0+displaystyle_ :: MisoString -> Attribute action+displaystyle_ = textProp "displaystyle"+------------------------------------------------------------------------------+-- | [scriptlevel](https://developer.mozilla.org/en-US/docs/Web/MathML/Reference/Global_attributes/scriptlevel)+--+-- @since 1.9.0.0+scriptlevel_ :: Int -> Attribute action+scriptlevel_ = intProp "scriptlevel"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+accent_ ::  Bool -> Attribute action+accent_ = boolProp "accent"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+accentunder_ ::  Bool -> Attribute action+accentunder_ = boolProp "accentunder"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+align_ ::  Bool -> Attribute action+align_ = boolProp "align"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+columnalign_ :: MisoString -> Attribute action+columnalign_ = textProp "columnalign"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+columnlines_ :: MisoString -> Attribute action+columnlines_ = textProp "columnlines"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+columnspacing_ :: MisoString -> Attribute action+columnspacing_ = textProp "columnspacing"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+columnspan_ :: Int -> Attribute action+columnspan_ = intProp "columnspan"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+depth_ :: MisoString -> Attribute action+depth_ = textProp "depth"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+display_ :: MisoString -> Attribute action+display_ = textProp "display"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+fence_ :: Bool -> Attribute action+fence_ = boolProp "fence"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+frame_ :: MisoString -> Attribute action+frame_ = textProp "frame"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+framespacing_ :: MisoString -> Attribute action+framespacing_ = textProp "framespacing"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+height_ :: MisoString -> Attribute action+height_ = textProp "height"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+href_ :: MisoString -> Attribute action+href_ = textProp "href"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+id_ :: MisoString -> Attribute action+id_ = textProp "id"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+linethickness_ :: MisoString -> Attribute action+linethickness_ = textProp "linethickness"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+lspace_ :: MisoString -> Attribute action+lspace_ = textProp "lspace"+-- | @since 1.9.0.0+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+mathbackground_ :: MisoString -> Attribute action+mathbackground_ = textProp "mathbackground"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+mathcolor_ :: MisoString -> Attribute action+mathcolor_ = textProp "mathcolor"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+mathsize_ :: MisoString -> Attribute action+mathsize_ = textProp "mathsize"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+mathvariant_ :: MisoString -> Attribute action+mathvariant_ = textProp "mathvariant"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+maxsize_ :: MisoString -> Attribute action+maxsize_ = textProp "maxsize"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+minsize_ :: MisoString -> Attribute action+minsize_ = textProp "minsize"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+movablelimits_ :: Bool -> Attribute action+movablelimits_ = boolProp "movablelimits"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+notation_ :: MisoString -> Attribute action+notation_ = textProp "notation"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+rowalign_ :: MisoString -> Attribute action+rowalign_ = textProp "rowalign"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+rowlines_ :: MisoString -> Attribute action+rowlines_ = textProp "rowlines"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+rowspacing_ :: MisoString -> Attribute action+rowspacing_ = textProp "rowspacing"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+rowspan_ :: Int -> Attribute action+rowspan_ = intProp "rowspan"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+rspace_ :: MisoString -> Attribute action+rspace_ = textProp "rspace"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+separator_ :: Bool -> Attribute action+separator_ = boolProp "separator"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+stretchy_ :: Bool -> Attribute action+stretchy_ = boolProp "stretchy"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+symmetric_ :: Bool -> Attribute action+symmetric_ = boolProp "symmetric"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+voffset_ :: MisoString -> Attribute action+voffset_ = textProp "voffset"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+width_ :: MisoString -> Attribute action+width_ = textProp "width"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+close_ :: MisoString -> Attribute action+close_ = textProp "close"+-----------------------------------------------------------------------------+-- | @since 1.9.0.0+open_ :: MisoString -> Attribute action+open_ = textProp "open"+-----------------------------------------------------------------------------
+ src/Miso/Media.hs view
@@ -0,0 +1,337 @@+-----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Media+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Media" is a Haskell wrapper around the browser's+-- <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement HTMLMediaElement>+-- API. It covers both @\<audio\>@ and @\<video\>@ 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+-- <https://developer.mozilla.org/en-US/docs/Web/API/HTMLMediaElement HTMLMediaElement>+-- 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        (..)+  , NetworkState (..)+  , ReadyState   (..)+  , Stream+  -- *** Methods+  , canPlayType+  , load+  , play+  , pause+  , srcObject+  -- *** Properties+  , autoplay+  , controls+  , currentSrc+  , currentTime+  , defaultMuted+  , defaultPlaybackRate+  , duration+  , ended+  , loop+  , mediaGroup+  , muted+  , networkState+  , paused+  , playbackRate+  , poster+  , preload+  , readyState+  , seeking+  , videoHeight+  , videoWidth+  , volume+  -- *** Event Map+  , mediaEvents+  ) where+-----------------------------------------------------------------------------+import           Control.Monad+-----------------------------------------------------------------------------+import           Miso.DSL+import           Miso.Event+import           Miso.String+-----------------------------------------------------------------------------+-- | Type that abstracts over [Audio](https://www.w3schools.com/jsref/dom_obj_audio.asp)+-- or [Video](https://www.w3schools.com/jsref/dom_obj_video.asp) media objects.+--+-- You can create them in the View using 'Miso.Html.Element.audio_' or 'Miso.Html.Element.video_'.+-- To get the corresponding t'Media' object from the DOM, you can use+--+-- @+-- media <- t'Media' \<$\> 'Miso.FFI.getElementById' "myVideo"+-- @+newtype Media = Media JSVal+  deriving (ToJSVal, Eq)+-----------------------------------------------------------------------------+-- | Possible values of [networkState](https://www.w3schools.com/tags/av_prop_networkstate.asp) property.+data NetworkState+  = NETWORK_EMPTY+  | NETWORK_IDLE+  | NETWORK_LOADING+  | NETWORK_NO_SOURCE+  deriving (Show, Eq, Enum)+-----------------------------------------------------------------------------+-- | Possible values of [readyState](https://www.w3schools.com/tags/av_prop_readystate.asp) property.+data ReadyState+  = HAVE_NOTHING+  | HAVE_METADATA+  | HAVE_CURRENT_DATA+  | HAVE_FUTURE_DATA+  | HAVE_ENOUGH_DATA+  deriving (Show, Eq, Enum)+-----------------------------------------------------------------------------+-- | The [load](https://www.w3schools.com/tags/av_met_load.asp) method+-- re-loads the audio/video element.+load :: Media -> IO ()+load (Media m) = void $ m # ("load" :: MisoString) $ ()+-----------------------------------------------------------------------------+-- | The [play](https://www.w3schools.com/tags/av_met_play.asp) method starts+-- playing the current audio or video.+play :: Media -> IO ()+play (Media m) = void $ m # ("play" :: MisoString) $ ()+-----------------------------------------------------------------------------+-- | The [pause](https://www.w3schools.com/tags/av_met_pause.asp) method pauses+-- the currently playing audio or video.+pause :: Media -> IO ()+pause (Media a) = void $ a # ("pause" :: MisoString) $ ()+-----------------------------------------------------------------------------+-- | The [canPlayType](https://www.w3schools.com/tags/av_met_canplaytype.asp)+-- method checks if the browser can play the specified audio/video type.+canPlayType :: Media -> IO MisoString+canPlayType (Media m) = do+  fromJSValUnchecked =<< do+    m # ("canPlayType" :: MisoString) $ ()+-----------------------------------------------------------------------------+-- | The [autoplay](https://www.w3schools.com/tags/av_prop_autoplay.asp) property+-- returns whether the audio/video should start playing as soon as it is loaded.+--+-- To set the property, use 'Miso.Html.Property.autoplay_'+-- on the 'Miso.Html.Element.audio_' or 'Miso.Html.Element.video_' element.+autoplay :: Media -> IO Bool+autoplay (Media m) = fromJSValUnchecked =<< m ! ("autoplay" :: MisoString)+-----------------------------------------------------------------------------+-- | The [controls](https://www.w3schools.com/tags/av_prop_controls.asp)+-- property returns whether the browser should display standard audio/video controls.+--+-- To set the property, use 'Miso.Html.Property.controls_'+-- on the 'Miso.Html.Element.audio_' or 'Miso.Html.Element.video_' element.+controls :: Media -> IO Bool+controls (Media m) = fromJSValUnchecked =<< m ! ("controls" :: MisoString)+-----------------------------------------------------------------------------+-- | The [currentSrc](https://www.w3schools.com/tags/av_prop_currentsrc.asp)+-- property returns the URL of the current audio/video.+currentSrc :: Media -> IO MisoString+currentSrc (Media m) = fromJSValUnchecked =<< m ! ("currentSrc" :: MisoString)+-----------------------------------------------------------------------------+-- | The [currentTime](https://www.w3schools.com/tags/av_prop_currenttime.asp)+-- property returns the current position (in seconds) of the audio/video playback.+--+-- To set the current time, use 'Miso.Html.Property.currentTime_'+-- on the 'Miso.Html.Element.audio_' or 'Miso.Html.Element.video_' element.+currentTime :: Media -> IO Double+currentTime (Media m) = fromJSValUnchecked =<< m ! ("currentTime" :: MisoString)+-----------------------------------------------------------------------------+-- | The [defaultMuted](https://www.w3schools.com/tags/av_prop_defaultmuted.asp)+-- property returns whether the audio/video should be muted by default.+--+-- To set the property, use 'Miso.Html.Property.defaultMuted_'+-- on the 'Miso.Html.Element.audio_' or 'Miso.Html.Element.video_' element.+defaultMuted :: Media -> IO Bool+defaultMuted (Media m) = fromJSValUnchecked =<< m ! ("defaultMuted" :: MisoString)+-----------------------------------------------------------------------------+-- | The [defaultPlaybackRate](https://www.w3schools.com/tags/av_prop_defaultplaybackrate.asp)+-- property returns the default playback speed of the audio/video.+--+-- To set the property, use 'Miso.Html.Property.defaultPlaybackRate_'+-- on the 'Miso.Html.Element.audio_' or 'Miso.Html.Element.video_' element.+defaultPlaybackRate :: Media -> IO Double+defaultPlaybackRate (Media m) = fromJSValUnchecked =<< m ! ("defaultPlaybackRate" :: MisoString)+-----------------------------------------------------------------------------+-- | The [duration](https://www.w3schools.com/tags/av_prop_duration.asp) property+-- returns the length of the current audio/video, in seconds.+duration :: Media -> IO Double+duration (Media m) = fromJSValUnchecked =<< m ! ("duration" :: MisoString)+-----------------------------------------------------------------------------+-- | The [ended](https://www.w3schools.com/tags/av_prop_ended.asp) property+-- returns whether the playback of the audio/video has ended.+ended :: Media -> IO Bool+ended (Media m) = fromJSValUnchecked =<< m ! ("ended" :: MisoString)+-----------------------------------------------------------------------------+-- | The [loop](https://www.w3schools.com/tags/av_prop_loop.asp) property+-- returns whether the audio/video should start playing over again when it is finished.+--+-- To set the property, use 'Miso.Html.Property.loop_'+-- on the 'Miso.Html.Element.audio_' or 'Miso.Html.Element.video_' element.+loop :: Media -> IO Bool+loop (Media m) = fromJSValUnchecked =<< m ! ("loop" :: MisoString)+-----------------------------------------------------------------------------+-- | The [mediaGroup](https://www.w3schools.com/tags/av_prop_mediagroup.asp) property+-- returns the name of the media group the audio/video is a part of.+--+-- To set the property, use 'Miso.Html.Property.mediaGroup_'+-- on the 'Miso.Html.Element.audio_' or 'Miso.Html.Element.video_' element.+mediaGroup :: Media -> IO MisoString+mediaGroup (Media m) = fromJSValUnchecked =<< m ! ("mediaGroup" :: MisoString)+-----------------------------------------------------------------------------+-- | The [muted](https://www.w3schools.com/tags/av_prop_muted.asp) property+-- returns whether the audio/video should be muted (sound turned off).+--+-- To set the property, use 'Miso.Html.Property.muted_'+-- on the 'Miso.Html.Element.audio_' or 'Miso.Html.Element.video_' element.+muted :: Media -> IO Bool+muted (Media m) = fromJSValUnchecked =<< m ! ("muted" :: MisoString)+-----------------------------------------------------------------------------+-- | The [networkState](https://www.w3schools.com/tags/av_prop_networkstate.asp)+-- property returns the current network state (activity) of the audio/video.+networkState :: Media -> IO NetworkState+networkState (Media m) = do+  number <- fromJSValUnchecked =<< m ! ("networkState" :: MisoString)+  pure (toEnum number)+-----------------------------------------------------------------------------+-- | The [paused](https://www.w3schools.com/tags/av_prop_paused.asp) property+-- returns whether the audio/video is paused.+paused :: Media -> IO Bool+paused (Media a) = fromJSValUnchecked =<< a ! ("paused" :: MisoString)+-----------------------------------------------------------------------------+-- | The [playbackRate](https://www.w3schools.com/tags/av_prop_playbackRate.asp)+-- property returns the current playback speed of the audio/video.+--+-- To set the playback rate, use 'Miso.Html.Property.playbackRate_'+-- on the 'Miso.Html.Element.audio_' or 'Miso.Html.Element.video_' element.+playbackRate :: Media -> IO Double+playbackRate (Media a) = fromJSValUnchecked =<< a ! ("playbackRate" :: MisoString)+-----------------------------------------------------------------------------+-- | The [poster](https://developer.mozilla.org/en-US/docs/Web/API/HTMLVideoElement/poster) property+-- of the HTMLVideoElement interface is a string that reflects the URL for an image+-- to be shown while no video data is available.+--+-- Specific to videos.+poster :: Media -> IO MisoString+poster (Media a) = fromJSValUnchecked =<< a ! ("poster" :: MisoString)+-----------------------------------------------------------------------------+-- | The [preload](https://www.w3schools.com/tags/av_prop_preload.asp) property+-- returns whether the audio/video should start loading as soon as the page loads.+--+-- To set the preload property, use 'Miso.Html.Property.preload_'+-- on the 'Miso.Html.Element.audio_' or 'Miso.Html.Element.video_' element.+preload :: Media -> IO MisoString+preload (Media a) = fromJSValUnchecked =<< a ! ("preload" :: MisoString)+-----------------------------------------------------------------------------+-- | The [readyState](https://www.w3schools.com/tags/av_prop_readyState.asp) property+-- returns the current ready state of the audio/video.+readyState :: Media -> IO ReadyState+readyState (Media a) = do+  number <- fromJSValUnchecked =<< a ! ("readyState" :: MisoString)+  pure (toEnum number)+-----------------------------------------------------------------------------+-- | The [seeking](https://www.w3schools.com/tags/av_prop_seeking.asp) property+-- returns whether the user is currently seeking in the audio/video.+seeking :: Media -> IO Bool+seeking (Media a) = fromJSValUnchecked =<< a ! ("seeking" :: MisoString)+-----------------------------------------------------------------------------+-- | The HTMLVideoElement interface's read-only+-- [videoHeight](https://developer.mozilla.org/en-US/docs/Web/API/HTMLVideoElement/videoHeight)+-- property indicates the intrinsic height of the video, expressed in CSS pixels.+videoHeight :: Media -> IO Int+videoHeight (Media m) = fromJSValUnchecked =<< m ! ("videoHeight" :: MisoString)+-----------------------------------------------------------------------------+-- | The HTMLVideoElement interface's read-only+-- [videoWidth](https://developer.mozilla.org/en-US/docs/Web/API/HTMLVideoElement/videoWidth)+-- property indicates the intrinsic width of the video, expressed in CSS pixels+videoWidth :: Media -> IO Int+videoWidth (Media m) = fromJSValUnchecked =<< m ! ("videoWidth" :: MisoString)+-----------------------------------------------------------------------------+-- | The [volume](https://www.w3schools.com/tags/av_prop_volume.asp) property+-- returns the current volume of the audio/video.+--+-- To set the volume, use 'Miso.Html.Property.volume_'+-- on the 'Miso.Html.Element.audio_' or 'Miso.Html.Element.video_' element.+volume :: Media -> IO Double+volume (Media m) = fromJSValUnchecked =<< m ! ("volume" :: MisoString)+-----------------------------------------------------------------------------+-- | A media Stream+type Stream = JSVal+-----------------------------------------------------------------------------+-- | Sets the `srcObject` on audio or video elements.+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+-----------------------------------------------------------------------------
+ src/Miso/Navigator.hs view
@@ -0,0 +1,221 @@+-----------------------------------------------------------------------------+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE CPP                 #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Navigator+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Navigator" wraps the browser's+-- <https://developer.mozilla.org/en-US/docs/Web/API/Navigator Navigator>+-- 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+-- <https://developer.mozilla.org/en-US/docs/Web/API/GeolocationPositionError GeolocationPositionError>+-- 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+  , userMedia+  , UserMedia (..)+  , Stream+  -- ** Clipboard+  , copyClipboard+  -- ** OnLine+  , isOnLine+  -- ** Geolocation+  , geolocation+  , Geolocation (..)+  , GeolocationError (..)+  , GeolocationErrorCode (..)+  ) where+-----------------------------------------------------------------------------+import           Control.Monad ((<=<))+import           Prelude hiding ((!!))+-----------------------------------------------------------------------------+import           Miso.DSL+import           Miso.String+import           Miso.Effect+import qualified Miso.FFI.Internal as FFI+----------------------------------------------------------------------------+-- | A media stream+type Stream = JSVal+----------------------------------------------------------------------------+-- | Get access to user's media devices.+--+-- <https://developer.mozilla.org/en-US/docs/Web/API/MediaDevices/getUserMedia>+--+getUserMedia+  :: UserMedia+  -- ^ Options+  -> (Stream -> action)+  -- ^ Successful callback+  -> (JSVal -> action)+  -- ^ Errorful callback+  -> Effect parent props model action+getUserMedia UserMedia {..} successful errorful =+  withSink $ \sink ->+    FFI.getUserMedia audio video+      (sink . successful)+      (sink . errorful)+-----------------------------------------------------------------------------+-- | Get access to the user's clipboard.+--+-- <https://developer.mozilla.org/en-US/docs/Web/API/Navigator/clipboard>+--+copyClipboard+  :: MisoString+  -- ^ Options+  -> action+  -- ^ Successful callback+  -> (JSVal -> action)+  -- ^ Errorful callback+  -> Effect parent props model action+copyClipboard txt successful errorful =+  withSink $ \sink ->+    FFI.copyClipboard txt+      (sink successful)+      (sink . errorful)+-----------------------------------------------------------------------------+-- | Get user's online status+--+-- <https://developer.mozilla.org/en-US/docs/Web/API/Navigator/onLine>+--+isOnLine+  :: (Bool -> action)+  -- ^ Successful callback+  -> Effect parent props model action+isOnLine action = io (action <$> FFI.isOnLine)+-----------------------------------------------------------------------------+-- | Type for dealing with 'navigator.mediaDevices.getUserMedia'+--+-- <https://developer.mozilla.org/en-US/docs/Web/API/Navigator/mediaDevices>+--+data UserMedia+  = UserMedia+  { audio :: Bool+  -- ^ Request access to the user's microphone+  , video :: Bool+  -- ^ Request access to the user's camera+  } deriving (Show, Eq)+-----------------------------------------------------------------------------+-- | Default t'UserMedia'+userMedia :: UserMedia+userMedia = UserMedia True True+-----------------------------------------------------------------------------+-- | Geolocation fetching+--+-- <https://developer.mozilla.org/en-US/docs/Web/API/Navigator/geolocation>+--+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 ->+    FFI.geolocation+      (sink . successful <=< fromJSValUnchecked)+      (sink . errorful <=< fromJSValUnchecked)+-----------------------------------------------------------------------------+-- | Geolocation errors+data GeolocationError = GeolocationError GeolocationErrorCode MisoString+  deriving (Show, Eq)+-----------------------------------------------------------------------------+instance FromJSVal GeolocationError where+  fromJSVal v = do+    code <- fromJSVal =<< (v ! "code")+    msg <- fromJSVal =<< (v ! "message")+    pure (GeolocationError <$> code <*> msg)+-----------------------------------------------------------------------------+-- | Geolocation error code+data GeolocationErrorCode+  = PERMISSION_DENIED+  | POSITION_UNAVAILABLE+  | TIMEOUT+  deriving (Enum, Show, Eq)+-----------------------------------------------------------------------------+instance FromJSVal GeolocationErrorCode where+  fromJSVal code =+    fromJSValUnchecked code >>= \case+      (1 :: Int) -> pure (Just PERMISSION_DENIED)+      2 -> pure (Just POSITION_UNAVAILABLE)+      3 -> pure (Just TIMEOUT)+      _ -> pure Nothing+-----------------------------------------------------------------------------+-- | Geolocation holds latitude, longitude and accuracy, among others.+data Geolocation+  = Geolocation+  { 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+  fromJSVal geo = do+    lat <- fromJSVal =<< geo ! "coords" ! "latitude"+    lon <- fromJSVal =<< geo ! "coords" ! "longitude"+    acc <- fromJSVal =<< geo ! "coords" ! "accuracy"+    pure (Geolocation <$> lat <*> lon <*> acc)+-----------------------------------------------------------------------------
+ src/Miso/Prelude.hs view
@@ -0,0 +1,59 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Prelude+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "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"+-- @+--+-- __Option 2 — Cabal mixin__ (replaces @Prelude@ project-wide, zero+-- per-file boilerplate):+--+-- @+-- executable app+--   main-is:         Main.hs+--   build-depends:   base, miso+--   mixins:+--     miso,+--     miso (Miso.Prelude as Prelude),+--     base hiding (Prelude)+--   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+  , (.)+  ) where+----------------------------------------------------------------------------+import Control.Category ((.))+import Prelude hiding ((.), (!!))+import Miso+----------------------------------------------------------------------------
+ src/Miso/Property.hs view
@@ -0,0 +1,177 @@+-----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Property+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "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+  , classList+  , textProp+  , stringProp+  , boolProp+  , intProp+  , integerProp+  , doubleProp+  , objectProp+  , keyProp+  , key_+  ) where+-----------------------------------------------------------------------------+import           Miso.JSON (ToJSON(..), Object)+-----------------------------------------------------------------------------+import           Miso.Types+-----------------------------------------------------------------------------+-- | @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+  -- ^ 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+  -- ^ DOM property name+  -> Bool+  -- ^ Property value+  -> Attribute action+boolProp = prop+-----------------------------------------------------------------------------+-- | Set field to 'String' value+stringProp+  :: MisoString+  -- ^ DOM property name+  -> String+  -- ^ Property value+  -> Attribute action+stringProp = prop+-----------------------------------------------------------------------------+-- | Set field to 'MisoString' value+textProp+  :: MisoString+  -- ^ DOM property name+  -> MisoString+  -- ^ Property value+  -> Attribute action+textProp = prop+-----------------------------------------------------------------------------+-- | Set field to t'Object' value+objectProp+  :: MisoString+  -- ^ DOM property name+  -> Object+  -- ^ JSON object value+  -> Attribute action+objectProp = prop+-----------------------------------------------------------------------------+-- | Set field to 'Int' value+intProp+  :: MisoString+  -- ^ DOM property name+  -> Int+  -- ^ Property value+  -> Attribute action+intProp = prop+-----------------------------------------------------------------------------+-- | Set field to 'Integer' value+integerProp+  :: MisoString+  -- ^ DOM property name+  -> Integer+  -- ^ Property value+  -> Attribute action+integerProp = prop+-----------------------------------------------------------------------------+-- | Set field to 'Double' value+doubleProp+  :: MisoString+  -- ^ DOM property name+  -> Double+  -- ^ Property value+  -> Attribute action+doubleProp = prop+-----------------------------------------------------------------------------+-- | Set 'Miso.Types.Key' on 'VNode'.+keyProp :: ToKey key => key -> Attribute action+keyProp key = prop "key" (toKey key)+-----------------------------------------------------------------------------+-- | Synonym for 'keyProp'+-- Allows a user to specify a t'Key' inside of an '[Attribute action]'+key_ :: ToKey key => key -> Attribute action+key_ = keyProp+-----------------------------------------------------------------------------+-- | Smart constructor for specifying 'class'+--+-- @since 1.9.0.0+classList :: [MisoString] -> Attribute action+classList = ClassList+-----------------------------------------------------------------------------
+ src/Miso/PubSub.hs view
@@ -0,0 +1,65 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.PubSub+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = 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+  ( -- * Pub\/Sub+    Topic+  , topic+  , subscribe+  , unsubscribe+  , publish+  ) where+----------------------------------------------------------------------------+import Miso.Runtime+----------------------------------------------------------------------------
+ src/Miso/Random.hs view
@@ -0,0 +1,143 @@+-----------------------------------------------------------------------------+{-# LANGUAGE CPP               #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Random+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Random" provides a pseudo-random number generator for miso+-- components and their test infrastructure. It is built on the+-- <https://prng.di.unimi.it/ SplitMix32> 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+    StdGen (..)+  , Seed+    -- ** Functions+  , newStdGen+  , mkStdGen+  , next+  , replicateRM+  , getStdGen+  , setStdGen+    -- ** Globals+  , globalStdGen+  ) where+-----------------------------------------------------------------------------+import           Data.Tuple (swap)+import           Control.Monad.State (state, runState)+import           Control.Monad (replicateM)+import           Data.IORef+import           System.IO.Unsafe (unsafePerformIO)+-----------------------------------------------------------------------------+import           Miso.DSL+import qualified Miso.FFI.Internal as FFI+-----------------------------------------------------------------------------+-- | t'StdGen' holds a JS t'Function'.+newtype StdGen = StdGen Function+-----------------------------------------------------------------------------+-- | An initial 'Seed' value, useful for simulations or reproducing test failures+type Seed = Int+-----------------------------------------------------------------------------+-- | Like 'Miso.Random.newStdGen' but takes a t'Seed' as an argument and is pure.+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'.+newStdGen :: IO StdGen+newStdGen = do+  seed <- FFI.getRandomValue+  StdGen . Function <$> FFI.splitmix32 seed+-----------------------------------------------------------------------------+-- | Get the next t'StdGen', extracting the value, useful with t'State'.+next+  :: StdGen+  -- ^ Current generator state+  -> (Double, StdGen)+next (StdGen func) = unsafePerformIO $ do+  result <- apply func ()+  pure (result, StdGen func)+-----------------------------------------------------------------------------+-- | Global 'StdGen', used by 'replicateRM' and others.+globalStdGen :: IORef StdGen+{-# NOINLINE globalStdGen #-}+globalStdGen = unsafePerformIO $ do+  seed <- floor . (*1e7) <$> FFI.mathRandom+  newIORef (mkStdGen seed)+-----------------------------------------------------------------------------+-- | Read the `globalStdGen`+getStdGen :: IO StdGen+getStdGen = readIORef globalStdGen+-----------------------------------------------------------------------------+-- | Set the `globalStdGen`+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'.+--+-- @+-- replicateRM 10 :: 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)+-----------------------------------------------------------------------------
+ src/Miso/Reload.hs view
@@ -0,0 +1,194 @@+-----------------------------------------------------------------------------+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Reload+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "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@:+--+-- ['reload'] clears @\<head\>@ and @\<body\>@ — full reset on every @:r@; model is lost+-- ['live'] clears @\<body\>@ only — model state survives @:r@+--+-- = reload+--+-- Clears both @\<head\>@ and @\<body\>@, 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' 'Miso.Event.Types.defaultEvents' app+-- @+--+-- = live+--+-- Clears only @\<body\>@, then re-mounts the component using the __old+-- model__ value recovered from the previous GHCi session via a C-heap+-- stable pointer. @\<head\>@ injections (stylesheets, scripts) from the+-- previous session are preserved.+--+-- @+-- main :: IO ()+-- main = 'live' 'Miso.Event.Types.defaultEvents' app+-- @+--+-- __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+--+-- * <https://github.com/haskell-miso/miso-sampler miso-sampler> — 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+    reload+  , live+  ) where+-----------------------------------------------------------------------------+import           Control.Concurrent+import           Control.Monad+-----------------------------------------------------------------------------+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, Hydrate(..))+import           Miso.Runtime.Internal (components, schedulerThread)+-----------------------------------------------------------------------------+import           Miso.Lens+-----------------------------------------------------------------------------+import qualified Data.IntMap.Strict as IM+import           Data.IORef+import           Foreign hiding (void)+import           Foreign.C.Types+-----------------------------------------------------------------------------+foreign import ccall unsafe "miso_x_store"+  x_store :: StablePtr a -> IO ()+-----------------------------------------------------------------------------+foreign import ccall unsafe "miso_x_get"+  x_get :: IO (StablePtr a)+-----------------------------------------------------------------------------+foreign import ccall unsafe "miso_x_exists"+  x_exists :: IO CInt+-----------------------------------------------------------------------------+foreign import ccall unsafe "miso_x_clear"+  x_clear :: IO ()+-----------------------------------------------------------------------------+#define MISO_JS_PATH "js/miso.js"+-----------------------------------------------------------------------------+-- | Clears the \<body\> and \<head\> on each 'reload'.+--+-- Meant to be used with WASM browser mode.+--+-- @+-- main :: IO ()+-- main = 'reload' 'defaultEvents' app+-- @+--+-- N.B. This also resets the internal 'component' state. This means all currently+-- mounted components become unmounted and t'ComponentId' are reset to their+-- original form factory.+--+-- If you'd like to preserve application state between calls to GHCi `:r`, see 'live'.+--+-- @since 1.9.0.0+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+  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+--+-- 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.+--+-- Use 'reload' if you're changing the 'model' frequently and 'live'+-- if you're adjusting the 'view' / 'update' function logic.+--+-- @+-- main :: IO ()+-- main = 'live' 'defaultEvents' app+-- @+--+-- @since 1.9.0.0+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+      -- clearBody (only clear the body)+      clearBody++      -- Deref old state, update new state, set pointer in C heap.+      (oldComponentsRef, oldSchedulerRef) <- deRefStablePtr =<< x_get+      killThread =<< readIORef oldSchedulerRef++      _oldState <- readIORef oldComponentsRef+      let oldModel = (_oldState IM.! topLevelComponentId) ^. componentModel+          initialVComp = vcomp { model = oldModel }++      -- Overwrite new components state with old components state+      atomicWriteIORef components _oldState++      -- 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 True initialVComp++      -- Don't forget to flush (native mobile needs this too)+      FFI.flush++      -- Clear and set static ptr to use new state (new CAF state)+      x_clear+      x_store =<< newStablePtr (components, schedulerThread)+    else do+      -- This means it is initial load, just store the pointer.+      void (initComponent events Draw False vcomp)+      x_store =<< newStablePtr (components, schedulerThread)+-----------------------------------------------------------------------------+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)+-----------------------------------------------------------------------------
src/Miso/Router.hs view
@@ -1,221 +1,629 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveFunctor #-}+----------------------------------------------------------------------------- {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE UndecidableInstances  #-}-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE GADTs                 #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds             #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}-{-# OPTIONS_GHC -fno-warn-orphans  #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE DefaultSignatures          #-}+{-# LANGUAGE TypeApplications           #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE PolyKinds                  #-} -----------------------------------------------------------------------------+{-# OPTIONS_GHC -fno-warn-orphans #-}+----------------------------------------------------------------------------- -- | -- Module      :  Miso.Router--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- Stability   :  experimental -- Portability :  non-portable-----------------------------------------------------------------------------+--+-- = Overview+--+-- "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.+--+-- = Approach 1 — Generic deriving (recommended)+--+-- @+-- {-\# 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'+-- @+--+-- Decoding:+--+-- @+-- 'toRoute' \"\/user\/42\"  -- Right (User (Capture 42))+-- 'toRoute' \"\/search?q=hello\" -- Right (Search (QueryParam (Just \"hello\")))+-- @+--+-- Encoding (type-safe links):+--+-- @+-- 'prettyRoute' (User (Capture 42))       -- \"\/user\/42\"+-- button_ [ 'href_' (User (Capture 42)) ] [ text \"Profile\" ]+-- @+--+-- = Approach 2 — Manual instance+--+-- @+-- data Route = Widget Int deriving (Show, Eq)+--+-- instance 'Router' Route where+--   routeParser = 'routes' [ Widget \<$\> ('path' \"widget\" *\> 'capture') ]+--   fromRoute (Widget n) = [ 'toPath' \"widget\", 'toCapture' n ]+-- @+--+-- = Generic naming rules+--+-- * __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.+--+-- = URL types+--+-- [@'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@+--+-- = Integration with history subscription+--+-- @+-- import "Miso.Subscription.History" ('routerSub')+--+-- subs :: ['Miso.Effect.Sub' Action]+-- subs = [ 'Miso.Subscription.History.routerSub' RouteChanged ]+-- @+--+-- = 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-  ( runRoute-  , route-  , HasRouter-  , RouteT+  ( -- ** Classes+    Router (..)+  , RouteParser+  , GRouter (..)+    -- ** Types+  , Capture (..)+  , Path (..)+  , QueryParam (..)+  , QueryFlag (..)+  , Fragment (..)+  , Token (..)+  , URI (..)+    -- ** Errors   , RoutingError (..)+    -- ** Functions+  , parseURI+  , prettyURI+  , prettyQueryString+    -- ** Manual Routing+  , runRouter+  , routes+    -- ** Construction+  , toQueryParam+  , toCapture+  , toPath+  , emptyURI+    -- ** Parser combinators+  , queryFlag+  , queryParam+  , capture+  , path+  , fragment+    -- ** Lexing+  , lexTokens+  , tokensToURI   ) where--import qualified Data.ByteString.Char8 as BS+-----------------------------------------------------------------------------+import qualified Data.Map.Strict as M+import           Data.Maybe+import           Data.Bifunctor (first)+import           Data.Functor import           Data.Proxy-import           Data.Text             (Text)-import qualified Data.Text             as T-import           Data.Text.Encoding+import qualified Data.Char as C+import           Data.String+import           Control.Applicative+import           Control.Monad+import           GHC.Generics import           GHC.TypeLits-import           Network.HTTP.Types    hiding (Header)-import           Network.URI-import           Servant.API-import           Web.HttpApiData--import           Miso.Html             hiding (text)---- | Router terminator.--- The 'HasRouter' instance for 'View' finalizes the router.------ Example:------ > type MyApi = "books" :> Capture "bookId" Int :> View---- | 'Location' is used to split the path and query of a URI into components.-data Location = Location-  { locPath  :: [Text]-  , locQuery :: Query-  } deriving (Show, Eq, Ord)---- | When routing, the router may fail to match a location.-data RoutingError = Fail-  deriving (Show, Eq, Ord)---- | A 'Router' contains the information necessary to execute a handler.-data Router a where-  RChoice       :: Router a -> Router a -> Router a-  RCapture      :: FromHttpApiData x => (x -> Router a) -> Router a-  RQueryParam   :: (FromHttpApiData x, KnownSymbol sym)-                   => Proxy sym -> (Maybe x -> Router a) -> Router a-  RQueryParams  :: (FromHttpApiData x, KnownSymbol sym)-                   => Proxy sym -> ([x] -> Router a) -> Router a-  RQueryFlag    :: KnownSymbol sym-                   => Proxy sym -> (Bool -> Router a) -> Router a-  RPath         :: KnownSymbol sym => Proxy sym -> Router a -> Router a-  RPage         :: a -> Router a---- | This is similar to the @HasServer@ class from @servant-server@.--- It is the class responsible for making API combinators routable.--- 'RouteT' is used to build up the handler types.--- 'Router' is returned, to be interpretted by 'routeLoc'.-class HasRouter layout where-  -- | A mkRouter handler.-  type RouteT layout a :: *-  -- | Transform a mkRouter handler into a 'Router'.-  mkRouter :: Proxy layout -> Proxy a -> RouteT layout a -> Router a---- | Alternative-instance (HasRouter x, HasRouter y) => HasRouter (x :<|> y) where-  type RouteT (x :<|> y) a = RouteT x a :<|> RouteT y a-  mkRouter _ (a :: Proxy a) ((x :: RouteT x a) :<|> (y :: RouteT y a))-    = RChoice (mkRouter (Proxy :: Proxy x) a x) (mkRouter (Proxy :: Proxy y) a y)---- | Capture-instance (HasRouter sublayout, FromHttpApiData x) =>-  HasRouter (Capture sym x :> sublayout) where-  type RouteT (Capture sym x :> sublayout) a = x -> RouteT sublayout a-  mkRouter _ a f = RCapture (\x -> mkRouter (Proxy :: Proxy sublayout) a (f x))---- | QueryParam-instance (HasRouter sublayout, FromHttpApiData x, KnownSymbol sym)-         => HasRouter (QueryParam sym x :> sublayout) where-  type RouteT (QueryParam sym x :> sublayout) a = Maybe x -> RouteT sublayout a-  mkRouter _ a f = RQueryParam (Proxy :: Proxy sym)-    (\x -> mkRouter (Proxy :: Proxy sublayout) a (f x))---- | QueryParams-instance (HasRouter sublayout, FromHttpApiData x, KnownSymbol sym)-         => HasRouter (QueryParams sym x :> sublayout) where-  type RouteT (QueryParams sym x :> sublayout) a = [x] -> RouteT sublayout a-  mkRouter _ a f = RQueryParams-    (Proxy :: Proxy sym)-    (\x -> mkRouter (Proxy :: Proxy sublayout) a (f x))---- | QueryFlag-instance (HasRouter sublayout, KnownSymbol sym)-         => HasRouter (QueryFlag sym :> sublayout) where-  type RouteT (QueryFlag sym :> sublayout) a = Bool -> RouteT sublayout a-  mkRouter _ a f = RQueryFlag-    (Proxy :: Proxy sym)-    (\x -> mkRouter (Proxy :: Proxy sublayout) a (f x))---- | Header-instance HasRouter sublayout => HasRouter (Header sym (x :: *) :> sublayout) where-    type RouteT (Header sym x :> sublayout) a = Maybe x -> RouteT sublayout a-    mkRouter _ a f = mkRouter (Proxy :: Proxy sublayout) a (f Nothing)---- | Path-instance (HasRouter sublayout, KnownSymbol path)-         => HasRouter (path :> sublayout) where-  type RouteT (path :> sublayout) a = RouteT sublayout a-  mkRouter _ a page = RPath-    (Proxy :: Proxy path)-    (mkRouter (Proxy :: Proxy sublayout) a page)---- | View-instance HasRouter (View a) where-  type RouteT (View a) x = x-  mkRouter _ _ a = RPage a+-----------------------------------------------------------------------------+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)+import qualified Miso.Util.Lexer as L+import           Miso.Util.Lexer (Lexer)+import           Miso.String (ToMisoString, FromMisoString, fromMisoStringEither)+import qualified Miso.String as MS+-----------------------------------------------------------------------------+-- | Type used for representing capture variables+newtype Capture sym a = Capture a+  deriving stock (Eq, Show)+  deriving newtype (ToMisoString, FromMisoString)+-----------------------------------------------------------------------------+-- | Type used for representing URL paths+newtype Path (path :: Symbol) = Path MisoString+  deriving stock (Eq, Show)+  deriving newtype (ToMisoString, IsString)+-----------------------------------------------------------------------------+-- | Type used for representing query flags+newtype QueryFlag (path :: Symbol) = QueryFlag Bool+  deriving stock (Eq, Show)+-----------------------------------------------------------------------------+-- | Type used for representing query parameters+newtype QueryParam (path :: Symbol) a = QueryParam (Maybe a)+  deriving stock (Eq, Show)+-----------------------------------------------------------------------------+-- | Type used for representing fragments+data Fragment (path :: Symbol) = Fragment+  deriving stock (Eq, Show)+-----------------------------------------------------------------------------+instance (KnownSymbol frag) => ToMisoString (Fragment frag) where+  toMisoString Fragment = "#" <> ms (symbolVal (Proxy @frag))+-----------------------------------------------------------------------------+instance (ToMisoString a, KnownSymbol path) => ToMisoString (QueryParam path a) where+  toMisoString (QueryParam maybeVal) =+    maybe mempty (\param -> "?" <> ms param <> "=" <> val) maybeVal+      where+        val = ms $ symbolVal (Proxy @path)+-----------------------------------------------------------------------------+instance (FromMisoString a, KnownSymbol path) => FromMisoString (QueryParam path a) where+  fromMisoStringEither x =+    case fromMisoStringEither @a x of+      Right r -> Right $ QueryParam (Just r)+      Left v -> Left v+-----------------------------------------------------------------------------+instance KnownSymbol name => ToMisoString (QueryFlag name) where+  toMisoString = \case+    QueryFlag True ->+      "?" <> ms (symbolVal (Proxy @name))+    QueryFlag False ->+      mempty+-----------------------------------------------------------------------------+-- | A list of tokens are returned from a successful lex of a t'URI'+data Token+  = QueryParamTokens [(MisoString, Maybe MisoString)]+  | QueryParamToken MisoString (Maybe MisoString)+  | CaptureOrPathToken MisoString+  | FragmentToken MisoString+  | IndexToken+  deriving (Show, Eq)+-----------------------------------------------------------------------------+-- | Smart constructor for building a 'QueryParamToken'+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+toCapture :: ToMisoString string => string -> Token+toCapture = CaptureOrPathToken . ms+-----------------------------------------------------------------------------+-- | Smart constructor for building a path fragment+toPath :: MisoString -> Token+toPath = CaptureOrPathToken+-----------------------------------------------------------------------------+-- | Converts a list of @[Token]@ into an actual @URI@.+tokensToURI :: [Token] -> URI+tokensToURI tokens = URI+  { uriPath =+      case tokens of+        IndexToken : _ -> ""+        _ ->+          MS.intercalate "/"+          [ x+          | CaptureOrPathToken x <- filter isPathRelated tokens+          ]+  , uriQueryString =+      M.unions+        [ case queryToken of+            QueryParamTokens queryParams_ ->+              M.fromList queryParams_+            QueryParamToken k v ->+              M.singleton k v+            _ ->+              mempty+        | queryToken <- filter isQuery tokens+        ]+  , uriFragment =+      foldMap ms (filter isFragment tokens)+  } where+      isFragment = \case+        FragmentToken{} -> True+        _ -> False+      isQuery = \case+        QueryParamToken{} -> True+        _ -> False+      isPathRelated = \case+        CaptureOrPathToken {} -> True+        IndexToken {} -> True+        _ -> False+-----------------------------------------------------------------------------+instance ToMisoString Token where+  toMisoString = \case+    CaptureOrPathToken x -> "/" <> x+    FragmentToken x -> "#" <> x+    QueryParamTokens params ->+      "?" <> MS.intercalate "&"+        [ case value of+            Nothing -> key+            Just v -> key <> "=" <> v+        | (key, value) <- params+        ]+    QueryParamToken k (Just v) ->+      "?" <> k <> "=" <> v+    QueryParamToken k Nothing ->+      "?" <> k+    IndexToken -> "/"+-----------------------------------------------------------------------------+-- | An error that can occur during lexing / parsing of a URI into a user-defined+-- data type+data RoutingError+  = ParseError MisoString [Token]+  | AmbiguousParse MisoString [Token]+  | LexError MisoString MisoString+  | LexErrorEOF MisoString+  | NoParses MisoString+  deriving (Show, Eq)+-----------------------------------------------------------------------------+-- | State monad for parsing URI+type RouteParser = ParserT URI [Token] []+-----------------------------------------------------------------------------+-- | Combinator for parsing a capture variable out of a URI+capture :: FromMisoString value => RouteParser value+capture = do+  CaptureOrPathToken capture_ <- captureOrPathToken+  case fromMisoStringEither capture_ of+    Left msg -> fail (fromMisoString (ms msg))+    Right token -> pure token+-----------------------------------------------------------------------------+-- | Combinator for parsing a path out of a URI+path :: MisoString -> RouteParser MisoString+path specified = do+  CaptureOrPathToken parsed <- captureOrPathToken+  when (specified /= parsed) (fail "path")+  pure specified+-----------------------------------------------------------------------------+index :: MisoString -> RouteParser MisoString+index specified = do+  IndexToken <- indexToken+  when (specified /= "index") (fail "index")+  pure "/"+-----------------------------------------------------------------------------+fragment :: MisoString -> RouteParser MisoString+fragment specified = do+  FragmentToken frag <- indexToken+  when (specified /= frag) (fail "fragment")+  pure frag+-----------------------------------------------------------------------------+-- | URI parsing+parseURI :: MisoString -> Either MisoString URI+parseURI txt =+  case lexTokens txt of+    Left (L.LexerError err _) -> Left err+    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]+  default fromRoute :: (Generic route, GRouter (Rep route)) => route -> [Token]+  fromRoute = gFromRoute . from --- | Verb-instance HasRouter (Verb m s c a) where-  type RouteT (Verb m s c a) x = x-  mkRouter _ _ a = RPage a+  -- | Convert a 'Router route => route' into a t'URI'+  toURI :: route -> URI+  toURI = tokensToURI . fromRoute --- | Raw-instance HasRouter Raw where-  type RouteT Raw x = x-  mkRouter _ _ a = RPage a+  -- | Map a URI back to a route+  route :: URI -> Either RoutingError route+  route = toRoute . prettyURI --- | Use a handler to mkRouter a 'Location'.--- Normally 'route' should be used instead, unless you want custom--- handling of string failing to parse as 'URI'.-runRouteLoc :: forall layout a. HasRouter layout-            => Location -> Proxy layout -> RouteT layout a ->  Either RoutingError a-runRouteLoc loc layout page =-  let routing = mkRouter layout (Proxy :: Proxy a) page-  in routeLoc loc routing+  -- | Convenience for specifying a URL as a hyperlink reference in 'Miso.Types.View'+  href_ :: route -> Attribute action+  href_ = P.href_ . prettyRoute --- | Use a handler to mkRouter a location, represented as a 'String'.--- All handlers must, in the end, return @m a@.--- 'routeLoc' will choose a mkRouter and return its result.-route-  :: HasRouter layout-  => Proxy layout-  -> RouteT layout a-  -> URI-  -> Either RoutingError a-route layout handler u = runRouteLoc (uriToLocation u) layout handler+  -- | Route pretty printing+  prettyRoute :: route -> MisoString+  prettyRoute = prettyURI . tokensToURI . fromRoute -runRoute-  :: HasRouter layout-  => Proxy layout-  -> RouteT layout (m -> a)-  -> (m -> URI)-  -> m-  -> Either RoutingError a-runRoute layout pages getURI model = ($ model) <$> route layout pages (getURI model)+  -- | Route debugging+  dumpURI :: route -> MisoString+  dumpURI = ms . show . tokensToURI . fromRoute --- | Use a computed 'Router' to mkRouter a 'Location'.-routeLoc :: Location -> Router a -> Either RoutingError a-routeLoc loc r = case r of-  RChoice a b -> do-    case routeLoc loc a of-      Left Fail -> routeLoc loc b-      Right x -> Right x-  RCapture f -> case locPath loc of-    [] -> Left Fail-    capture:paths ->-      case parseUrlPieceMaybe capture of-        Nothing -> Left Fail-        Just x -> routeLoc loc { locPath = paths } (f x)-  RQueryParam sym f -> case lookup (BS.pack $ symbolVal sym) (locQuery loc) of-    Nothing -> routeLoc loc (f Nothing)-    Just Nothing -> Left Fail-    Just (Just text) -> case parseQueryParamMaybe (decodeUtf8 text) of-      Nothing -> Left Fail-      Just x -> routeLoc loc (f (Just x))-  RQueryParams sym f -> maybe (Left Fail) (\x -> routeLoc loc (f x)) $ do-    ps <- sequence $ snd <$> Prelude.filter-      (\(k, _) -> k == BS.pack (symbolVal sym)) (locQuery loc)-    sequence $ (parseQueryParamMaybe . decodeUtf8) <$> ps-  RQueryFlag sym f -> case lookup (BS.pack $ symbolVal sym) (locQuery loc) of-    Nothing -> routeLoc loc (f False)-    Just Nothing -> routeLoc loc (f True)-    Just (Just _) -> Left Fail-  RPath sym a -> case locPath loc of-    [] -> Left Fail-    p:paths -> if p == T.pack (symbolVal sym)-      then routeLoc (loc { locPath = paths }) a-      else Left Fail-  RPage a ->-    case locPath loc of-      [] -> Right a-      [""] -> Right a-      _ -> Left Fail+  -- | Route parsing from a 'MisoString'+  toRoute :: MisoString -> Either RoutingError route+  toRoute input = parseRoute input routeParser --- | Convert a 'URI' to a 'Location'.-uriToLocation :: URI -> Location-uriToLocation uri = Location-  { locPath = decodePathSegments $ BS.pack (uriPath uri)-  , locQuery = parseQuery $ BS.pack (uriQuery uri)-  }+  routeParser :: RouteParser route+  default routeParser :: (Generic route, GRouter (Rep route)) => RouteParser route+  routeParser = to <$> gRouteParser+-----------------------------------------------------------------------------+-- | Smart constructor for building a @RouteParser@+--+-- @+--+-- data Route = Widget MisoString Int+--+-- instance Router Route where+--   routeParser = routes [ Widget \<$\> path "widget" \<*\> capture ]+--   fromRoute (Widget path value) = [ toPath path, toCapture value ]+--+-- router :: Router router => RouteParser router+-- router = routes [ Widget \<$\> path "widget" \<*\> capture ]+--+-- > Right (Widget "widget" 10)+-- @+--+-----------------------------------------------------------------------------+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+routes :: [ RouteParser route ] -> RouteParser route+routes = foldr (<|>) empty+-----------------------------------------------------------------------------+-- | Generic deriving for 'Router'+class GRouter f where+  gFromRoute :: f route -> [Token]+  gRouteParser :: RouteParser (f route)+-----------------------------------------------------------------------------+instance GRouter next => GRouter (D1 m next) where+  gFromRoute (M1 x) = gFromRoute x+  gRouteParser = M1 <$> gRouteParser+-----------------------------------------------------------------------------+instance (KnownSymbol name, GRouter next) => GRouter (C1 ('MetaCons name x y) next) where+  gFromRoute (M1 x) =+    case name of+      "index" -> [IndexToken]+      _ -> CaptureOrPathToken name : gFromRoute x+      where+        name = lowercaseStrip $ symbolVal (Proxy @name)+  gRouteParser = do+    case name of+      "index" -> do+        void (index name)+        M1 <$> gRouteParser+      _ -> do+        void (path name)+        M1 <$> gRouteParser+      where+        name = lowercaseStrip $ symbolVal (Proxy @name)+-----------------------------------------------------------------------------+instance GRouter next => GRouter (S1 m next) where+  gFromRoute (M1 x) = gFromRoute x+  gRouteParser = M1 <$> gRouteParser+-----------------------------------------------------------------------------+instance {-# OVERLAPS #-} forall path m . KnownSymbol path => GRouter (K1 m (Path path)) where+  gFromRoute (K1 x) = pure $ CaptureOrPathToken (ms x)+  gRouteParser = K1 (Path chunk) <$ path chunk+    where+      chunk = ms $ symbolVal (Proxy :: Proxy path)+-----------------------------------------------------------------------------+instance {-# OVERLAPS #-} (FromMisoString a, ToMisoString a) => GRouter (K1 m (Capture sym a)) where+  gFromRoute (K1 x) = pure $ CaptureOrPathToken (ms x)+  gRouteParser = K1 <$> capture+-----------------------------------------------------------------------------+instance {-# OVERLAPS #-} KnownSymbol frag => GRouter (K1 m (Fragment frag)) where+  gFromRoute (K1 x) = pure $ FragmentToken (ms x)+  gRouteParser = K1 Fragment <$ fragment frag+    where+      frag = ms (symbolVal (Proxy :: Proxy frag))+-----------------------------------------------------------------------------+instance {-# OVERLAPS #-} forall param m a . (ToMisoString a, FromMisoString a, KnownSymbol param) =>+  GRouter (K1 m (QueryParam param a)) where+    gFromRoute (K1 (QueryParam maybeParam)) = do+      let key = ms (symbolVal (Proxy @param))+      case maybeParam of+        Nothing -> [QueryParamToken key Nothing]+        Just v -> [QueryParamToken key (Just (ms v))]+    gRouteParser = K1 <$> queryParam+-----------------------------------------------------------------------------+-- | Query parameter parser from a route+queryParam+  :: forall param a . (FromMisoString a, KnownSymbol param)+  => RouteParser (QueryParam param a)+queryParam = do+  URI {..} <- askParser+  QueryParam <$> do+    case M.lookup (ms (symbolVal (Proxy @param))) uriQueryString of+      Just (Just value) ->+        case fromMisoStringEither value of+          Left _ -> pure Nothing+          Right parsed -> pure (Just parsed)+      _ -> pure Nothing+-----------------------------------------------------------------------------+instance {-# OVERLAPS #-} forall flag m . KnownSymbol flag => GRouter (K1 m (QueryFlag flag)) where+  gFromRoute (K1 (QueryFlag specified))+    | specified = [ QueryParamToken flag Nothing ]+    | otherwise = []+        where+          flag = ms (symbolVal (Proxy @flag))+  gRouteParser = K1 <$> queryFlag+-----------------------------------------------------------------------------+-- | Query flag parser from a route+queryFlag :: forall flag . KnownSymbol flag => RouteParser (QueryFlag flag)+queryFlag = do+  URI {..} <- askParser+  pure $ QueryFlag $ isJust (M.lookup flag uriQueryString)+    where+      flag = ms $ symbolVal (Proxy @flag)+-----------------------------------------------------------------------------+instance Router a => GRouter (K1 m a) where+  gFromRoute (K1 x) = fromRoute x+  gRouteParser = K1 <$> routeParser+-----------------------------------------------------------------------------+instance GRouter U1 where+  gFromRoute U1 = []+  gRouteParser = pure U1+-----------------------------------------------------------------------------+instance (GRouter left, GRouter right) => GRouter (left :*: right) where+  gFromRoute (left :*: right) = gFromRoute left <> gFromRoute right+  gRouteParser = liftA2 (:*:) gRouteParser gRouteParser+-----------------------------------------------------------------------------+instance (GRouter left, GRouter right) => GRouter (left :+: right) where+  gFromRoute = \case+    L1 m1 -> gFromRoute m1+    R1 m1 -> gFromRoute m1+  gRouteParser = foldr (<|>) empty+    [ L1 <$> gRouteParser+    , R1 <$> gRouteParser+    ]+-----------------------------------------------------------------------------+captureOrPathToken :: RouteParser Token+captureOrPathToken = satisfy $ \case+  CaptureOrPathToken {} -> True+  _ -> False+-----------------------------------------------------------------------------+indexToken :: RouteParser Token+indexToken = satisfy $ \case+  IndexToken {} -> True+  _ -> False+-----------------------------------------------------------------------------+-- | Lexing for a URI+uriLexer :: Lexer [Token]+uriLexer = do+  tokens <- some lexer+  void $ optional (L.char '/')+  pure (postProcess tokens)+    where+      postProcess :: [Token] -> [Token]+      postProcess = concatMap $ \case+        QueryParamTokens queryParams_ ->+          [ QueryParamToken k v+          | (k,v) <- queryParams_+          ]+        x -> pure x+      lexer = msum+        [ captureOrPathLexer+        , queryParamLexer+        , fragmentLexer+        , indexLexer+        ] where+            indexLexer =+              IndexToken <$ L.char '/'+            captureOrPathLexer = do+              void (L.char '/')+              CaptureOrPathToken <$> chars+            fragmentLexer = do+              void (L.char '#')+              FragmentToken <$> query+            queryParamLexer = QueryParamTokens <$> do+              void (L.char '?')+              sepBy (L.char '&') $ do+                key <- query+                maybeValue <-+                  optional $ do+                    void (L.char '=')+                    query+                pure (key, maybeValue)+-----------------------------------------------------------------------------+chars :: Lexer MisoString+chars = MS.concat <$> some pchar+-----------------------------------------------------------------------------+pchar :: Lexer MisoString+pchar = unreserved <|> pctEncoded <|> subDelims <|> L.string ":" <|> L.string "@"+-----------------------------------------------------------------------------+query :: Lexer MisoString+query = foldr (<|>) empty+  [ MS.concat <$> some pchar+  ]+-----------------------------------------------------------------------------+subDelims :: Lexer MisoString+subDelims = fmap ms <$> L.satisfy $ \x -> x `elem` ("!$'()*+,;" :: String)+-----------------------------------------------------------------------------+unreserved :: Lexer MisoString+unreserved = ms <$> do+  L.satisfy $ \x -> or+    [ C.isAlphaNum x+    , x == '-'+    , x == '.'+    , x == '_'+    , x == '~'+    ]+-----------------------------------------------------------------------------+pctEncoded :: Lexer MisoString+pctEncoded = do+  pct <- L.char '%'+  d1 <- hexDig+  d2 <- hexDig+  pure (ms pct <> ms d1 <> ms d2)+-----------------------------------------------------------------------------+hexDig :: Lexer Char+hexDig = L.satisfy C.isHexDigit+-----------------------------------------------------------------------------+lexTokens :: MisoString -> Either L.LexerError [Token]+lexTokens input =+  case L.runLexer uriLexer (L.mkStream input) of+    Right (tokens, _) -> Right tokens+    Left x -> Left x+-----------------------------------------------------------------------------+parseRoute :: MisoString -> RouteParser a -> Either RoutingError a+parseRoute input parser =+  case L.runLexer uriLexer (L.mkStream input) of+    Left (L.LexerError lexErrorMessage _) ->+      Left (LexError input lexErrorMessage)+    Left (L.UnexpectedEOF _) ->+      Left (LexErrorEOF input)+    Right (tokens, _) -> do+      let+        uri = tokensToURI tokens+        isCapturePathOrIndex = \case+          CaptureOrPathToken{} -> True+          IndexToken{} -> True+          _ -> False+      case runParserT parser uri (filter isCapturePathOrIndex tokens) of+        [(x, [])]  ->+          Right x+        [(_, leftovers)]  ->+          Left $ ParseError input leftovers+        []  ->+          Left $ NoParses input+        (_, leftovers) : _  ->+          Left $ AmbiguousParse input leftovers+-----------------------------------------------------------------------------+lowercaseStrip :: String -> MisoString+lowercaseStrip (x:xs) = ms (C.toLower x : takeWhile C.isLower xs)+lowercaseStrip x = ms x+-----------------------------------------------------------------------------
+ src/Miso/Runtime.hs view
@@ -0,0 +1,2059 @@+-----------------------------------------------------------------------------+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE KindSignatures             #-}+{-# LANGUAGE BlockArguments             #-}+{-# LANGUAGE TemplateHaskell            #-}+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -fno-warn-orphans       #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Runtime+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+-----------------------------------------------------------------------------+module Miso.Runtime+  ( -- * Internal functions+    initialize+  , freshComponentId+  , buildVTree+  , renderStyles+  , renderScripts+  , Hydrate(..)+  -- * Subscription+  , startSub+  , stopSub+  -- * Pub / Sub+  , subscribe+  , unsubscribe+  , publish+  , Topic (..)+  , topic+  -- * Component+  , ComponentState (..)+  -- ** Communication+  , mail+  , checkMail+  , broadcast+  , parent+  , mailParent+  , mailChildren+  , mailAncestors+  , mailDescendants+  -- ** WebSocket+  , websocketConnect+  , websocketConnectJSON+  , websocketConnectText+  , websocketConnectArrayBuffer+  , websocketConnectBLOB+  , websocketSend+  , websocketClose+  , socketState+  , emptyWebSocket+  , WebSocket (..)+  , URL+  , SocketState (..)+  , CloseCode (..)+  , Closed (..)+  -- ** EventSource+  , eventSourceConnectText+  , eventSourceConnectJSON+  , eventSourceClose+  , emptyEventSource+  , EventSource (..)+  -- ** Payload+  , Payload (..)+  , json+  , blob+  , arrayBuffer+  -- ** Internal Component state+  , components+  , schedulerThread+  , componentIds+  , rootComponentId+  , componentId+  , modifyComponent+  , componentModel+  -- ** Scheduler+  , scheduler+#ifdef WASM+  , evalFile+#endif+  , topLevelComponentId+  , initComponent+  , withJS+  ) where+-----------------------------------------------------------------------------+import qualified Data.IntSet as IS+import           Data.IntSet (IntSet)+import           Control.Category ((.))+import           Control.Concurrent+import           Control.Exception (SomeException, catch, evaluate)+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(..), Value, encode, fromJSON, jsonStringify, toJSON)++import           Data.Foldable (foldl')+import           Data.Maybe+import           Data.Map.Strict (Map)+import qualified Data.Map.Strict as M+import           Data.IntMap.Strict (IntMap)+import qualified Data.IntMap.Strict as IM+import           Data.IORef (IORef, newIORef, atomicModifyIORef', readIORef, atomicWriteIORef)+import qualified Data.Sequence as S+import           Data.Sequence (Seq)+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+import           Unsafe.Coerce (unsafeCoerce)+-----------------------------------------------------------------------------+import           Miso.Binding (Precedence(..))+import           Miso.Concurrent (Waiter(..), waiter)+import           Miso.CSS (renderStyleSheet)+import           Miso.Delegate (delegator)+import qualified Miso.Diff as Diff+import           Miso.DSL+#ifdef WASM+import           Miso.DSL.TH.File (evalFile)+#endif+import           Miso.Effect+  ( ComponentInfo(..), Sub, Sink, Effect, Schedule(..), runEffect+  , io_, withSink, Synchronicity(..)+  )+import qualified Miso.FFI.Internal as FFI+import           Miso.FFI.Internal (Blob(..), ArrayBuffer(..))+import qualified Miso.Hydrate as Hydrate+import           Miso.Lens hiding (view)+import           Miso.String (ToMisoString(..))+import           Miso.Types+import           Miso.Util+-----------------------------------------------------------------------------+-- | Helper function to abstract out initialization of t'Miso.Types.Component' between top-level API functions.+initialize+  :: (Eq parent, Eq model, Eq props)+  => Events+  -> ComponentId+  -> Hydrate+  -> Bool+  -- ^ 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 maybeKey comp@Component {..} getComponentMountPoint = do+  _componentId <- freshComponentId+  let+    _componentProps = initialProps+    _componentSink = \action -> do+      atomicModifyIORef' globalQueue (\q -> (enqueue _componentId action q, ()))+      notify globalWaiter++  initializedModel <-+    case (hydrate, hydrateModel) of+      (Hydrate, Just m) -> m+      (Draw, _) -> do+        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 <-+    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+  let _componentIsDirty = False+  _componentVTree <- newIORef (VTree (Object jsNull))+  _componentSubThreads <- newIORef M.empty++  frame <- newEmptyMVar :: IO (MVar Double)+  let _componentMailbox = S.empty++  rAFCallback <-+    asyncCallback1 $ \jsval -> do+      putMVar frame =<< fromJSValUnchecked jsval++  let _componentDraw = \newModel -> do+        currentProps <- (^. componentProps) . (IM.! _componentId) <$> readIORef components+        newVTree <-+          buildVTree events _componentParentId _componentId Draw+            _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+        atomicWriteIORef _componentVTree newVTree+        FFI.flush++  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)+                    | modelCheck m n =+                        let cs = vcomps IM.! _componentId+                        in propagate _componentId+                          (IM.insert _componentId (cs { _componentModel = n }) vcomps)+                    | otherwise = (vcomps, mempty)+              in (newComps, n, ss <> sss, dirtySet <> newDirty)+          ) (comps, model_, [], mempty) actions++  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 ()+        , ..+        }++  when isRoot (delegator _componentDOMRef _componentVTree events (logLevel `elem` [DebugEvents, DebugAll]))+  registerComponent vcomponent++  -- Inherit bindings state (if applicable)+  _componentModel <- inheritParentBindings _componentParentId initializedModel bindings+  modifyComponent _componentId (componentModel .= _componentModel)++  initSubs subs _componentSubThreads _componentSink+  initialDraw _componentModel events hydrate isRoot comp vcomponent+  forM_ mount _componentSink+  FFI.mountComponent _componentId =<< toObject jsNull+  pure vcomponent+-----------------------------------------------------------------------------+inheritParentBindings+  :: ComponentId+  -- ^ ParentId+  -> child+  -- ^ Child model+  -> [ Binding parent child ]+  -> IO child+inheritParentBindings compParentId childModel bindings = do+  inheritChildBindings compParentId childModel bindings+  foldM (\m -> \case+            ParentToChild getParentField setChildField -> do+              ComponentState {..} <- (IM.! compParentId) <$> readIORef components+              pure (setChildField (getParentField _componentModel) m)+            Bidirectional Parent getParentField _ _ setChildField -> do+              ComponentState {..} <- (IM.! compParentId) <$> readIORef components+              pure (setChildField (getParentField _componentModel) m)+            _ -> pure m+        ) childModel bindings+-----------------------------------------------------------------------------+inheritChildBindings+  :: ComponentId+  -- ^ ParentId+  -> child+  -- ^ Child component+  -> [ Binding parent child ]+  -> IO ()+inheritChildBindings compParentId childState bindings = do+  forM_ bindings $ \case+     ChildToParent setParentField getChildField -> do+       modifyComponent compParentId $ do+         componentModel %= setParentField (getChildField childState)+         isDirty .= True+     Bidirectional Child _ setParentField getChildField _ -> do+       modifyComponent compParentId $ do+         componentModel %= setParentField (getChildField childState)+         isDirty .= True+     _ -> do+       pure ()+-----------------------------------------------------------------------------+initSubs :: [Sub action] -> IORef (Map MisoString ThreadId) -> Sink action -> IO ()+initSubs subs_ _componentSubThreads _componentSink = do+  forM_ subs_ $ \sub_ -> do+    threadId <- forkIO (sub_ _componentSink)+    subKey <- freshSubId+    atomicModifyIORef' _componentSubThreads $ \m ->+      (M.insert subKey threadId m, ())+-----------------------------------------------------------------------------+-- | Diffs two models, returning True if a redraw is necessary+modelCheck :: Eq model => model -> model -> Bool+modelCheck c n = unsafePerformIO $ do+  currentName <- c `seq` makeStableName c+  updatedName <- n `seq` makeStableName n+  pure (currentName /= updatedName && c /= n)+-----------------------------------------------------------------------------+-- | Checks if the Component is mounted before executing actions+isMounted :: ComponentId -> IO Bool+isMounted vcompId = isJust . IM.lookup vcompId <$> readIORef components+-----------------------------------------------------------------------------+-- | The scheduler processes all events in the system and is responsible+-- for propagating changes across model states both asynchronously+-- and synchronously (via 'Binding'). It also is responsible for+-- top-down rendering of the UI Component tree.+scheduler :: IO ()+scheduler =+  forever $ do+    getBatch >>= \case+      Nothing -> wait globalWaiter+      Just (vcompId, S.Empty)+        | vcompId < 0 -> do+            -- props propagation, negated 'ComponentId' indicates render-phase only.+            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)+  where+    -----------------------------------------------------------------------------+    -- | Execute the commit phase against the model, perform top-down render+    -- of the entire Component tree.+    run :: ComponentId -> Seq action -> IO ()+    run vcompId = renderComponents <=< commit vcompId+    -----------------------------------------------------------------------------+    -- | Apply the actions across the model, evaluate async and sync IO.+    commit :: ComponentId -> Seq action -> IO ComponentIds+    commit vcompId events = do+      (updatedModel, schedules, dirtySet, ComponentState{..}) <- do+        atomicModifyIORef' components $ \vcomps -> do+          let cs@ComponentState {..} = vcomps IM.! vcompId+          case _componentApplyActions events _componentModel vcomps _componentProps of+            (x, updatedModel, schedules, dirtySet) ->+              (x, (updatedModel, schedules, dirtySet, cs))+      forM_ schedules $ \case+        Schedule Async action ->+          evalScheduled Async (action _componentSink)+        Schedule Sync action ->+          evalScheduled Sync (action _componentSink)+      if _componentModelDirty _componentModel updatedModel+        then do+          modifyComponent _componentId $ do+            isDirty .= True+            componentModel .= updatedModel+          pure dirtySet+        else+          pure mempty+-----------------------------------------------------------------------------+-- | Perform a top-down rendering of the 'Component' tree.+--+-- We lookup the components each time to account for unmounting.+-- Reset the dirty bit if a render occurs+--+renderComponents :: ComponentIds -> IO ()+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'.+--+-- Auxiliary function+modifyComponent+  :: ComponentId+  -> State (ComponentState parent props model action) a+  -> IO ()+modifyComponent vcompId go =+  atomicModifyIORef' components $ \vcomps ->+    (IM.adjust (execState go) vcompId vcomps, ())+----------------------------------------------------------------------------+propagate+  :: ComponentId+  -> IntMap (ComponentState p props m a)+  -> (IntMap (ComponentState p props m a), ComponentIds)+propagate vcompId vcomps =+  let dfsState = execState synch (dfs vcomps vcompId)+  in (_state dfsState, _visited dfsState)+-----------------------------------------------------------------------------+-- | Create an empty DFS state+dfs :: IntMap (ComponentState p props m a) -> ComponentId -> DFS p props m a+dfs cs vcompId = DFS cs mempty (pure vcompId)+-----------------------------------------------------------------------------+type ComponentIds = IntSet+-----------------------------------------------------------------------------+data DFS p props m a+  = DFS+  { _state :: IntMap (ComponentState p props m a)+    -- ^ global component state to alter+  , _visited :: ComponentIds+    -- ^ visited set+  , _stack :: [ComponentId]+    -- ^ neighbors queue+  }+-----------------------------------------------------------------------------+type Synch p props m a x = State (DFS p props m a) x+-----------------------------------------------------------------------------+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))+state = lens _state $ \r x -> r { _state = x }+-----------------------------------------------------------------------------+stack :: Lens (DFS p props m a) [ComponentId]+stack = lens _stack $ \r x -> r { _stack = x }+-----------------------------------------------------------------------------+synch :: Synch p props m a ()+synch = mapM_ go =<< pop+  where+    go :: ComponentState p props m a -> Synch p props m a ()+    go cs = do+      seen <- IS.member (cs ^. componentId) <$> use visited+      unless seen $ do+        propagateParent cs (cs ^. parentId)+        propagateChildren cs (cs ^. children)+        markVisited (cs ^. componentId)+        synch+-----------------------------------------------------------------------------+propagateChildren+  :: forall p props m a+   . ComponentState p props m a+  -> ComponentIds+  -> Synch p props m a ()+propagateChildren currentState childComponents = do+  forM_ (IS.toList childComponents) $ \childId -> do+    childState <- unsafeCoerce (IM.! childId) <$> use state+    updatedChild <- unsafeCoerce <$>+      foldM process childState (childState ^. componentBindings)+    let isChildDirty =+          (_componentModelDirty childState)+          (_componentModel childState)+          (_componentModel updatedChild)+    when isChildDirty $ do+      state.at childId ?= updatedChild { _componentIsDirty = True }+      visit childId+    where+      process+        :: ComponentState m props child a+        -> Binding m child+        -> Synch p props m a (ComponentState m props child a)+      process childState = \case+        ParentToChild getCurrentField setChildField -> do+          let currentChildModel = childState ^. componentModel+              currentFieldValue = getCurrentField (currentState ^. componentModel)+              updatedChildModel = setChildField currentFieldValue currentChildModel+          pure (childState & componentModel .~ updatedChildModel)+        Bidirectional _ getCurrentField _ _ setChildField -> do+          let currentChildModel = _componentModel childState+              currentFieldValue = getCurrentField (currentState ^. componentModel)+              updatedChildModel = setChildField currentFieldValue currentChildModel+          pure (childState & componentModel .~ updatedChildModel)+        _ ->+          pure childState+-----------------------------------------------------------------------------+propagateParent+  :: forall p props m a+   . ComponentState p props m a+  -> ComponentId+  -> Synch p props m a ()+propagateParent currentState parentId_ =+  IM.lookup parentId_ <$> use state >>= mapM_ \case+    parentState -> do+      updatedParent <- unsafeCoerce <$>+        foldM process (unsafeCoerce parentState) (currentState ^. componentBindings)+      let isParentDirty =+            (_componentModelDirty parentState)+            (_componentModel parentState)+            (_componentModel updatedParent)+      when isParentDirty $ do+        state.at parentId_ ?= updatedParent { _componentIsDirty = True }+        visit parentId_+  where+    process+      :: ComponentState x props p a+      -> Binding p m+      -> Synch p props m a (ComponentState x props p a)+    process parentState = \case+      ChildToParent setParentField getCurrentField -> do+        let currentParentModel = parentState ^. componentModel+            currentFieldValue = getCurrentField (currentState ^. componentModel)+            updatedParentModel = setParentField currentFieldValue currentParentModel+        pure (parentState & componentModel .~ updatedParentModel)+      Bidirectional _ _ setParentField getCurrentField _ -> do+        let currentParentModel = parentState ^. componentModel+            currentFieldValue = getCurrentField (currentState ^. componentModel)+            updatedParentModel = setParentField currentFieldValue currentParentModel+        pure (parentState & componentModel .~ updatedParentModel)+      _ ->+        pure parentState+-----------------------------------------------------------------------------+markVisited :: ComponentId -> Synch p props m a ()+markVisited vcompId = visited.at vcompId ?= ()+-----------------------------------------------------------------------------+visit :: ComponentId -> Synch p props m a ()+visit vcompId = stack %= (vcompId:)+-----------------------------------------------------------------------------+pop :: Synch p props m a (Maybe (ComponentState p props m a))+pop = use stack >>= \case+  [] ->+    pure Nothing+  x : xs -> do+    stack .= xs+    use (state . at x)+-----------------------------------------------------------------------------+initialDraw+  :: (Eq m, Eq props)+  => m+  -> Events+  -> Hydrate+  -> Bool+  -> Component p props m a+  -> ComponentState p props m a+  -> IO ()+initialDraw initializedModel events hydrate isRoot Component {..} ComponentState {..} = do+#ifdef BENCH+  start <- FFI.now+#endif+  vtree <- buildVTree events _componentParentId _componentId hydrate _componentSink logLevel+    (view _componentProps initializedModel)+#ifdef BENCH+  end <- FFI.now+  when isRoot $ FFI.consoleLog $ ms (printf "buildVTree: %.3f ms" (end - start) :: String)+#endif+  case hydrate of+    Draw -> do+      Diff.diff Nothing (Just vtree) _componentDOMRef+      atomicWriteIORef _componentVTree vtree+    Hydrate -> do+      if isRoot+        then do+          hydrated <- Hydrate.hydrate logLevel _componentDOMRef vtree+          if hydrated+            then do+              atomicWriteIORef _componentVTree vtree+            else do+              newTree <-+                buildVTree events _componentParentId _componentId Draw+                  _componentSink logLevel (view _componentProps initializedModel)+              Diff.diff Nothing (Just newTree) _componentDOMRef+              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, Seq action))+getBatch = do+  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 (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+data Queue action+  = Queue+  { _queue :: IntMap (Seq action)+  , _queueSchedule :: Seq ComponentId+  } deriving (Show, Eq)+-----------------------------------------------------------------------------+emptyQueue :: Queue action+emptyQueue = mempty+-----------------------------------------------------------------------------+instance Semigroup (Queue action) where+  Queue q1 s1 <> Queue q2 s2 = Queue (q1 <> q2) (s1 <> s2)+-----------------------------------------------------------------------------+instance Monoid (Queue action) where+  mempty = Queue mempty mempty+-----------------------------------------------------------------------------+queue :: Lens (Queue action) (IntMap (Seq action))+queue = lens _queue $ \r f -> r { _queue = f }+-----------------------------------------------------------------------------+queueSchedule :: Lens (Queue action) (Seq ComponentId)+queueSchedule = lens _queueSchedule $ \r f -> r { _queueSchedule = f }+-----------------------------------------------------------------------------+enqueue :: ComponentId -> action -> Queue action -> Queue action+enqueue vcompId action q =+  q & queue %~ IM.insertWith (flip (<>)) vcompId (S.singleton action)+    & queueSchedule %~ (S.|> vcompId)+-----------------------------------------------------------------------------+-- | Used to fast track to render phase, bypassing commit phase. Used in 'props'+-- feature.+enqueueSchedule :: ComponentId -> IO ()+enqueueSchedule vcompId =+  atomicModifyIORef' globalQueue $ \q ->+     (q & queueSchedule %~ (S.|> negate vcompId), ())+-----------------------------------------------------------------------------+-- | Case on queue schedule, get first item, span on the rest of queueSchedule, get length.+-- set schedule with whatever remains.+--+-- Take the length of the queue schedule found, looking up with vcompId (from first element)+-- in the queue, splitAt the queue.+--+dequeue+  :: forall action+   . Queue action+  -> Maybe (ComponentId, Seq action, Queue action)+dequeue q =+  case q ^. queueSchedule of+    S.Empty -> Nothing+    sched@(vcompId S.:<| _) ->+      case q ^. queue . at vcompId of+        Nothing ->+          let (_, remaining) = S.spanl (== vcompId) sched+          in Just (vcompId, S.empty, q & queueSchedule .~ remaining)+        Just actions ->+          case S.spanl (==vcompId) sched of+            (scheduled, remaining) ->+              case S.splitAt (length scheduled) actions of+                (process, rest) -> do+                  let updated =+                        q & queueSchedule .~ remaining+                          & queue.at vcompId .~ do if null rest then Nothing else Just rest+                  Just (vcompId, process, updated)+-----------------------------------------------------------------------------+-- | Dequeues everything from the Queue at a specific t'ComponentId', draining+-- both the queue events and the queue schedule.+dequeueAt+  :: forall action+   . ComponentId+  -> Queue action+  -> (Queue action, Seq action)+dequeueAt vcompId q =+  case q ^. queue . at vcompId of+    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, actions)+-----------------------------------------------------------------------------+globalWaiter :: Waiter+{-# NOINLINE globalWaiter #-}+globalWaiter = unsafePerformIO waiter+-----------------------------------------------------------------------------+globalQueue :: IORef (Queue action)+{-# NOINLINE globalQueue #-}+globalQueue = unsafePerformIO (newIORef emptyQueue)+-----------------------------------------------------------------------------+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 _componentChildren $ \record field -> record { _componentChildren = field }+-----------------------------------------------------------------------------+componentTopics :: Lens (ComponentState parent props model action) (Map MisoString (Value -> IO ()))+componentTopics = lens _componentTopics $ \record field -> record { _componentTopics = field }+-----------------------------------------------------------------------------+isDirty :: Lens (ComponentState parent props model action) Bool+isDirty = lens _componentIsDirty $ \record field -> record { _componentIsDirty = field }+-----------------------------------------------------------------------------+componentModel :: Lens (ComponentState parent props model action) model+componentModel = lens _componentModel $ \record field -> record { _componentModel = field }+-----------------------------------------------------------------------------+componentBindings :: Lens (ComponentState p props m a) [Binding p m]+componentBindings = lens _componentBindings $ \record field -> record { _componentBindings = field }+-----------------------------------------------------------------------------+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+  = Draw+  | Hydrate+  deriving (Show, Eq)+-----------------------------------------------------------------------------+-- | t'Miso.Types.Component' state, data associated with the lifetime of a t'Miso.Types.Component'+data ComponentState parent props model action+  = 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+  -- ^ The DOM reference the t'Miso.Types.Component' is mounted on+  , _componentVTree :: IORef VTree+  -- ^ A reference to the current virtual DOM (i.e. t'VTree')+  , _componentSink :: action -> IO ()+  -- ^ t'Miso.Types.Component' t'Sink' used to enter events into the system+  , _componentModel :: model+  -- ^ t'Miso.Types.Component' state+  , _componentIsDirty :: Bool+  -- ^ Indicator if t'Miso.Types.Component' needs to be drawn+  , _componentScripts :: [DOMRef]+  -- ^ DOM references for \<script\> and \<style\> appended to \<head\>+  , _componentEvents :: Events+  -- ^ List of events a t'Miso.Types.Component' listens on+  , _componentBindings :: [Binding parent model]+  -- ^ Declarative bindings between t'Miso.Types.Component' 'model'.+  , _componentMailbox :: Value -> Maybe action+  -- ^ 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+      :: Seq action+      -> model+      -> IntMap (ComponentState parent props model action)+      -> props+      -> (IntMap (ComponentState parent props model action), model, [Schedule action], ComponentIds)+  -- ^ t'Miso.Types.Component' actions application+  , _componentTopics :: Map MisoString (Value -> IO ())+  -- ^ t'Miso.Types.Component' topics using for Pub Sub async communication.+  , _componentChildren :: ComponentIds+  -- ^ 'IntSet' of children t'Miso.Types.ComponentId'+  }+-----------------------------------------------------------------------------+-- | A @Topic@ represents a place to send and receive messages. @Topic@ is used to facilitate+-- communication between t'Miso.Types.Component'. t'Miso.Types.Component' can 'subscribe' to or 'publish' to any @Topic@,+-- within the same t'Miso.Types.Component' or across t'Miso.Types.Component'.+--+-- This requires creating a custom 'ToJSON' / 'FromJSON'. Any other t'Miso.Types.Component'+-- can 'publish' or 'subscribe' to this @Topic message@. It is a way to provide+-- loosely-coupled communication between @Components@.+--+-- See 'publish', 'subscribe', 'unsubscribe' for more details.+--+-- When distributing t'Miso.Types.Component' for third-party use, it is recommended to export+-- the @Topic@, where message is the JSON protocol.+--+--+-- @since 1.9.0.0+newtype Topic a = Topic MisoString+  deriving (Ord, Eq, Show, ToMisoString)+-----------------------------------------------------------------------------+-- | Smart constructor for creating a @Topic message@ to write to+--+-- @+--+-- data Message+--   = Increment+--   | Decrement+--   deriving (Show, Eq, Generic, ToJSON, FromJSON)+--+-- arithmetic :: Topic Message+-- arithmetic = topic "arithmetic"+--+-- data Action+--   = Notification (Result Message)+--   | Subscribe+--   | Unsubscribe+--+-- update_ :: Action -> Effect parent props Int Action+-- update_ = \case+--   Unsubscribe ->+--     unsubscribe arithmetic+--   Subscribe ->+--     subscribe arithmetic Notification+--   Notification (Success Increment) ->+--     update_ AddOne+--   Notification (Success Decrement) ->+--     update_ SubtractOne+--   Notification (Error msg) ->+--     io_ $ consoleError ("Decode failure: " <> ms msg)+--+-- @+--+-- @since 1.9.0.0+topic :: MisoString -> Topic a+topic = Topic+-----------------------------------------------------------------------------+-- | Subscribes a t'Miso.Types.Component' to a t'Topic'.+--+-- 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"+--+-- 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+subscribe+  :: FromJSON message+  => Topic message+  -> (message -> action)+  -> (MisoString -> action)+  -> Effect parent props model action+subscribe (Topic topicName) successful errorful = do+  ComponentInfo {..} <- ask+  withSink $ \sink ->+    modifyComponent _componentInfoId $ do+      componentTopics %= do+        M.insert topicName $ \value ->+          sink (case fromJSON value of+                  Success s -> successful s+                  Error e -> errorful e)+-----------------------------------------------------------------------------+-- | Unsubscribes a t'Miso.Types.Component' from a 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 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+-----------------------------------------------------------------------------+-- | Publish to a t'Topic message'+--+-- t'Topic message' are generated dynamically if they do not exist. When using 'publish'+-- all subscribers are immediately notified of a new message. A message is distributed as a 'Value'+-- The underlying 'ToJSON' instance is used to construct this 'Value'.+--+-- We recommend documenting a public API for the JSON protocol message when distributing a t'Miso.Types.Component'+-- downstream to end users for consumption (be it inside a single cabal project or across multiple+-- cabal projects).+--+-- @+--+-- arithmetic :: Topic Message+-- arithmetic = topic "arithmetic"+--+-- server :: Component parent props () Action+-- server = component () update_ $ \() ->+--   div_+--   []+--   [ "Server component"+--   , button_ [ onClick AddOne ] [ "+" ]+--   , button_ [ onClick SubtractOne ] [ "-" ]+--   , component_ (client_ "client 1")+--   , component_ (client_ "client 2")+--   ] where+--       update_ :: Action -> Effect parent props () Action+--       update_ = \case+--         AddOne ->+--           publish arithmetic Increment+--         SubtractOne ->+--           publish arithemtic Decrement+--+-- @+--+-- @since 1.9.0.0+publish+  :: ToJSON message+  => Topic message+  -> message+  -> IO ()+publish (Topic topicName) message = mapM_ go . IM.elems =<< readIORef components+  where+    go ComponentState {..} =+      case M.lookup topicName _componentTopics of+        Nothing ->+          pure ()+        Just f ->+          f (toJSON message)+-----------------------------------------------------------------------------+subIds :: IORef Int+{-# NOINLINE subIds #-}+subIds = unsafePerformIO $ newIORef 0+-----------------------------------------------------------------------------+freshSubId :: IO MisoString+freshSubId = do+  x <- atomicModifyIORef' subIds $ \y -> (y + 1, y)+  pure ("miso-sub-id-" <> ms x)+-----------------------------------------------------------------------------+-- | This is used to demarcate the ROOT of a page. This ID will *never*+-- exist in the `components` map.+rootComponentId :: ComponentId+rootComponentId = 0+-----------------------------------------------------------------------------+-- | This is the top-level ComponentId, hardcoded+topLevelComponentId :: ComponentId+topLevelComponentId = 1+-----------------------------------------------------------------------------+-- | The global store of 'ComponentId', for internal-use only.+--+-- Used internally @freshComponentId@ to allocate new 'ComponentId' on+-- mount.+--+componentIds :: IORef Int+{-# NOINLINE componentIds #-}+componentIds = unsafePerformIO $ newIORef topLevelComponentId+-----------------------------------------------------------------------------+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 <https://try.haskell-miso.org>+--+-- * 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+-- mounted t'Miso.Types.Component's+components :: IORef (IntMap (ComponentState parent props model action))+{-# NOINLINE components #-}+components = unsafePerformIO (newIORef mempty)+-----------------------------------------------------------------------------+-- | This function evaluates effects according to 'Synchronicity'.+evalScheduled :: Synchronicity -> IO () -> IO ()+evalScheduled Sync x = x `catch` (void . exception)+evalScheduled Async x = void (forkIO (x `catch` (void . exception)))+-----------------------------------------------------------------------------+exception :: SomeException -> IO ()+exception ex = FFI.consoleError ("[EXCEPTION]: " <> ms ex)+-----------------------------------------------------------------------------+-- | Drains the event queue before unmounting, executed synchronously.+drain+  :: ComponentState parent props model action+  -> IO ()+drain ComponentState {..} = do+  drainQueueAt _componentId >>= \case+    S.Empty -> pure ()+    actions -> do+       vcomps <- readIORef components+       case _componentApplyActions actions _componentModel vcomps _componentProps of+         (newVComps, _, schedules, _) -> do+           forM_ schedules $ \case+             -- dmj: process all actions synchronously during unmount+             Schedule _ action ->+               action _componentSink+                 `catch` (\(e :: SomeException) -> void (evaluate e))+             -- dmj: Don't recurse on drain, we only fire-off the last set+             -- of events for 'onBeforeUnmounted' hooks. The queue will+             -- ignore the rest of these.+           atomicWriteIORef components newVComps+-----------------------------------------------------------------------------+-- | Post unmount call to drop the <style> and <script> in <head>+unloadScripts :: ComponentState parent props model action -> IO ()+unloadScripts ComponentState {..} = do+  head_ <- FFI.getHead+  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) <- readIORef _componentVTree+  mapM_ freeFunction =<< fromJSVal =<< comp ! ("mount" :: MisoString)+  mapM_ freeFunction =<< fromJSVal =<< comp ! ("unmount" :: MisoString)+-----------------------------------------------------------------------------+-- | Helper function for cleanly destroying a t'Miso.Types.Component'+unmountComponent+  :: ComponentState parent props model action+  -> IO ()+unmountComponent cs@ComponentState {..} = do+  mapM_ killThread =<< readIORef _componentSubThreads+  drain cs+  finalizeWebSockets _componentId+  finalizeEventSources _componentId+  unloadScripts cs+  freeLifecycleHooks cs+  modifyComponent _componentParentId $ do+    children.at _componentId .= Nothing+  atomicModifyIORef' components $ \m -> (IM.delete _componentId m, ())+  FFI.unmountComponent _componentId+-----------------------------------------------------------------------------+-- | Internal function for construction of a Virtual DOM.+--+-- Component mounting should be synchronous.+-- Mounting causes a recursive diffing to occur+-- (creating sub components as detected), setting up+-- infrastructure for each sub-component. During this+-- process we go between the Haskell heap and the JS heap.+buildVTree+  :: Eq model+  => Events+  -> ComponentId+  -> ComponentId+  -> Hydrate+  -> Sink action+  -> LogLevel+  -> View model action+  -> IO VTree+buildVTree events_ parentId_ vcompId hydrate snk logLevel_ = \case+  VComp maybeKey (SomeComponent newProps app) -> do+    vcomp_ <- create++    mountCallback <- do+      syncCallback1' $ \parent_ -> do+        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)+        obj <- create+        setProp "componentId" _componentId obj+        setProp "componentTree" vtree obj+        toJSVal obj++    unmountCallback <- toJSVal =<< do+      FFI.syncCallback1 $ \vcompId_ -> do+        componentId_ <- fromJSValUnchecked vcompId_+        IM.lookup componentId_ <$> readIORef components >>= \case+          Nothing -> pure ()+          Just componentState -> do+            forM_ (unmount app) (_componentSink componentState)+            unmountComponent componentState++    -- When props are present, install a diffProps callback.+    -- Comparison happens in Haskell against _componentLastProps — no round-trip.+    -- TypeScript calls diffProps() unconditionally; Haskell decides whether to dispatch.+    diffPropsCallback <- toJSVal =<< do+      syncCallback $ do+        componentId_ <- fromJSValUnchecked =<< vcomp_ ! ("componentId" :: MisoString)+        currentProps <- _componentProps . (IM.! componentId_) <$> readIORef components+        when (currentProps /= newProps) $ do+          modifyComponent componentId_ $ do+            componentProps .= newProps+            prevComponentProps .= currentProps+          enqueueSchedule componentId_++    FFI.set "diffProps" diffPropsCallback vcomp_+    FFI.set "child" jsNull vcomp_+    forM_ maybeKey (\key -> FFI.set "key" key vcomp_)+    FFI.set "mount" mountCallback vcomp_+    FFI.set "unmount" unmountCallback vcomp_+    FFI.set "eventPropagation" (eventPropagation app) vcomp_+    FFI.set "type" VCompType vcomp_+    pure (VTree vcomp_)+  VNode ns tag attrs kids -> do+    vnode_ <- createNode "vnode" ns tag+    setAttrs vnode_ attrs snk logLevel_ events_+    vchildren <- toJSVal =<< procreate vnode_+    FFI.set "children" vchildren vnode_+    flip (FFI.set "type") vnode_ =<< toJSVal VNodeType+    pure (VTree vnode_)+      where+        procreate parentVTree = do+          kidsViews <- foldM (buildKid parentVTree) [] kids+          let ordered = reverse kidsViews+          setNextSibling ordered+          pure ordered+            where+              setNextSibling xs =+                zipWithM_ (flip setField "nextSibling")+                  xs (drop 1 xs)+              buildKid _ acc (VFrag _ []) = pure acc+              buildKid p acc kid = do+                VTree child <- buildVTree events_ parentId_ vcompId hydrate snk logLevel_ kid+                FFI.set "parent" p child+                pure (child : acc)+  VText key t -> do+    vtree <- create+    flip (FFI.set "type") vtree =<< toJSVal VTextType+    forM_ key $ \k -> FFI.set "key" (ms k) vtree+    FFI.set "ns" ("text" :: MisoString) vtree+    FFI.set "text" t vtree+    pure (VTree vtree)+  VFrag maybeKey kids -> do+    frag <- create+    FFI.set "type" VFragType frag+    forM_ maybeKey $ \(Key k) -> FFI.set "key" k frag+    vchildren <- toJSVal =<< procreateFragChildren frag+    FFI.set "children" vchildren frag+    pure (VTree frag)+      where+        procreateFragChildren parentVTree = do+          kidsViews <- foldM buildKid [] kids+          let ordered = reverse kidsViews+          zipWithM_ (flip setField "nextSibling") ordered (drop 1 ordered)+          pure ordered+            where+              buildKid acc (VFrag _ []) = pure acc+              buildKid acc kid = do+                VTree child <- buildVTree events_ parentId_ vcompId hydrate snk logLevel_ kid+                FFI.set "parent" parentVTree child+                pure (child : acc)+-----------------------------------------------------------------------------+-- | @createNode@+-- A helper function for constructing a vtree (used for @vcomp@ and @vnode@)+-- Doesn't handle children+createNode :: MisoString -> Namespace -> MisoString -> IO Object+createNode typ ns tag = do+  vnode_ <- create+  cssObj <- create+  propsObj <- create+  eventsObj <- create+  captures <- create+  bubbles <- create+  FFI.set "css" cssObj vnode_+  FFI.set "type" typ vnode_+  FFI.set "props" propsObj vnode_+  FFI.set "events" eventsObj vnode_+  FFI.set "captures" captures eventsObj+  FFI.set "bubbles" bubbles eventsObj+  FFI.set "ns" ns vnode_+  FFI.set "tag" tag vnode_+  pure vnode_+-----------------------------------------------------------------------------+-- | Helper function for populating "props" and "css" fields on a virtual+-- DOM node+setAttrs+  :: Object+  -> [Attribute action]+  -> Sink action+  -> LogLevel+  -> Events+  -> IO ()+setAttrs vnode_@(Object jval) attrs snk logLevel events =+  forM_ attrs $ \case+    Property "key" v -> do+      value <- toJSVal v+      FFI.set "key" value vnode_+    ClassList classes ->+      FFI.populateClass jval classes+    Property k v -> do+      value <- toJSVal v+      o <- getProp "props" vnode_+      FFI.set k value (Object o)+    On callback ->+      callback snk (VTree vnode_) logLevel events+    Styles styles -> do+      cssObj <- getProp "css" vnode_+      forM_ (M.toList styles) $ \(k,v) -> do+        FFI.set k v (Object cssObj)+-----------------------------------------------------------------------------+-- | Registers components in the global state+registerComponent :: MonadIO m => ComponentState parent props model action -> m ()+registerComponent componentState = liftIO $+  atomicModifyIORef' components $ \vcomps' ->+    (IM.insert (_componentId componentState) componentState vcomps', ())+-----------------------------------------------------------------------------+-- | Renders styles+--+-- Meant for development purposes+-- Appends CSS to <head>+--+renderStyles :: [CSS] -> IO [DOMRef]+renderStyles styles =+  forM styles $ \case+    Href url cacheBust -> FFI.addStyleSheet url cacheBust+    Style css -> FFI.addStyle css+    Sheet sheet -> FFI.addStyle (renderStyleSheet sheet)+-----------------------------------------------------------------------------+-- | Renders scripts+--+-- Meant for development purposes+-- Appends JS to <head>+--+renderScripts :: [JS] -> IO [DOMRef]+renderScripts scripts =+  forM scripts $ \case+    Src src cacheBust ->+      FFI.addSrc src cacheBust+    Script script ->+      FFI.addScript False script+    Module src ->+      FFI.addScript True src+    ImportMap importMap -> do+      o <- create+      imports <- create+      forM_ importMap $ \(k,v) ->+        FFI.set k v imports+      FFI.set "imports" imports o+      FFI.addScriptImportMap+        =<< jsonStringify+        =<< toJSVal o+-----------------------------------------------------------------------------+-- | Starts a named 'Sub' dynamically, during the life of a t'Miso.Types.Component'.+-- The 'Sub' can be stopped by calling @Ord subKey => stop subKey@ from the 'update' function.+-- All 'Sub' started will be stopped if a t'Miso.Types.Component' is unmounted.+--+-- @+-- data SubType = LoggerSub | TimerSub+--   deriving (Eq, Ord)+--+-- update Action =+--   startSub LoggerSub $ \\sink -> forever (threadDelay (secs 1) >> consoleLog "test")+-- @+--+-- @since 1.9.0.0+startSub+  :: ToMisoString subKey+  => subKey+  -- ^ The key used to track the 'Sub'+  -> Sub action+  -- ^ The 'Sub'+  -> Effect parent props model action+startSub subKey sub = do+  ComponentInfo {..} <- ask+  io_ $ do+    IM.lookup _componentInfoId <$> liftIO (readIORef components) >>= \case+      Nothing -> pure ()+      Just compState@ComponentState {..} -> do+        mtid <- liftIO (M.lookup (ms subKey) <$> readIORef _componentSubThreads)+        case mtid of+          Nothing ->+            startThread compState+          Just tid -> do+            status <- threadStatus tid+            case status of+              ThreadFinished -> startThread compState+              ThreadDied -> startThread compState+              _ -> pure ()+  where+    startThread ComponentState {..} = do+      tid <- forkIO (sub _componentSink)+      atomicModifyIORef' _componentSubThreads $ \m ->+        (M.insert (ms subKey) tid m, ())+-----------------------------------------------------------------------------+-- | Stops a named 'Sub' dynamically, during the life of a t'Miso.Types.Component'.+-- All 'Sub' started will be stopped automatically if a t'Miso.Types.Component' is unmounted.+--+-- @+-- data SubType = LoggerSub | TimerSub+--   deriving (Eq, Ord)+--+-- update Action = do+--   stopSub LoggerSub+-- @+--+-- @since 1.9.0.0+stopSub+  :: ToMisoString subKey+  => subKey+  -- ^ The key used to stop the 'Sub'+  -> Effect parent props model action+stopSub subKey = do+  vcompId <- asks _componentInfoId+  io_ $ do+    IM.lookup vcompId <$> readIORef components >>= \case+      Nothing -> do+        pure ()+      Just ComponentState {..} -> do+        mtid <- liftIO (M.lookup (ms subKey) <$> readIORef _componentSubThreads)+        forM_ mtid $ \tid ->+          liftIO $ do+            atomicModifyIORef' _componentSubThreads $ \m -> (M.delete (ms subKey) m, ())+            killThread tid+-----------------------------------------------------------------------------+-- | Send any @ToJSON message => message@ to a t'Miso.Types.Component' mailbox, by 'ComponentId'+--+-- @+-- io_ $ mail componentId ("test message" :: MisoString) :: Effect parent props model action+-- @+--+-- @since 1.9.0.0+mail+  :: ToJSON message+  => ComponentId+  -- ^ 'ComponentId' to receive 'mail'+  -> message+  -- ^ The message to send+  -> IO ()+mail vcompId msg =+  IM.lookup vcompId <$> readIORef components >>= \case+    Nothing -> pure ()+    Just ComponentState{..} ->+      case _componentMailbox (toJSON msg) of+        Nothing -> pure ()+        Just action ->+          _componentSink action+-----------------------------------------------------------------------------+-- | Send any @ToJSON message => message@ to the parent's t'Miso.Types.Component' mailbox+--+-- @+-- mailParent ("test message" :: MisoString) :: Effect parent props model action+-- @+--+-- @since 1.9.0.0+mailParent+  :: ToJSON message+  => message+  -- ^ Message to send+  -> Effect parent props model action+mailParent msg = do+  ComponentInfo {..} <- ask+  io_ (mail _componentInfoParentId msg)+-----------------------------------------------------------------------------+-- | Send any @ToJSON message => message@ to all ancestor t'Miso.Types.Component' 'mailbox'.+--+-- This function walks the t'Miso.Types.Component' ancestor hierarchy, delivering mail+-- along the way.+--+-- @+-- mailAncestors ("test message" :: MisoString) :: Effect parent props model action+-- @+--+-- @since 1.11.0.0+mailAncestors+  :: ToJSON message+  => message+  -- ^ Message to send+  -> Effect parent props model action+mailAncestors msg = do+  ComponentInfo {..} <- ask+  io_ (climb _componentInfoParentId)+    where+      climb vcompId = do+        mail vcompId msg+        IM.lookup vcompId <$> readIORef components >>= \case+          Nothing -> pure ()+          Just cs -> climb (_componentParentId cs)+-----------------------------------------------------------------------------+-- | Send any @ToJSON message => message@ to the children's t'Miso.Types.Component' mailbox+--+-- N.B. this is only relevant for immediate descendants (not all descendants).+--+-- @+-- mailChildren ("test message" :: MisoString) :: Effect parent props model action+-- @+--+-- @since 1.9.0.0+mailChildren+  :: ToJSON message+  => message+  -- ^ Message to send+  -> Effect parent props model action+mailChildren msg = do+  ComponentInfo {..} <- ask+  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'.+--+-- @+--+-- data Action+--   = ParsedMail Message+--   | ErrorMail MisoString+--+-- main :: IO ()+-- main = app { mailbox = checkMail ParsedMail ErrorMail }+-- @+--+-- @since 1.9.0.0+checkMail+  :: FromJSON value+  => (value -> action)+  -- ^ Successful callback+  -> (MisoString -> action)+  -- ^ Errorful callback+  -> Value+  -- ^ The message received to parse.+  -> Maybe action+checkMail successful errorful value =+  pure $ case fromJSON value of+    Success x -> successful x+    Error err -> errorful (ms err)+-----------------------------------------------------------------------------+-- | Fetches the parent `model` from the child (if @parent@ exists).+--+-- N.B. this is a no-op for 'ROOT'.+--+-- @since 1.9.0.0+parent+  :: (parent -> action)+  -- ^ Successful callback+  -> action+  -- ^ Errorful callback+  -> Effect parent props model action+parent successful errorful = do+  ComponentInfo {..} <- ask+  withSink $ \sink -> do+    IM.lookup _componentInfoParentId <$> liftIO (readIORef components) >>= \case+      Nothing -> sink errorful+      Just ComponentState {..} -> do+        sink (successful _componentModel)+-----------------------------------------------------------------------------+-- | Sends a message to all t'Miso.Types.Component' 'mailbox', excluding oneself.+--+-- @+--+-- update :: action -> Effect parent props model action+-- update _ = broadcast (String "public service announcement")+-- @+--+-- @since 1.9.0.0+broadcast+  :: Eq model+  => ToJSON message+  => message+  -- ^ Message to broadcast to all other 'Component'+  -> Effect parent props model action+broadcast msg = do+  ComponentInfo {..} <- ask+  io_ $ do+    vcompIds <- IM.keys <$> readIORef components+    forM_ vcompIds $ \vcompId ->+      when (_componentInfoId /= vcompId) $ do+        IM.lookup vcompId <$> readIORef components >>= \case+          Nothing -> pure ()+          Just ComponentState{..} ->+            case _componentMailbox (toJSON msg) of+              Nothing -> pure ()+              Just action -> _componentSink action+-----------------------------------------------------------------------------+type Socket = JSVal+-----------------------------------------------------------------------------+type WebSockets = IM.IntMap (IM.IntMap Socket)+-----------------------------------------------------------------------------+type EventSources = IM.IntMap (IM.IntMap Socket)+-----------------------------------------------------------------------------+websocketConnections :: IORef WebSockets+{-# NOINLINE websocketConnections #-}+websocketConnections = unsafePerformIO (newIORef IM.empty)+-----------------------------------------------------------------------------+websocketConnectionIds :: IORef Int+{-# NOINLINE websocketConnectionIds #-}+websocketConnectionIds = unsafePerformIO (newIORef (0 :: Int))+-----------------------------------------------------------------------------+websocketConnectText+  :: URL+  -- ^ t'WebSocket' 'URL'+  -> (WebSocket -> action)+  -- ^ onOpen+  -> (Closed -> action)+  -- ^ onClosed+  -> (MisoString -> action)+  -- ^ onMessage+  -> (MisoString -> action)+  -- ^ onError+  -> Effect parent props model action+websocketConnectText url onOpen onClosed onMessage onError =+  websocketCore $ \webSocketId sink ->+    FFI.websocketConnect url+      (sink $ onOpen webSocketId)+      (sink . onClosed <=< fromJSValUnchecked)+      (pure (sink . onMessage <=< fromJSValUnchecked))+      Nothing+      Nothing+      Nothing+      (sink . onError <=< fromJSValUnchecked)+      True+-----------------------------------------------------------------------------+websocketConnectBLOB+  :: URL+  -- ^ t'WebSocket' 'URL'+  -> (WebSocket -> action)+  -- ^ onOpen+  -> (Closed -> action)+  -- ^ onClosed+  -> (Blob -> action)+  -- ^ onMessage+  -> (MisoString -> action)+  -- ^ onError+  -> Effect parent props model action+websocketConnectBLOB url onOpen onClosed onMessage onError =+  websocketCore $ \webSocketId sink ->+    FFI.websocketConnect url+      (sink $ onOpen webSocketId)+      (sink . onClosed <=< fromJSValUnchecked)+      Nothing+      Nothing+      (pure (sink . onMessage . Blob))+      Nothing+      (sink . onError <=< fromJSValUnchecked)+      False+-----------------------------------------------------------------------------+websocketConnectArrayBuffer+  :: URL+  -- ^ t'WebSocket' 'URL'+  -> (WebSocket -> action)+  -- ^ onOpen+  -> (Closed -> action)+  -- ^ onClosed+  -> (ArrayBuffer -> action)+  -- ^ onMessage+  -> (MisoString -> action)+  -- ^ onError+  -> Effect parent props model action+websocketConnectArrayBuffer url onOpen onClosed onMessage onError =+  websocketCore $ \webSocketId sink ->+    FFI.websocketConnect url+      (sink $ onOpen webSocketId)+      (sink . onClosed <=< fromJSValUnchecked)+      Nothing+      Nothing+      Nothing+      (pure (sink . onMessage . ArrayBuffer))+      (sink . onError <=< fromJSValUnchecked)+      False+-----------------------------------------------------------------------------+websocketConnectJSON+  :: FromJSON json+  => URL+  -- ^ WebSocket URL+  -> (WebSocket -> action)+  -- ^ onOpen+  -> (Closed -> action)+  -- ^ onClosed+  -> (json -> action)+  -- ^ onMessage+  -> (MisoString -> action)+  -- ^ onError+  -> Effect parent props model action+websocketConnectJSON url onOpen onClosed onMessage onError =+  websocketCore $ \webSocketId sink ->+    FFI.websocketConnect url+      (sink $ onOpen webSocketId)+      (sink . onClosed <=< fromJSValUnchecked)+      Nothing+      (pure (\bytes -> do+          value :: Value <- fromJSValUnchecked bytes+          case fromJSON value of+            Error msg -> sink $ onError (ms msg)+            Success x -> sink $ onMessage x))+      Nothing+      Nothing+      (sink . onError <=< fromJSValUnchecked)+      False+-----------------------------------------------------------------------------+websocketConnect+  :: FromJSON json+  => URL+  -- ^ WebSocket URL+  -> (WebSocket -> action)+  -- ^ onOpen+  -> (Closed -> action)+  -- ^ onClosed+  -> (Payload json -> action)+  -- ^ onMessage+  -> (MisoString -> action)+  -- ^ onError+  -> Effect parent props model action+websocketConnect url onOpen onClosed onMessage onError =+  websocketCore $ \webSocketId sink ->+    FFI.websocketConnect url+      (sink $ onOpen webSocketId)+      (sink . onClosed <=< fromJSValUnchecked)+      (pure (sink . onMessage . TEXT <=< fromJSValUnchecked))+      (pure (\bytes -> do+          value :: Value <- fromJSValUnchecked bytes+          case fromJSON value of+            Error msg -> sink $ onError (ms msg)+            Success x -> sink $ onMessage (JSON x)))+      (pure (sink . onMessage . BLOB . Blob))+      (pure (sink . onMessage . BUFFER . ArrayBuffer))+      (sink . onError <=< fromJSValUnchecked)+      False+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/WebSocket>+websocketCore+  :: (WebSocket -> Sink action -> IO Socket)+  -> Effect parent props model action+websocketCore core = do+  ComponentInfo {..} <- ask+  withSink $ \sink -> do+    webSocketId <- freshWebSocket+    socket <- core webSocketId sink+    insertWebSocket _componentInfoId webSocketId socket+  where+    insertWebSocket :: ComponentId -> WebSocket -> Socket -> IO ()+    insertWebSocket componentId_ (WebSocket socketId) socket =+      atomicModifyIORef' websocketConnections $ \websockets ->+          (update websockets, ())+      where+        update websockets =+          IM.unionWith IM.union websockets+            $ IM.singleton componentId_+            $ IM.singleton socketId socket++    freshWebSocket :: IO WebSocket+    freshWebSocket = WebSocket <$>+      atomicModifyIORef' websocketConnectionIds (\x -> (x + 1, x))+-----------------------------------------------------------------------------+getWebSocket :: ComponentId -> WebSocket -> WebSockets -> Maybe Socket+getWebSocket vcompId (WebSocket websocketId) =+  IM.lookup websocketId <=< IM.lookup vcompId+-----------------------------------------------------------------------------+finalizeWebSockets :: ComponentId -> IO ()+finalizeWebSockets vcompId = do+  mapM_ (mapM_ FFI.websocketClose . IM.elems) .+    IM.lookup vcompId =<< readIORef websocketConnections+  dropComponentWebSockets+    where+      dropComponentWebSockets :: IO ()+      dropComponentWebSockets =+        atomicModifyIORef' websocketConnections $ \websockets ->+          (IM.delete vcompId websockets, ())+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/close>+websocketClose :: WebSocket -> Effect parent props model action+websocketClose socketId = do+  ComponentInfo {..} <- ask+  io_ $ do+    result <-+      atomicModifyIORef' websocketConnections $ \imap ->+        dropWebSocket _componentInfoId socketId imap =:+          getWebSocket _componentInfoId socketId imap+    case result of+      Nothing ->+        pure ()+      Just socket ->+        FFI.websocketClose socket+  where+    dropWebSocket :: ComponentId -> WebSocket -> WebSockets -> WebSockets+    dropWebSocket vcompId (WebSocket websocketId) websockets = do+      case IM.lookup vcompId websockets of+        Nothing ->+          websockets+        Just componentSockets ->+          IM.insert vcompId (IM.delete websocketId componentSockets) websockets+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/send>+websocketSend+  :: ToJSON value+  => WebSocket+  -> Payload value+  -> Effect parent props model action+websocketSend socketId msg = do+  ComponentInfo {..} <- ask+  io_ $ do+    getWebSocket _componentInfoId socketId <$> readIORef websocketConnections >>= \case+      Nothing -> pure ()+      Just socket ->+        case msg of+          JSON json_ ->+            FFI.websocketSend socket =<< toJSVal (encode json_)+          BUFFER arrayBuffer_ -> do+            FFI.websocketSend socket =<< toJSVal arrayBuffer_+          TEXT txt ->+            FFI.websocketSend socket =<< toJSVal txt+          BLOB blob_ ->+            FFI.websocketSend socket =<< toJSVal blob_+-----------------------------------------------------------------------------+-- | Retrieves current status of t'WebSocket'+--+-- If the t'WebSocket' identifier does not exist a 'CLOSED' is returned.+--+socketState :: WebSocket -> (SocketState -> action) -> Effect parent props model action+socketState socketId callback = do+  ComponentInfo {..} <- ask+  withSink $ \sink -> do+     getWebSocket _componentInfoId socketId <$> readIORef websocketConnections >>= \case+      Just socket -> do+        x <- socket ! ("socketState" :: MisoString)+        socketstate <- toEnum <$> fromJSValUnchecked x+        sink (callback socketstate)+      Nothing ->+        sink (callback CLOSED)+-----------------------------------------------------------------------------+codeToCloseCode :: Int -> CloseCode+codeToCloseCode = \case+  1000 -> CLOSE_NORMAL+  1001 -> CLOSE_GOING_AWAY+  1002 -> CLOSE_PROTOCOL_ERROR+  1003 -> CLOSE_UNSUPPORTED+  1005 -> CLOSE_NO_STATUS+  1006 -> CLOSE_ABNORMAL+  1007 -> Unsupported_Data+  1008 -> Policy_Violation+  1009 -> CLOSE_TOO_LARGE+  1010 -> Missing_Extension+  1011 -> Internal_Error+  1012 -> Service_Restart+  1013 -> Try_Again_Later+  1015 -> TLS_Handshake+  n    -> OtherCode n+-----------------------------------------------------------------------------+-- | Closed message is sent when a t'WebSocket' has closed+data Closed+  = Closed+  { closedCode :: CloseCode+    -- ^ The code used to indicate why a socket closed+  , wasClean :: Bool+    -- ^ If the connection was closed cleanly, or forcefully.+  , reason :: MisoString+    -- ^ The reason for socket closure.+  } deriving (Eq, Show)+-----------------------------------------------------------------------------+instance FromJSVal Closed where+  fromJSVal o = do+    closed_ <- fmap codeToCloseCode <$> do fromJSVal =<< o ! ("code" :: MisoString)+    wasClean_ <- fromJSVal =<< o ! ("wasClean" :: MisoString)+    reason_ <- fromJSVal =<< o ! ("reason" :: MisoString)+    pure (Closed <$> closed_ <*> wasClean_ <*> reason_)+-----------------------------------------------------------------------------+-- | URL that the t'WebSocket' will @connect@ to+type URL = MisoString+-----------------------------------------------------------------------------+-- | 'SocketState' corresponding to current t'WebSocket' connection+data SocketState+  = CONNECTING -- ^ 0+  | OPEN       -- ^ 1+  | CLOSING    -- ^ 2+  | CLOSED     -- ^ 3+  deriving (Show, Eq, Ord, Enum)+-----------------------------------------------------------------------------+-- | Code corresponding to a closed connection+-- https://developer.mozilla.org/en-US/docs/Web/API/CloseEvent+data CloseCode+  = CLOSE_NORMAL+   -- ^ 1000, Normal closure; the connection successfully completed whatever purpose for which it was created.+  | CLOSE_GOING_AWAY+   -- ^ 1001, The endpoint is going away, either because of a server failure or because the browser is navigating away from the page that opened the connection.+  | CLOSE_PROTOCOL_ERROR+   -- ^ 1002, The endpoint is terminating the connection due to a protocol error.+  | CLOSE_UNSUPPORTED+   -- ^ 1003, The connection is being terminated because the endpoint received data of a type it cannot accept (for example, a textonly endpoint received binary data).+  | CLOSE_NO_STATUS+   -- ^ 1005, Reserved.  Indicates that no status code was provided even though one was expected.+  | CLOSE_ABNORMAL+   -- ^ 1006, Reserved. Used to indicate that a connection was closed abnormally (that is, with no close frame being sent) when a status code is expected.+  | Unsupported_Data+   -- ^ 1007, The endpoint is terminating the connection because a message was received that contained inconsistent data (e.g., nonUTF8 data within a text message).+  | Policy_Violation+   -- ^ 1008, The endpoint is terminating the connection because it received a message that violates its policy. This is a generic status code, used when codes 1003 and 1009 are not suitable.+  | CLOSE_TOO_LARGE+   -- ^ 1009, The endpoint is terminating the connection because a data frame was received that is too large.+  | Missing_Extension+   -- ^ 1010, The client is terminating the connection because it expected the server to negotiate one or more extension, but the server didn't.+  | Internal_Error+   -- ^ 1011, The server is terminating the connection because it encountered an unexpected condition that prevented it from fulfilling the request.+  | Service_Restart+   -- ^ 1012, The server is terminating the connection because it is restarting.+  | Try_Again_Later+   -- ^ 1013, The server is terminating the connection due to a temporary condition, e.g. it is overloaded and is casting off some of its clients.+  | TLS_Handshake+   -- ^ 1015, Reserved. Indicates that the connection was closed due to a failure to perform a TLS handshake (e.g., the server certificate can't be verified).+  | OtherCode Int+   -- ^ OtherCode that is reserved and not in the range 0999+  deriving (Show, Eq)+-----------------------------------------------------------------------------+-- | Type for holding a t'WebSocket' file descriptor.+newtype WebSocket = WebSocket Int+  deriving (ToJSVal, Eq, Num)+-----------------------------------------------------------------------------+-- | A null t'WebSocket' is one with a negative descriptor.+emptyWebSocket :: WebSocket+emptyWebSocket = -1+-----------------------------------------------------------------------------+-- | A type for holding an t'EventSource' descriptor.+newtype EventSource = EventSource Int+  deriving (ToJSVal, Eq, Num)+-----------------------------------------------------------------------------+-- | A null t'EventSource' is one with a negative descriptor.+emptyEventSource :: EventSource+emptyEventSource = -1+-----------------------------------------------------------------------------+eventSourceConnections :: IORef EventSources+{-# NOINLINE eventSourceConnections #-}+eventSourceConnections = unsafePerformIO (newIORef IM.empty)+-----------------------------------------------------------------------------+eventSourceConnectionIds :: IORef Int+{-# NOINLINE eventSourceConnectionIds #-}+eventSourceConnectionIds = unsafePerformIO (newIORef (0 :: Int))+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/EventSource/EventSource>+eventSourceConnectText+  :: URL+  -- ^ EventSource URL+  -> (EventSource -> action)+  -- ^ onOpen+  -> (MisoString -> action)+  -- ^ onMessage+  -> (MisoString -> action)+  -- ^ onError+  -> Effect parent props model action+eventSourceConnectText url onOpen onMessage onError =+  eventSourceCore $ \eventSourceId sink -> do+    FFI.eventSourceConnect url+      (sink $ onOpen eventSourceId)+      (pure $ \e -> do+          txt <- fromJSValUnchecked e+          sink (onMessage txt))+      Nothing+      (sink . onError <=< fromJSValUnchecked)+      True+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/EventSource/EventSource>+eventSourceConnectJSON+  :: FromJSON json+  => URL+  -- ^ EventSource URL+  -> (EventSource -> action)+  -- ^ onOpen+  -> (json -> action)+  -- ^ onMessage+  -> (MisoString -> action)+  -- ^ onError+  -> Effect parent props model action+eventSourceConnectJSON url onOpen onMessage onError =+  eventSourceCore $ \eventSourceId sink -> do+    FFI.eventSourceConnect url+      (sink $ onOpen eventSourceId)+      Nothing+      (pure $ \e ->+         fromJSON <$> fromJSValUnchecked e >>= \case+            Error errMsg -> sink (onError (ms errMsg))+            Success json_ -> sink $ onMessage json_)+      (sink . onError <=< fromJSValUnchecked)+      False+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/EventSource/EventSource>+eventSourceCore+  :: (EventSource -> Sink action -> IO Socket)+  -> Effect parent props model action+eventSourceCore core = do+  ComponentInfo {..} <- ask+  withSink $ \sink -> do+    eventSourceId <- freshEventSource+    socket <- core eventSourceId sink+    insertEventSource _componentInfoId eventSourceId socket+  where+    insertEventSource :: ComponentId -> EventSource -> Socket -> IO ()+    insertEventSource componentId_ (EventSource socketId) socket =+      atomicModifyIORef' eventSourceConnections $ \eventSources ->+        (update eventSources, ())+      where+        update eventSources =+          IM.unionWith IM.union eventSources+            $ IM.singleton componentId_+            $ IM.singleton socketId socket++    freshEventSource :: IO EventSource+    freshEventSource = EventSource <$>+      atomicModifyIORef' eventSourceConnectionIds (\x -> (x + 1, x))+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/EventSource/close>+eventSourceClose :: EventSource -> Effect parent props model action+eventSourceClose socketId = do+  ComponentInfo {..} <- ask+  io_ $ do+    result <-+      atomicModifyIORef' eventSourceConnections $ \imap ->+        dropEventSource _componentInfoId socketId imap =:+          getEventSource _componentInfoId socketId imap+    case result of+      Nothing ->+        pure ()+      Just socket ->+        FFI.eventSourceClose socket+  where+    dropEventSource :: ComponentId -> EventSource -> EventSources -> EventSources+    dropEventSource vcompId (EventSource eventSourceId) eventSources = do+      case IM.lookup vcompId eventSources of+        Nothing ->+          eventSources+        Just componentSockets ->+          IM.insert vcompId (IM.delete eventSourceId componentSockets) eventSources++    getEventSource :: ComponentId -> EventSource -> EventSources -> Maybe Socket+    getEventSource vcompId (EventSource eventSourceId) =+      IM.lookup eventSourceId <=< IM.lookup vcompId+-----------------------------------------------------------------------------+finalizeEventSources :: ComponentId -> IO ()+finalizeEventSources vcompId = do+  mapM_ (mapM_ FFI.eventSourceClose . IM.elems) .+    IM.lookup vcompId =<< readIORef eventSourceConnections+  dropComponentEventSources+    where+      dropComponentEventSources :: IO ()+      dropComponentEventSources =+        atomicModifyIORef' eventSourceConnections $ \eventSources ->+          (IM.delete vcompId eventSources, ())+-----------------------------------------------------------------------------+-- | Payload is used as the potential source of data when working with t'EventSource'+data Payload value+  = JSON value+  -- ^ JSON-encoded data+  | BLOB Blob+  -- ^ Binary encoded data+  | TEXT MisoString+  -- ^ Text encoded data+  | BUFFER ArrayBuffer+  -- ^ Buffered data+-----------------------------------------------------------------------------+-- | Smart constructor for sending JSON encoded data via an t'EventSource'+json :: ToJSON value => value -> Payload value+json = JSON+-----------------------------------------------------------------------------+-- | Smart constructor for sending binary encoded data via an t'EventSource'+blob :: Blob -> Payload value+blob = BLOB+-----------------------------------------------------------------------------+-- | Smart constructor for sending an @ArrayBuffer@ via an t'EventSource'+arrayBuffer :: ArrayBuffer -> Payload value+arrayBuffer = BUFFER+-----------------------------------------------------------------------------+initComponent+  :: (Eq parent, Eq model)+  => Events+  -> Hydrate+  -> Bool+  -> Component parent () model action+  -> IO ()+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.+--+-- You don't need to use this function if you're compiling w/ WASM and using `miso` or `startApp`.+-- It's already invoked for you. This is a no-op w/ the JS backend.+--+-- If you need access to `Miso.FFI` to call functions from `miso.js`, but you're not+-- using `startApp` or `miso`, you'll need to call this function (w/ WASM only).+--+#ifdef PRODUCTION+#define MISO_JS_PATH "js/miso.prod.js"+#else+#define MISO_JS_PATH "js/miso.js"+#endif+withJS+  :: IO a+  -- ^ 'IO' action to execute in between 'evalFile'+  -> IO a+withJS action = do+#ifdef WASM+  $(evalFile MISO_JS_PATH)+#endif+  action+-----------------------------------------------------------------------------
+ src/Miso/Runtime/Internal.hs view
@@ -0,0 +1,49 @@+-----------------------------------------------------------------------------+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Runtime.Internal+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Runtime.Internal" is a __testing-only__ facade that re-exports+-- the miso runtime's global mutable state from "Miso.Runtime".+--+-- __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, schedulerThread)+----------------------------------------------------------------------------
+ src/Miso/State.hs view
@@ -0,0 +1,73 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.State+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "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.+--+-- This module is re-exported in its entirety by "Miso", so most+-- applications do not need to import it explicitly.+--+-- = Quick start+--+-- @+-- 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))+-- @+--+-- 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+  , asks+  , modify+  , modify'+  , get+  , gets+  , put+  , tell+  , liftIO+  ) where+----------------------------------------------------------------------------+import Control.Monad.RWS (get, gets, modify, modify', tell, put, ask, asks)+import Control.Monad.IO.Class (liftIO)+----------------------------------------------------------------------------
+ src/Miso/Storage.hs view
@@ -0,0 +1,195 @@+-----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Storage+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Storage" wraps the browser's+-- <https://developer.mozilla.org/en-US/docs/Web/API/Web_Storage_API Web Storage API>,+-- providing access to both+-- <https://developer.mozilla.org/en-US/docs/Web/API/Window/localStorage localStorage>+-- and+-- <https://developer.mozilla.org/en-US/docs/Web/API/Window/sessionStorage sessionStorage>+-- 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+    getLocalStorage+  , setLocalStorage+  , removeLocalStorage+  , clearLocalStorage+  , localStorageLength+    -- ** Session+  , getSessionStorage+  , setSessionStorage+  , removeSessionStorage+  , clearSessionStorage+  , sessionStorageLength+  ) where+-----------------------------------------------------------------------------+import           Control.Monad (void)+-----------------------------------------------------------------------------+import           Miso.DSL+import           Miso.String (MisoString)+-----------------------------------------------------------------------------+-- | 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+-----------------------------------------------------------------------------+-- | 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+-----------------------------------------------------------------------------+-- | Sets the value of a key in local storage.+--+-- @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+  setItem s key value+-----------------------------------------------------------------------------+-- | Sets the value of a key in session storage.+--+-- @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+  setItem s key value+-----------------------------------------------------------------------------+-- | Removes an item from local storage.+--+-- @removeLocalStorage key@ removes the value of @key@.+removeLocalStorage+  :: MisoString+  -- ^ Storage key to remove+  -> IO ()+removeLocalStorage key = do+  s <- localStorage+  removeItem s key+-----------------------------------------------------------------------------+-- | Removes an item from session storage.+--+-- @removeSessionStorage key@ removes the value of @key@.+removeSessionStorage+  :: MisoString+  -- ^ Storage key to remove+  -> IO ()+removeSessionStorage key = do+  s <- sessionStorage+  removeItem s key+-----------------------------------------------------------------------------+-- | Clears local storage.+--+-- @clearLocalStorage@ removes all values from local storage.+clearLocalStorage :: IO ()+clearLocalStorage = clear =<< localStorage+-----------------------------------------------------------------------------+-- | Clears session storage.+--+-- @clearSessionStorage@ removes all values from session storage.+clearSessionStorage :: IO ()+clearSessionStorage = clear =<< sessionStorage+-----------------------------------------------------------------------------+-- | Returns the number of items in local storage.+--+-- @localStorageLength@ returns the count of items in local storage+localStorageLength :: IO Int+localStorageLength = fromJSValUnchecked =<< localStorage ! "length"+-----------------------------------------------------------------------------+-- | Returns the number of items in session storage.+--+-- @sessionStorageLength@ returns the count of items in session storage+sessionStorageLength :: IO Int+sessionStorageLength = fromJSValUnchecked =<< sessionStorage ! "length"+-----------------------------------------------------------------------------+localStorage :: IO Storage+localStorage = Storage <$> (jsg "window" ! "localStorage")+-----------------------------------------------------------------------------+sessionStorage :: IO Storage+sessionStorage = Storage <$> (jsg "window" ! "sessionStorage")+-----------------------------------------------------------------------------+getItem :: Storage -> MisoString -> IO JSVal+getItem (Storage s) key = s # "getItem" $ [key]+-----------------------------------------------------------------------------+removeItem :: Storage -> MisoString -> IO ()+removeItem (Storage s) key = void $ s # "removeItem" $ [key]+-----------------------------------------------------------------------------+setItem :: Storage -> MisoString -> MisoString -> IO ()+setItem (Storage s) key val = do+  _ <- s # "setItem" $ (key, val)+  pure ()+-----------------------------------------------------------------------------+clear :: Storage -> IO ()+clear (Storage s) = do+  _ <- s # "clear" $ ()+  pure ()+-----------------------------------------------------------------------------+newtype Storage = Storage JSVal+  deriving (ToObject, ToJSVal)+-----------------------------------------------------------------------------
+ src/Miso/String.hs view
@@ -0,0 +1,208 @@+-----------------------------------------------------------------------------+{-# LANGUAGE CPP               #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE FlexibleInstances #-}+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.String+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- 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 (..)+  , FromMisoString (..)+  , fromMisoString+  , MisoString+#ifdef VANILLA+  , module Data.Text+#else+  , module Data.JSString+#endif+  , ms+  ) where+----------------------------------------------------------------------------+import           Control.Exception+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Lazy as BL+#ifdef VANILLA+import           Data.Text hiding (show, elem)+#else+import           Data.JSString+#ifdef GHCJS_BOTH+import           Data.JSString.Text+#endif+#endif+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT+----------------------------------------------------------------------------+import           Miso.DSL.FFI+----------------------------------------------------------------------------+-- | The primary string type in Miso applications.+--+-- * @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+#else+type MisoString = JSString+#endif+----------------------------------------------------------------------------+-- | 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 value to 'MisoString'.+  toMisoString :: str -> 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+----------------------------------------------------------------------------+-- | 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+----------------------------------------------------------------------------+-- | Short alias for 'toMisoString'. The idiomatic way to construct a 'MisoString'.+ms :: ToMisoString str => str -> MisoString+ms = toMisoString+----------------------------------------------------------------------------+instance ToMisoString a => ToMisoString (Maybe a) where+  toMisoString = \case+    Nothing -> mempty+    Just x -> ms x+----------------------------------------------------------------------------+instance ToMisoString Char where+  toMisoString = singleton+----------------------------------------------------------------------------+instance ToMisoString IOException where+  toMisoString = ms . show+----------------------------------------------------------------------------+#ifndef VANILLA+instance ToMisoString MisoString where+  toMisoString = id+#endif+----------------------------------------------------------------------------+instance ToMisoString SomeException where+  toMisoString = ms . show+----------------------------------------------------------------------------+instance ToMisoString String where+  toMisoString = pack+----------------------------------------------------------------------------+instance ToMisoString LT.Text where+  toMisoString = ms . LT.toStrict+----------------------------------------------------------------------------+instance ToMisoString T.Text where+#ifdef VANILLA+  toMisoString = id+#else+  toMisoString = textToJSString+#endif+----------------------------------------------------------------------------+instance ToMisoString B.ByteString where+  toMisoString = ms . T.decodeUtf8+----------------------------------------------------------------------------+instance ToMisoString BL.ByteString where+  toMisoString = ms . LT.decodeUtf8+----------------------------------------------------------------------------+instance ToMisoString B.Builder where+  toMisoString = ms . B.toLazyByteString+----------------------------------------------------------------------------+instance ToMisoString Float where+  -- dmj: issue where Float shows additional digits (affects both JS & WASM)+  toMisoString = toString_Double . realToFrac+----------------------------------------------------------------------------+instance ToMisoString Double where+  toMisoString = toString_Double+----------------------------------------------------------------------------+instance ToMisoString Int where+  toMisoString = toString_Int+----------------------------------------------------------------------------+instance ToMisoString Word where+  toMisoString = toString_Word+----------------------------------------------------------------------------+#ifndef VANILLA+instance FromMisoString MisoString where+  fromMisoStringEither = Right+#endif+----------------------------------------------------------------------------+instance FromMisoString T.Text where+#ifdef VANILLA+  fromMisoStringEither = Right+#else+  fromMisoStringEither = Right . textFromJSString+#endif+----------------------------------------------------------------------------+instance FromMisoString String where+  fromMisoStringEither = Right . unpack+----------------------------------------------------------------------------+instance FromMisoString LT.Text where+#ifdef VANILLA+  fromMisoStringEither = Right . LT.fromStrict+#else+  fromMisoStringEither = Right . LT.fromStrict . textFromJSString+#endif+----------------------------------------------------------------------------+instance FromMisoString B.ByteString where+  fromMisoStringEither = fmap T.encodeUtf8 . fromMisoStringEither+----------------------------------------------------------------------------+instance FromMisoString BL.ByteString where+  fromMisoStringEither = fmap LT.encodeUtf8 . fromMisoStringEither+----------------------------------------------------------------------------+instance FromMisoString B.Builder where+  fromMisoStringEither = fmap B.byteString . fromMisoStringEither+----------------------------------------------------------------------------+instance FromMisoString Word where+  fromMisoStringEither string =+    case parseWord string of+      Nothing -> Left ("fromMisoString Word: could not parse " <> unpack string)+      Just x -> Right x+----------------------------------------------------------------------------+instance FromMisoString Double where+  fromMisoStringEither string =+    case parseDouble string of+      Nothing -> Left ("fromMisoString Double: could not parse " <> unpack string)+      Just x -> Right x+----------------------------------------------------------------------------+instance FromMisoString Int where+  fromMisoStringEither string =+    case parseInt string of+      Nothing -> Left ("fromMisoString Int: could not parse " <> unpack string)+      Just x -> Right x+----------------------------------------------------------------------------+instance FromMisoString Float where+  fromMisoStringEither string =+    case parseFloat string of+      Nothing -> Left ("fromMisoString Float: could not parse " <> unpack string)+      Just x -> Right x+----------------------------------------------------------------------------
+ src/Miso/String/QQ.hs view
@@ -0,0 +1,97 @@+-----------------------------------------------------------------------------+{-# LANGUAGE CPP                       #-}+{-# LANGUAGE QuasiQuotes               #-}+{-# LANGUAGE NamedFieldPuns            #-}+{-# LANGUAGE RecordWildCards           #-}+{-# LANGUAGE TemplateHaskellQuotes     #-}+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -Wno-duplicate-exports #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.String.QQ+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- 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 \<style\> or \<script\> 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 \<the-literal-string\>@, 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+  ) where+----------------------------------------------------------------------------+import Language.Haskell.TH.Quote+----------------------------------------------------------------------------+import Miso.String (toMisoString)+----------------------------------------------------------------------------+-- | QuasiQuoter for specifying multiline 'Miso.String.MisoString'+--+-- @+-- {-# LANGUAGE QuasiQuotes #-}+--+-- test :: MisoString+-- test = [misoString| foo+--   bar+--     baz+-- |]+--+-- @+--+misoString :: QuasiQuoter+misoString = QuasiQuoter+  { quoteExp  = \string -> [| toMisoString string |]+  , quotePat  = \_ -> fail "quotePat: not implemented"+  , quoteType = \_ -> fail "quoteType: not implemented"+  , quoteDec  = \_ -> fail "quoteDec: not implemented"+  }+----------------------------------------------------------------------------
+ src/Miso/Subscription.hs view
@@ -0,0 +1,85 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Subscription+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = 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+    module Miso.Subscription.Mouse+    -- ** Keyboard+  , module Miso.Subscription.Keyboard+    -- ** History+  , module Miso.Subscription.History+    -- ** Window+  , module Miso.Subscription.Window+    -- ** OnLine+  , module Miso.Subscription.OnLine+    -- ** requestForAnimationFrame+  , module Miso.Subscription.RAF+  ) where+-----------------------------------------------------------------------------+import Miso.Subscription.Mouse+import Miso.Subscription.Keyboard+import Miso.Subscription.History+import Miso.Subscription.Window+import Miso.Subscription.OnLine+import Miso.Subscription.RAF+-----------------------------------------------------------------------------
+ src/Miso/Subscription/History.hs view
@@ -0,0 +1,193 @@+-----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Subscription.History+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Subscription.History" wraps the browser's+-- <https://developer.mozilla.org/en-US/docs/Web/API/History History API>+-- and+-- <https://developer.mozilla.org/en-US/docs/Web/API/PopStateEvent popstate>+-- 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+    uriSub+  , routerSub+    -- *** Functions+  , getURI+  , pushURI+  , pushRoute+  , replaceURI+  , back+  , forward+  , go+   -- *** Types+  , URI (..)+  ) where+-----------------------------------------------------------------------------+import           Control.Monad+-----------------------------------------------------------------------------+import           Miso.DSL+import qualified Miso.FFI.Internal as FFI+import           Miso.String+import           Miso.Router+import           Miso.Effect (Sub)+import           Miso.Subscription.Util+-----------------------------------------------------------------------------+-- | Pushes a new URI onto the History stack. Also raises a `popstate` event.+pushURI+  :: URI+  -- ^ The URI to push onto the history stack+  -> IO ()+pushURI uri = do+  pushState (prettyURI uri)+  raisePopState+-----------------------------------------------------------------------------+-- | Pushes a new 'Route' onto the History stack. Also raises a `popstate` event.+--+-- Converts the t'Route' to a t'URI' internally.+--+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+  -- ^ The URI to replace the current history entry with+  -> IO ()+replaceURI uri = do+  replaceState (prettyURI uri)+  raisePopState+-----------------------------------------------------------------------------+raisePopState :: IO ()+raisePopState = do+  event <- new (jsg "PopStateEvent") ["popstate" :: MisoString]+  window <- jsg "window"+  void $ window # "dispatchEvent" $ [event]+-----------------------------------------------------------------------------+-- | Navigates backwards.+back :: IO ()+back = void $ getHistory # "back" $ ()+-----------------------------------------------------------------------------+-- | Navigates forwards.+forward :: IO ()+forward = void $ getHistory # "forward" $ ()+-----------------------------------------------------------------------------+-- | Jumps to a specific position in history.+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.+--+-- This returns a new t'URI' whenever `go`, `back`, `forward`, `pushState`+-- or `replaceState` have been called.+--+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+-----------------------------------------------------------------------------+-- | Subscription for @popstate@ events, from the History API, mapped+-- to a user-defined 'Router'.+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@+-- and @hash@.+getURI :: IO URI+getURI = do+  location <- jsg "window" ! "location"+  pathname <- fromJSValUnchecked =<< location ! "pathname"+  search <- fromJSValUnchecked =<< location ! "search"+  hash <- fromJSValUnchecked =<< location ! "hash"+  let uriText =+        mconcat+        [ pathname+        , search+        , hash+        ]+  case parseURI uriText of+    Left err -> do+      FFI.consoleError ("Couldn't parse URI: " <> err)+      pure emptyURI+    Right uri -> do+      pure uri+-----------------------------------------------------------------------------+getHistory :: IO JSVal+getHistory = jsg "window" ! "history"+-----------------------------------------------------------------------------+pushState :: MisoString -> IO ()+pushState url = void $ getHistory # "pushState" $ (jsNull, jsNull, url)+-----------------------------------------------------------------------------+replaceState :: MisoString -> IO ()+replaceState url = void $ getHistory # "replaceState" $ (jsNull, jsNull, url)+-----------------------------------------------------------------------------
+ src/Miso/Subscription/Keyboard.hs view
@@ -0,0 +1,164 @@+-----------------------------------------------------------------------------+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Subscription.Keyboard+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- 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+--   <https://developer.mozilla.org/en-US/docs/Web/API/KeyboardEvent/keyCode keyCodes>.+--   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+    Arrows (..)+    -- *** Subscriptions+  , arrowsSub+  , directionSub+  , keyboardSub+  , wasdSub+  ) where+-----------------------------------------------------------------------------+import           Control.Monad.IO.Class+import           Data.IORef+import           Data.IntSet+import qualified Data.IntSet as S+-----------------------------------------------------------------------------+import           Miso.DSL hiding (new)+import           Miso.Effect (Sub)+import           Miso.Subscription.Util (createSub)+import qualified Miso.FFI.Internal as FFI+-----------------------------------------------------------------------------+-- | Type for arrow keys currently pressed.+--+--  * 37 left arrow  ( x = -1 )+--  * 38 up arrow    ( y =  1 )+--  * 39 right arrow ( x =  1 )+--  * 40 down arrow  ( y = -1 )+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+-- mapping for keys representing up, down, left and right respectively.+toArrows :: ([Int], [Int], [Int], [Int]) -> IntSet -> Arrows+toArrows (up, down, left, right) set' = Arrows+  { arrowX =+      case (check left, check right) of+        (True, False) -> -1+        (False, True) -> 1+        (_,_) -> 0+  , arrowY =+      case (check down, check up) of+        (True, False) -> -1+        (False, True) -> 1+        (_,_) -> 0+  } where+      check = any (`S.member` set')+-----------------------------------------------------------------------------+-- | Maps t'Arrows' onto a Keyboard subscription.+arrowsSub :: (Arrows -> action) -> Sub action+arrowsSub = directionSub ([38], [40], [37], [39])+-----------------------------------------------------------------------------+-- | Maps t'Arrows' onto a Keyboard subscription for directions (W+A+S+D keys).+wasdSub :: (Arrows -> action) -> Sub action+wasdSub = directionSub ([87], [83], [65], [68])+-----------------------------------------------------------------------------+-- | Maps a specified list of keys to directions (up, down, left, right).+-- 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)+-----------------------------------------------------------------------------+-- | Returns 'Sub' for keyboard events.+-- The callback will be called with the Set of currently pressed @keyCode@s.+keyboardSub :: (IntSet -> action) -> Sub action+keyboardSub f sink = createSub acquire release sink+  where+    release (cb1, cb2, cb3) = do+      FFI.windowRemoveEventListener "keyup" cb1+      FFI.windowRemoveEventListener "keydown" cb2+      FFI.windowRemoveEventListener "blur" cb3+    acquire = do+      keySetRef <- liftIO (newIORef mempty)+      cb1 <- FFI.windowAddEventListener "keyup" (keyUpCallback keySetRef)+      cb2 <- FFI.windowAddEventListener "keydown" (keyDownCallback keySetRef)+      cb3 <- FFI.windowAddEventListener "blur" (blurCallback keySetRef)+      pure (cb1, cb2, cb3)+        where+          keyDownCallback keySetRef = \keyDownEvent -> do+              key <- fromJSValUnchecked =<< getProp "keyCode" (Object keyDownEvent)+              newKeys <- liftIO $ atomicModifyIORef' keySetRef $ \keys ->+                 let !new = S.insert key keys+                 in (new, new)+              sink (f newKeys)++          keyUpCallback keySetRef = \keyUpEvent -> do+              key <- fromJSValUnchecked =<< getProp "keyCode" (Object keyUpEvent)+              newKeys <- liftIO $ atomicModifyIORef' keySetRef $ \keys ->+                 let !new = S.delete key keys+                 in (new, new)+              sink (f newKeys)++          -- Assume keys are released the moment focus is lost. Otherwise going+          -- back and forth to the app can cause keys to get stuck.+          blurCallback keySetRef = \_ -> do+              newKeys <- liftIO $ atomicModifyIORef' keySetRef $ \_ ->+                let !new = S.empty+                in (new, new)+              sink (f newKeys)+-----------------------------------------------------------------------------
+ src/Miso/Subscription/Mouse.hs view
@@ -0,0 +1,65 @@+-----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Subscription.Mouse+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- 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+    mouseSub+  ) where+-----------------------------------------------------------------------------+import Miso.Event (pointerDecoder, PointerEvent)+import Miso.Subscription.Window (windowSub)+import Miso.Effect (Sub)+-----------------------------------------------------------------------------+-- | Captures mouse coordinates as they occur and writes them to+-- an event sink.+mouseSub+  :: (PointerEvent -> action)+  -- ^ Callback fired with the full 'PointerEvent' on every @pointermove@+  -> Sub action+mouseSub = windowSub "pointermove" pointerDecoder+-----------------------------------------------------------------------------
+ src/Miso/Subscription/OnLine.hs view
@@ -0,0 +1,74 @@+-----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings   #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Subscription.OnLine+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Subscription.OnLine" provides 'onLineSub', a subscription that+-- tracks the browser's+-- <https://developer.mozilla.org/en-US/docs/Web/API/Navigator/onLine navigator.onLine>+-- 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+    onLineSub+  ) where+-----------------------------------------------------------------------------+import           Miso.Effect (Sub)+import           Miso.Subscription.Util (createSub)+import qualified Miso.FFI.Internal as FFI+-----------------------------------------------------------------------------+-- | Returns 'Sub' for the navigator.onLine API.+-- Fires action with 'True' when the browser goes online, and 'False' when it goes offline.+--+-- <https://developer.mozilla.org/en-US/docs/Web/API/Navigator/onLine>+--+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+      FFI.windowRemoveEventListener "online" cb1+      FFI.windowRemoveEventListener "offline" cb2+    acquire = do+      cb1 <- FFI.windowAddEventListener "online" (\_ -> sink (f True))+      cb2 <- FFI.windowAddEventListener "offline" (\_ -> sink (f False))+      pure (cb1, cb2)+-----------------------------------------------------------------------------
+ src/Miso/Subscription/RAF.hs view
@@ -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 <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Subscription.RAF" provides 'rAFSub', a subscription that hooks+-- into the browser's+-- <https://developer.mozilla.org/en-US/docs/Web/API/Window/requestAnimationFrame requestAnimationFrame>+-- loop. On each frame the browser calls back with a+-- <https://developer.mozilla.org/en-US/docs/Web/API/DOMHighResTimeStamp DOMHighResTimeStamp>+-- (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+----------------------------------------------------------------------------
+ src/Miso/Subscription/Util.hs view
@@ -0,0 +1,89 @@+-----------------------------------------------------------------------------+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Subscription.Util+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- 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+     createSub+   ) where+----------------------------------------------------------------------------+import           Control.Concurrent (threadDelay)+import           Control.Monad (forever)+import           Control.Exception (bracket)+-----------------------------------------------------------------------------+import           Miso.Effect+-----------------------------------------------------------------------------+-- | Utility function to allow resource finalization on 'Sub'.+createSub+  :: IO a+  -- ^ Acquire resource+  -> (a -> IO b)+  -- ^ Release resource+  -> Sub action+createSub acquire release = \_ ->+  bracket acquire release (\_ -> forever (threadDelay (secs 10000)))+    where+      secs :: Int -> Int+      secs = (*1000000)+----------------------------------------------------------------------------
+ src/Miso/Subscription/Window.hs view
@@ -0,0 +1,142 @@+-----------------------------------------------------------------------------+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Subscription.Window+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Subscription.Window" provides subscriptions that listen to+-- <https://developer.mozilla.org/en-US/docs/Web/API/Window#events window-level events>.+-- 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+    windowSub+  , windowCoordsSub+  , windowPointerMoveSub+  , windowSubWithOptions+  -- *** Types+  , Coord+  ) where+-----------------------------------------------------------------------------+import           Control.Monad+-----------------------------------------------------------------------------+import           Miso.DSL+import           Miso.Event+import           Miso.Effect+import qualified Miso.FFI.Internal as FFI+import           Miso.JSON hiding (Options, defaultOptions)+import           Miso.String+import           Miso.Subscription.Util+import           Miso.Canvas (Coord)+-----------------------------------------------------------------------------+-- | Captures window coordinates changes as they occur and writes them to+-- an event sink.+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+  -- ^ 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+    where+      release =+        FFI.windowRemoveEventListener eventName+      acquire =+        FFI.windowAddEventListener eventName $ \e -> do+          decodeAtVal <- toJSVal decodeAt+          v <- fromJSValUnchecked =<< FFI.eventJSON decodeAtVal e+          case parseEither decoder v of+            Left s ->+              FFI.consoleError ("windowSubWithOptions: Parse error on " <> eventName <> ": " <> ms s)+            Right r -> do+              when _stopPropagation (FFI.eventStopPropagation e)+              when _preventDefault (FFI.eventPreventDefault e)+              sink (toAction r)+-----------------------------------------------------------------------------+-- | @window.addEventListener ("pointermove", (event) => handle(event))@+-- A 'Sub' to handle t'PointerEvent's on window.+windowPointerMoveSub+  :: (PointerEvent -> action)+  -- ^ Callback fired with the full 'PointerEvent' on every @pointermove@+  -> Sub action+windowPointerMoveSub = windowSub "pointermove" pointerDecoder+-----------------------------------------------------------------------------
src/Miso/Svg.hs view
@@ -1,37 +1,63 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Miso.Svg--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- 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 ----- intView :: Int -> View IntAction--- intView 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 ----- <http://github.com/dmjio/miso>+-- * "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+-- * <https://developer.mozilla.org/en-US/docs/Web/SVG MDN SVG reference> ---------------------------------------------------------------------------- module Miso.Svg-   ( module Miso.Svg.Element-   , module Miso.Svg.Attribute+   ( -- ** Element+     module Miso.Svg.Element+     -- ** Event    , module Miso.Svg.Event    ) where--import Miso.Svg.Attribute hiding ( filter_, path_, title_, mask_-                               , glyphRef_, clipPath_, colorProfile_-                               , cursor_, style_ )+----------------------------------------------------------------------------- import Miso.Svg.Element import Miso.Svg.Event+-----------------------------------------------------------------------------
− src/Miso/Svg/Attribute.hs 
@@ -1,1038 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--------------------------------------------------------------------------------- |--- Module      :  Miso.Svg.Attribute--- Copyright   :  (C) 2016-2018 David M. Johnson--- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------ <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute>---------------------------------------------------------------------------------module Miso.Svg.Attribute-  ( -- * Regular attributes-    accentHeight_-  , accelerate_-  , accumulate_-  , additive_-  , alphabetic_-  , allowReorder_-  , amplitude_-  , arabicForm_-  , ascent_-  , attributeName_-  , attributeType_-  , autoReverse_-  , azimuth_-  , baseFrequency_-  , baseProfile_-  , bbox_-  , begin_-  , bias_-  , by_-  , calcMode_-  , capHeight_-  , class_'-  , clipPathUnits_-  , contentScriptType_-  , contentStyleType_-  , cx_-  , cy_-  , d_-  , decelerate_-  , descent_-  , diffuseConstant_-  , divisor_-  , dur_-  , dx_-  , dy_-  , edgeMode_-  , elevation_-  , end_-  , exponent_-  , externalResourcesRequired_-  , filterRes_-  , filterUnits_-  , format_-  , from_-  , fx_-  , fy_-  , g1_-  , g2_-  , glyphName_-  , glyphRef_-  , gradientTransform_-  , gradientUnits_-  , hanging_-  , height_-  , horizAdvX_-  , horizOriginX_-  , horizOriginY_-  , id_-  , ideographic_-  , in_'-  , in2_-  , intercept_-  , k_-  , k1_-  , k2_-  , k3_-  , k4_-  , kernelMatrix_-  , kernelUnitLength_-  , keyPoints_-  , keySplines_-  , keyTimes_-  , lang_-  , lengthAdjust_-  , limitingConeAngle_-  , local_-  , markerHeight_-  , markerUnits_-  , markerWidth_-  , maskContentUnits_-  , maskUnits_-  , mathematical_-  , max_-  , media_-  , method_-  , min_-  , mode_-  , name_-  , numOctaves_-  , offset_-  , operator_-  , order_-  , orient_-  , orientation_-  , origin_-  , overlinePosition_-  , overlineThickness_-  , panose1_-  , path_-  , pathLength_-  , patternContentUnits_-  , patternTransform_-  , patternUnits_-  , pointOrder_-  , points_-  , pointsAtX_-  , pointsAtY_-  , pointsAtZ_-  , preserveAlpha_-  , preserveAspectRatio_-  , primitiveUnits_-  , r_-  , radius_-  , refX_-  , refY_-  , renderingIntent_-  , repeatCount_-  , repeatDur_-  , requiredExtensions_-  , requiredFeatures_-  , restart_-  , result_-  , rotate_-  , rx_-  , ry_-  , scale_-  , seed_-  , slope_-  , spacing_-  , specularConstant_-  , specularExponent_-  , speed_-  , spreadMethod_-  , startOffset_-  , stdDeviation_-  , stemh_-  , stemv_-  , stitchTiles_-  , strikethroughPosition_-  , strikethroughThickness_-  , string_-  , style_-  , surfaceScale_-  , systemLanguage_-  , tableValues_-  , target_-  , targetX_-  , targetY_-  , textLength_-  , title_-  , to_-  , transform_-  , type_'-  , u1_-  , u2_-  , underlinePosition_-  , underlineThickness_-  , unicode_-  , unicodeRange_-  , unitsPerEm_-  , vAlphabetic_-  , vHanging_-  , vIdeographic_-  , vMathematical_-  , values_-  , version_-  , vertAdvY_-  , vertOriginX_-  , vertOriginY_-  , viewBox_-  , viewTarget_-  , width_-  , widths_-  , x_-  , xHeight_-  , x1_-  , x2_-  , xChannelSelector_-  , xlinkActuate_-  , xlinkArcrole_-  , xlinkHref_-  , xlinkRole_-  , xlinkShow_-  , xlinkTitle_-  , xlinkType_-  , xmlBase_-  , xmlLang_-  , xmlSpace_-  , y_-  , y1_-  , y2_-  , yChannelSelector_-  , z_-  , zoomAndPan_-  -- * Presentation_ attributes-  , alignmentBaseline_-  , baselineShift_-  , clipPath_-  , clipRule_-  , clip_-  , colorInterpolationFilters_-  , colorInterpolation_-  , colorProfile_-  , colorRendering_-  , color_-  , cursor_-  , direction_-  , display_-  , dominantBaseline_-  , enableBackground_-  , fillOpacity_-  , fillRule_-  , fill_-  , filter_-  , floodColor_-  , floodOpacity_-  , fontFamily_-  , fontSizeAdjust_-  , fontSize_-  , fontStretch_-  , fontStyle_-  , fontVariant_-  , fontWeight_-  , glyphOrientationHorizontal_-  , glyphOrientationVertical_-  , imageRendering_-  , kerning_-  , letterSpacing_-  , lightingColor_-  , markerEnd_-  , markerMid_-  , markerStart_-  , mask_-  , opacity_-  , overflow_-  , pointerEvents_-  , shapeRendering_-  , stopColor_-  , stopOpacity_-  , strokeDasharray_-  , strokeDashoffset_-  , strokeLinecap_-  , strokeLinejoin_-  , strokeMiterlimit_-  , strokeOpacity_-  , strokeWidth_-  , stroke_-  , textAnchor_-  , textDecoration_-  , textRendering_-  , unicodeBidi_-  , visibility_-  , wordSpacing_-  , writingMode_-  ) where--import Miso.Html.Internal ( Attribute )-import Miso.Html.Property ( textProp )-import Miso.String        ( MisoString )--attr :: MisoString -> MisoString -> Attribute action-attr = textProp---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/accent-height>-accentHeight_ ::  MisoString -> Attribute action-accentHeight_ = attr "accent-height"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/accelerate>-accelerate_ ::  MisoString -> Attribute action-accelerate_ = attr "accelerate"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/accumulate>-accumulate_ ::  MisoString -> Attribute action-accumulate_ = attr "accumulate"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/additive>-additive_ ::  MisoString -> Attribute action-additive_ = attr "additive"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/alphabetic>-alphabetic_ ::  MisoString -> Attribute action-alphabetic_ = attr "alphabetic"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/allowReorder>-allowReorder_ ::  MisoString -> Attribute action-allowReorder_ = attr "allowReorder"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/amplitude>-amplitude_ ::  MisoString -> Attribute action-amplitude_ = attr "amplitude"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/arabic-form>-arabicForm_ ::  MisoString -> Attribute action-arabicForm_ = attr "arabic-form"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/ascent>-ascent_ ::  MisoString -> Attribute action-ascent_ = attr "ascent"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/attributeName>-attributeName_ ::  MisoString -> Attribute action-attributeName_ = attr "attributeName"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/attributeType>-attributeType_ ::  MisoString -> Attribute action-attributeType_ = attr "attributeType"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/autoReverse>-autoReverse_ ::  MisoString -> Attribute action-autoReverse_ = attr "autoReverse"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/azimuth>-azimuth_ ::  MisoString -> Attribute action-azimuth_ = attr "azimuth"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/baseFrequency>-baseFrequency_ ::  MisoString -> Attribute action-baseFrequency_ = attr "baseFrequency"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/baseProfile>-baseProfile_ ::  MisoString -> Attribute action-baseProfile_ = attr "baseProfile"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/bbox>-bbox_ ::  MisoString -> Attribute action-bbox_ = attr "bbox"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/begin>-begin_ ::  MisoString -> Attribute action-begin_ = attr "begin"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/bias>-bias_ ::  MisoString -> Attribute action-bias_ = attr "bias"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/by>-by_ ::  MisoString -> Attribute action-by_ = attr "by"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/calcMode>-calcMode_ ::  MisoString -> Attribute action-calcMode_ = attr "calcMode"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/cap-height>-capHeight_ ::  MisoString -> Attribute action-capHeight_ = attr "cap-height"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/class>-class_' ::  MisoString -> Attribute action-class_' = attr "class"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/clipPathUnits>-clipPathUnits_ ::  MisoString -> Attribute action-clipPathUnits_ = attr "clipPathUnits"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/contentScriptType>-contentScriptType_ ::  MisoString -> Attribute action-contentScriptType_ = attr "contentScriptType"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/contentStyleType>-contentStyleType_ ::  MisoString -> Attribute action-contentStyleType_ = attr "contentStyleType"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/cx>-cx_ ::  MisoString -> Attribute action-cx_ = attr "cx"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/cy>-cy_ ::  MisoString -> Attribute action-cy_ = attr "cy"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d>-d_ ::  MisoString -> Attribute action-d_ = attr "d"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/decelerate>-decelerate_ ::  MisoString -> Attribute action-decelerate_ = attr "decelerate"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/descent>-descent_ ::  MisoString -> Attribute action-descent_ = attr "descent"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/diffuseConstant>-diffuseConstant_ ::  MisoString -> Attribute action-diffuseConstant_ = attr "diffuseConstant"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/divisor>-divisor_ ::  MisoString -> Attribute action-divisor_ = attr "divisor"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/dur>-dur_ ::  MisoString -> Attribute action-dur_ = attr "dur"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/dx>-dx_ ::  MisoString -> Attribute action-dx_ = attr "dx"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/dy>-dy_ ::  MisoString -> Attribute action-dy_ = attr "dy"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/edgeMode>-edgeMode_ ::  MisoString -> Attribute action-edgeMode_ = attr "edgeMode"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/elevation>-elevation_ ::  MisoString -> Attribute action-elevation_ = attr "elevation"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/end>-end_ ::  MisoString -> Attribute action-end_ = attr "end"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/exponent>-exponent_ ::  MisoString -> Attribute action-exponent_ = attr "exponent"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/externalResourcesRequired>-externalResourcesRequired_ ::  MisoString -> Attribute action-externalResourcesRequired_ = attr "externalResourcesRequired"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/filterRes>-filterRes_ ::  MisoString -> Attribute action-filterRes_ = attr "filterRes"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/filterUnits>-filterUnits_ ::  MisoString -> Attribute action-filterUnits_ = attr "filterUnits"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/format>-format_ ::  MisoString -> Attribute action-format_ = attr "format"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/from>-from_ ::  MisoString -> Attribute action-from_ = attr "from"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fx>-fx_ ::  MisoString -> Attribute action-fx_ = attr "fx"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fy>-fy_ ::  MisoString -> Attribute action-fy_ = attr "fy"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/g1>-g1_ ::  MisoString -> Attribute action-g1_ = attr "g1"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/g2>-g2_ ::  MisoString -> Attribute action-g2_ = attr "g2"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/glyph-name>-glyphName_ ::  MisoString -> Attribute action-glyphName_ = attr "glyph-name"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/glyphRef>-glyphRef_ ::  MisoString -> Attribute action-glyphRef_ = attr "glyphRef"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/gradientTransform>-gradientTransform_ ::  MisoString -> Attribute action-gradientTransform_ = attr "gradientTransform"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/gradientUnits>-gradientUnits_ ::  MisoString -> Attribute action-gradientUnits_ = attr "gradientUnits"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/hanging>-hanging_ ::  MisoString -> Attribute action-hanging_ = attr "hanging"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/height>-height_ ::  MisoString -> Attribute action-height_ = attr "height"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/horiz-adv-x>-horizAdvX_ ::  MisoString -> Attribute action-horizAdvX_ = attr "horiz-adv-x"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/horiz-origin-x>-horizOriginX_ ::  MisoString -> Attribute action-horizOriginX_ = attr "horiz-origin-x"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/horiz-origin-y>-horizOriginY_ ::  MisoString -> Attribute action-horizOriginY_ = attr "horiz-origin-y"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/id>-id_ ::  MisoString -> Attribute action-id_ = attr "id"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/ideographic>-ideographic_ ::  MisoString -> Attribute action-ideographic_ = attr "ideographic"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/in>-in_' ::  MisoString -> Attribute action-in_' = attr "in"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/in2>-in2_ ::  MisoString -> Attribute action-in2_ = attr "in2"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/intercept>-intercept_ ::  MisoString -> Attribute action-intercept_ = attr "intercept"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/k>-k_ ::  MisoString -> Attribute action-k_ = attr "k"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/k1>-k1_ ::  MisoString -> Attribute action-k1_ = attr "k1"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/k2>-k2_ ::  MisoString -> Attribute action-k2_ = attr "k2"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/k3>-k3_ ::  MisoString -> Attribute action-k3_ = attr "k3"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/k4>-k4_ ::  MisoString -> Attribute action-k4_ = attr "k4"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/kernelMatrix>-kernelMatrix_ ::  MisoString -> Attribute action-kernelMatrix_ = attr "kernelMatrix"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/kernelUnitLength>-kernelUnitLength_ ::  MisoString -> Attribute action-kernelUnitLength_ = attr "kernelUnitLength"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/keyPoints>-keyPoints_ ::  MisoString -> Attribute action-keyPoints_ = attr "keyPoints"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/keySplines>-keySplines_ ::  MisoString -> Attribute action-keySplines_ = attr "keySplines"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/keyTimes>-keyTimes_ ::  MisoString -> Attribute action-keyTimes_ = attr "keyTimes"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/lang>-lang_ ::  MisoString -> Attribute action-lang_ = attr "lang"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/lengthAdjust>-lengthAdjust_ ::  MisoString -> Attribute action-lengthAdjust_ = attr "lengthAdjust"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/limitingConeAngle>-limitingConeAngle_ ::  MisoString -> Attribute action-limitingConeAngle_ = attr "limitingConeAngle"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/local>-local_ ::  MisoString -> Attribute action-local_ = attr "local"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/markerHeight>-markerHeight_ ::  MisoString -> Attribute action-markerHeight_ = attr "markerHeight"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/markerUnits>-markerUnits_ ::  MisoString -> Attribute action-markerUnits_ = attr "markerUnits"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/markerWidth>-markerWidth_ ::  MisoString -> Attribute action-markerWidth_ = attr "markerWidth"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/maskContentUnits>-maskContentUnits_ ::  MisoString -> Attribute action-maskContentUnits_ = attr "maskContentUnits"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/maskUnits>-maskUnits_ ::  MisoString -> Attribute action-maskUnits_ = attr "maskUnits"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/mathematical>-mathematical_ ::  MisoString -> Attribute action-mathematical_ = attr "mathematical"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/max>-max_ ::  MisoString -> Attribute action-max_ = attr "max"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/media>-media_ ::  MisoString -> Attribute action-media_ = attr "media"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/method>-method_ ::  MisoString -> Attribute action-method_ = attr "method"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/min>-min_ ::  MisoString -> Attribute action-min_ = attr "min"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/mode>-mode_ ::  MisoString -> Attribute action-mode_ = attr "mode"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/name>-name_ ::  MisoString -> Attribute action-name_ = attr "name"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/numOctaves>-numOctaves_ ::  MisoString -> Attribute action-numOctaves_ = attr "numOctaves"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/offset>-offset_ ::  MisoString -> Attribute action-offset_ = attr "offset"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/operator>-operator_ ::  MisoString -> Attribute action-operator_ = attr "operator"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/order>-order_ ::  MisoString -> Attribute action-order_ = attr "order"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/orient>-orient_ ::  MisoString -> Attribute action-orient_ = attr "orient"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/orientation>-orientation_ ::  MisoString -> Attribute action-orientation_ = attr "orientation"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/origin>-origin_ ::  MisoString -> Attribute action-origin_ = attr "origin"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/overline-position>-overlinePosition_ ::  MisoString -> Attribute action-overlinePosition_ = attr "overline-position"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/overline-thickness>-overlineThickness_ ::  MisoString -> Attribute action-overlineThickness_ = attr "overline-thickness"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/panose-1>-panose1_ ::  MisoString -> Attribute action-panose1_ = attr "panose-1"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/path>-path_ ::  MisoString -> Attribute action-path_ = attr "path"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/pathLength>-pathLength_ ::  MisoString -> Attribute action-pathLength_ = attr "pathLength"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/patternContentUnits>-patternContentUnits_ ::  MisoString -> Attribute action-patternContentUnits_ = attr "patternContentUnits"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/patternTransform>-patternTransform_ ::  MisoString -> Attribute action-patternTransform_ = attr "patternTransform"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/patternUnits>-patternUnits_ ::  MisoString -> Attribute action-patternUnits_ = attr "patternUnits"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/point-order>-pointOrder_ ::  MisoString -> Attribute action-pointOrder_ = attr "point-order"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/points>-points_ ::  MisoString -> Attribute action-points_ = attr "points"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/pointsAtX>-pointsAtX_ ::  MisoString -> Attribute action-pointsAtX_ = attr "pointsAtX"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/pointsAtY>-pointsAtY_ ::  MisoString -> Attribute action-pointsAtY_ = attr "pointsAtY"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/pointsAtZ>-pointsAtZ_ ::  MisoString -> Attribute action-pointsAtZ_ = attr "pointsAtZ"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/preserveAlpha>-preserveAlpha_ ::  MisoString -> Attribute action-preserveAlpha_ = attr "preserveAlpha"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/preserveAspectRatio>-preserveAspectRatio_ ::  MisoString -> Attribute action-preserveAspectRatio_ = attr "preserveAspectRatio"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/primitiveUnits>-primitiveUnits_ ::  MisoString -> Attribute action-primitiveUnits_ = attr "primitiveUnits"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/r>-r_ ::  MisoString -> Attribute action-r_ = attr "r"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/radius>-radius_ ::  MisoString -> Attribute action-radius_ = attr "radius"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/refX>-refX_ ::  MisoString -> Attribute action-refX_ = attr "refX"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/refY>-refY_ ::  MisoString -> Attribute action-refY_ = attr "refY"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/rendering-intent>-renderingIntent_ ::  MisoString -> Attribute action-renderingIntent_ = attr "rendering-intent"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/repeatCount>-repeatCount_ ::  MisoString -> Attribute action-repeatCount_ = attr "repeatCount"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/repeatDur>-repeatDur_ ::  MisoString -> Attribute action-repeatDur_ = attr "repeatDur"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/requiredExtensions>-requiredExtensions_ ::  MisoString -> Attribute action-requiredExtensions_ = attr "requiredExtensions"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/requiredFeatures>-requiredFeatures_ ::  MisoString -> Attribute action-requiredFeatures_ = attr "requiredFeatures"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/restart>-restart_ ::  MisoString -> Attribute action-restart_ = attr "restart"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/result>-result_ ::  MisoString -> Attribute action-result_ = attr "result"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/rotate>-rotate_ ::  MisoString -> Attribute action-rotate_ = attr "rotate"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/rx>-rx_ ::  MisoString -> Attribute action-rx_ = attr "rx"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/ry>-ry_ ::  MisoString -> Attribute action-ry_ = attr "ry"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/scale>-scale_ ::  MisoString -> Attribute action-scale_ = attr "scale"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/seed>-seed_ ::  MisoString -> Attribute action-seed_ = attr "seed"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/slope>-slope_ ::  MisoString -> Attribute action-slope_ = attr "slope"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/spacing>-spacing_ ::  MisoString -> Attribute action-spacing_ = attr "spacing"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/specularConstant>-specularConstant_ ::  MisoString -> Attribute action-specularConstant_ = attr "specularConstant"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/specularExponent>-specularExponent_ ::  MisoString -> Attribute action-specularExponent_ = attr "specularExponent"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/speed>-speed_ ::  MisoString -> Attribute action-speed_ = attr "speed"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/spreadMethod>-spreadMethod_ ::  MisoString -> Attribute action-spreadMethod_ = attr "spreadMethod"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/startOffset>-startOffset_ ::  MisoString -> Attribute action-startOffset_ = attr "startOffset"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stdDeviation>-stdDeviation_ ::  MisoString -> Attribute action-stdDeviation_ = attr "stdDeviation"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stemh>-stemh_ ::  MisoString -> Attribute action-stemh_ = attr "stemh"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stemv>-stemv_ ::  MisoString -> Attribute action-stemv_ = attr "stemv"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stitchTiles>-stitchTiles_ ::  MisoString -> Attribute action-stitchTiles_ = attr "stitchTiles"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/strikethrough-position>-strikethroughPosition_ ::  MisoString -> Attribute action-strikethroughPosition_ = attr "strikethrough-position"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/strikethrough-thickness>-strikethroughThickness_ ::  MisoString -> Attribute action-strikethroughThickness_ = attr "strikethrough-thickness"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/string>-string_ ::  MisoString -> Attribute action-string_ = attr "string"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/style>-style_ ::  MisoString -> Attribute action-style_ = attr "style"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/surfaceScale>-surfaceScale_ ::  MisoString -> Attribute action-surfaceScale_ = attr "surfaceScale"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/systemLanguage>-systemLanguage_ ::  MisoString -> Attribute action-systemLanguage_ = attr "systemLanguage"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/tableValues>-tableValues_ ::  MisoString -> Attribute action-tableValues_ = attr "tableValues"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/target>-target_ ::  MisoString -> Attribute action-target_ = attr "target"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/targetX>-targetX_ ::  MisoString -> Attribute action-targetX_ = attr "targetX"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/targetY>-targetY_ ::  MisoString -> Attribute action-targetY_ = attr "targetY"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/textLength>-textLength_ ::  MisoString -> Attribute action-textLength_ = attr "textLength"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/title>-title_ ::  MisoString -> Attribute action-title_ = attr "title"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/to>-to_ ::  MisoString -> Attribute action-to_ = attr "to"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/transform>-transform_ ::  MisoString -> Attribute action-transform_ = attr "transform"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/type>-type_' ::  MisoString -> Attribute action-type_' = attr "type"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/u1>-u1_ ::  MisoString -> Attribute action-u1_ = attr "u1"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/u2>-u2_ ::  MisoString -> Attribute action-u2_ = attr "u2"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/underline-position>-underlinePosition_ ::  MisoString -> Attribute action-underlinePosition_ = attr "underline-position"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/underline-thickness>-underlineThickness_ ::  MisoString -> Attribute action-underlineThickness_ = attr "underline-thickness"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/unicode>-unicode_ ::  MisoString -> Attribute action-unicode_ = attr "unicode"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/unicode-range>-unicodeRange_ ::  MisoString -> Attribute action-unicodeRange_ = attr "unicode-range"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/units-per-em>-unitsPerEm_ ::  MisoString -> Attribute action-unitsPerEm_ = attr "units-per-em"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/v-alphabetic>-vAlphabetic_ ::  MisoString -> Attribute action-vAlphabetic_ = attr "v-alphabetic"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/v-hanging>-vHanging_ ::  MisoString -> Attribute action-vHanging_ = attr "v-hanging"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/v-ideographic>-vIdeographic_ ::  MisoString -> Attribute action-vIdeographic_ = attr "v-ideographic"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/v-mathematical>-vMathematical_ ::  MisoString -> Attribute action-vMathematical_ = attr "v-mathematical"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/values>-values_ ::  MisoString -> Attribute action-values_ = attr "values"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/version>-version_ ::  MisoString -> Attribute action-version_ = attr "version"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/vert-adv-y>-vertAdvY_ ::  MisoString -> Attribute action-vertAdvY_ = attr "vert-adv-y"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/vert-origin-x>-vertOriginX_ ::  MisoString -> Attribute action-vertOriginX_ = attr "vert-origin-x"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/vert-origin-y>-vertOriginY_ ::  MisoString -> Attribute action-vertOriginY_ = attr "vert-origin-y"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/viewBox>-viewBox_ ::  MisoString -> Attribute action-viewBox_ = attr "viewBox"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/viewTarget>-viewTarget_ ::  MisoString -> Attribute action-viewTarget_ = attr "viewTarget"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/width>-width_ ::  MisoString -> Attribute action-width_ = attr "width"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/widths>-widths_ ::  MisoString -> Attribute action-widths_ = attr "widths"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/x>-x_ ::  MisoString -> Attribute action-x_ = attr "x"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/x-height>-xHeight_ ::  MisoString -> Attribute action-xHeight_ = attr "x-height"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/x1>-x1_ ::  MisoString -> Attribute action-x1_ = attr "x1"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/x2>-x2_ ::  MisoString -> Attribute action-x2_ = attr "x2"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/xChannelSelector>-xChannelSelector_ ::  MisoString -> Attribute action-xChannelSelector_ = attr "x-channel-selector"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/xlinkActuate>-xlinkActuate_ ::  MisoString -> Attribute action-xlinkActuate_ = attr "xlinkActuate"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/xlinkArcrole>-xlinkArcrole_ ::  MisoString -> Attribute action-xlinkArcrole_ = attr "xlinkArcrole"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/xlinkHref>-xlinkHref_ ::  MisoString -> Attribute action-xlinkHref_ = attr "xlinkHref"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/xlinkRole>-xlinkRole_ ::  MisoString -> Attribute action-xlinkRole_ = attr "xlinkRole"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/xlinkShow>-xlinkShow_ ::  MisoString -> Attribute action-xlinkShow_ = attr "xlinkShow"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/xlinkTitle>-xlinkTitle_ ::  MisoString -> Attribute action-xlinkTitle_ = attr "xlinkTitle"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/xlinkType>-xlinkType_ ::  MisoString -> Attribute action-xlinkType_ = attr "xlinkType"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/xmlBase>-xmlBase_ ::  MisoString -> Attribute action-xmlBase_ = attr "xmlBase"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/xmlLang>-xmlLang_ ::  MisoString -> Attribute action-xmlLang_ = attr "xmlLang"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/xmlSpace>-xmlSpace_ ::  MisoString -> Attribute action-xmlSpace_ = attr "xmlSpace"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/y>-y_ ::  MisoString -> Attribute action-y_ = attr "y"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/y1>-y1_ ::  MisoString -> Attribute action-y1_ = attr "y1"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/y2>-y2_ ::  MisoString -> Attribute action-y2_ = attr "y2"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/yChannelSelector>-yChannelSelector_ ::  MisoString -> Attribute action-yChannelSelector_ = attr "yChannelSelector"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/z>-z_ ::  MisoString -> Attribute action-z_ = attr "z"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/zoomAndPan>-zoomAndPan_ ::  MisoString -> Attribute action-zoomAndPan_ = attr "zoomAndPan"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/alignment-baseline>-alignmentBaseline_ ::  MisoString -> Attribute action-alignmentBaseline_ = attr "alignment-baseline"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/baseline-shift>-baselineShift_ ::  MisoString -> Attribute action-baselineShift_ = attr "baseline-shift"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/clip-path>-clipPath_ ::  MisoString -> Attribute action-clipPath_ = attr "clip-path"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/clip-rule>-clipRule_ ::  MisoString -> Attribute action-clipRule_ = attr "clip-rule"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/clip>-clip_ ::  MisoString -> Attribute action-clip_ = attr "clip"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/color-interpolation-filters>-colorInterpolationFilters_ ::  MisoString -> Attribute action-colorInterpolationFilters_ = attr "color-interpolation-filters"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/color-interpolation>-colorInterpolation_ ::  MisoString -> Attribute action-colorInterpolation_ = attr "color-interpolation"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/color-profile>-colorProfile_ ::  MisoString -> Attribute action-colorProfile_ = attr "color-profile"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/color-rendering>-colorRendering_ ::  MisoString -> Attribute action-colorRendering_ = attr "color-rendering"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/color>-color_ ::  MisoString -> Attribute action-color_ = attr "color"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/cursor>-cursor_ ::  MisoString -> Attribute action-cursor_ = attr "cursor"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/direction>-direction_ ::  MisoString -> Attribute action-direction_ = attr "direction"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/display>-display_ ::  MisoString -> Attribute action-display_ = attr "display"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/dominant-baseline>-dominantBaseline_ ::  MisoString -> Attribute action-dominantBaseline_ = attr "dominant-baseline"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/enable-background>-enableBackground_ ::  MisoString -> Attribute action-enableBackground_ = attr "enable-background"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill-opacity>-fillOpacity_ ::  MisoString -> Attribute action-fillOpacity_ = attr "fill-opacity"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill-rule>-fillRule_ ::  MisoString -> Attribute action-fillRule_ = attr "fill-rule"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>-fill_ ::  MisoString -> Attribute action-fill_ = attr "fill"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/filter>-filter_ ::  MisoString -> Attribute action-filter_ = attr "filter"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/flood-color>-floodColor_ ::  MisoString -> Attribute action-floodColor_ = attr "flood-color"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/flood-opacity>-floodOpacity_ ::  MisoString -> Attribute action-floodOpacity_ = attr "flood-opacity"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/font-family>-fontFamily_ ::  MisoString -> Attribute action-fontFamily_ = attr "font-family"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/font-size-adjust>-fontSizeAdjust_ ::  MisoString -> Attribute action-fontSizeAdjust_ = attr "font-size-adjust"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/font-size>-fontSize_ ::  MisoString -> Attribute action-fontSize_ = attr "font-size"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/font-stretch>-fontStretch_ ::  MisoString -> Attribute action-fontStretch_ = attr "font-stretch"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/font-style>-fontStyle_ ::  MisoString -> Attribute action-fontStyle_ = attr "font-style"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/font-variant>-fontVariant_ ::  MisoString -> Attribute action-fontVariant_ = attr "font-variant"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/font-weight>-fontWeight_ ::  MisoString -> Attribute action-fontWeight_ = attr "font-weight"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/glyph-orientation-horizontal>-glyphOrientationHorizontal_ ::  MisoString -> Attribute action-glyphOrientationHorizontal_ = attr "glyph-orientation-horizontal"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/glyph-orientation-vertical>-glyphOrientationVertical_ ::  MisoString -> Attribute action-glyphOrientationVertical_ = attr "glyph-orientation-vertical"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/image-rendering>-imageRendering_ ::  MisoString -> Attribute action-imageRendering_ = attr "image-rendering"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/kerning>-kerning_ ::  MisoString -> Attribute action-kerning_ = attr "kerning"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/letter-spacing>-letterSpacing_ ::  MisoString -> Attribute action-letterSpacing_ = attr "letter-spacing"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/lighting-color>-lightingColor_ ::  MisoString -> Attribute action-lightingColor_ = attr "lighting-color"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/marker-end>-markerEnd_ ::  MisoString -> Attribute action-markerEnd_ = attr "marker-end"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/marker-mid>-markerMid_ ::  MisoString -> Attribute action-markerMid_ = attr "marker-mid"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/marker-start>-markerStart_ ::  MisoString -> Attribute action-markerStart_ = attr "marker-start"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/mask>-mask_ ::  MisoString -> Attribute action-mask_ = attr "mask"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/opacity>-opacity_ ::  MisoString -> Attribute action-opacity_ = attr "opacity"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/overflow>-overflow_ ::  MisoString -> Attribute action-overflow_ = attr "overflow"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/pointer-events>-pointerEvents_ ::  MisoString -> Attribute action-pointerEvents_ = attr "pointer-events"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/shape-rendering>-shapeRendering_ ::  MisoString -> Attribute action-shapeRendering_ = attr "shape-rendering"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stop-color>-stopColor_ ::  MisoString -> Attribute action-stopColor_ = attr "stop-color"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stop-opacity>-stopOpacity_ ::  MisoString -> Attribute action-stopOpacity_ = attr "stop-opacity"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-dasharray>-strokeDasharray_ ::  MisoString -> Attribute action-strokeDasharray_ = attr "stroke-dasharray"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-dashoffset>-strokeDashoffset_ ::  MisoString -> Attribute action-strokeDashoffset_ = attr "stroke-dashoffset"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-linecap>-strokeLinecap_ ::  MisoString -> Attribute action-strokeLinecap_ = attr "stroke-linecap"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-linejoin>-strokeLinejoin_ ::  MisoString -> Attribute action-strokeLinejoin_ = attr "stroke-linejoin"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-miterlimit>-strokeMiterlimit_ ::  MisoString -> Attribute action-strokeMiterlimit_ = attr "stroke-miterlimit"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-opacity>-strokeOpacity_ ::  MisoString -> Attribute action-strokeOpacity_ = attr "stroke-opacity"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-width>-strokeWidth_ ::  MisoString -> Attribute action-strokeWidth_ = attr "stroke-width"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>-stroke_ ::  MisoString -> Attribute action-stroke_ = attr "stroke"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/text-anchor>-textAnchor_ ::  MisoString -> Attribute action-textAnchor_ = attr "text-anchor"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/text-decoration>-textDecoration_ ::  MisoString -> Attribute action-textDecoration_ = attr "text-decoration"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/text-rendering>-textRendering_ ::  MisoString -> Attribute action-textRendering_ = attr "text-rendering"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/unicode-bidi>-unicodeBidi_ ::  MisoString -> Attribute action-unicodeBidi_ = attr "unicode-bidi"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/visibility>-visibility_ ::  MisoString -> Attribute action-visibility_ = attr "visibility"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/word-spacing>-wordSpacing_ ::  MisoString -> Attribute action-wordSpacing_ = attr "word-spacing"--- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/writing-mode>-writingMode_ ::  MisoString -> Attribute action-writingMode_ = attr "writing-mode"
src/Miso/Svg/Element.hs view
@@ -1,19 +1,88 @@+----------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoImplicitPrelude #-} ----------------------------------------------------------------------------- -- | -- Module      :  Miso.Svg.Element--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- Stability   :  experimental -- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Svg.Element" provides smart constructors for every element in the+-- <https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element SVG>+-- 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-  ( -- * HTML Embedding+  ( -- *** SVG     svg_-  , foreignObject_-    -- * Graphics Elements+    -- *** Graphics   , circle_   , ellipse_   , image_@@ -23,51 +92,33 @@   , polyline_   , rect_   , use_-  -- * Animation Elements+  -- *** Animation   , animate_-  , animateColor_   , animateMotion_   , animateTransform_   , mpath_   , set_-  -- * Descriptive Elements+  -- *** Descriptive   , desc_   , metadata_   , title_-  -- * Containers-  , a_+  -- *** Containers   , defs_   , g_   , marker_   , mask_-  , missingGlyph_   , pattern_   , switch_   , symbol_-  -- * Text-  , altGlyph_-  , altGlyphDef_-  , altGlyphItem_-  , glyph_-  , glyphRef_+  -- *** Text   , textPath_   , text_-  , tref_   , tspan_-  -- * Fonts-  , font_-  , fontFace_-  , fontFaceFormat_-  , fontFaceName_-  , fontFaceSrc_-  , fontFaceUri_-  , hkern_-  , vkern_-  -- * Gradients+  -- *** Gradients   , linearGradient_   , radialGradient_   , stop_-  -- * Filters+  -- *** Filters   , feBlend_   , feColorMatrix_   , feComponentTransfer_@@ -75,6 +126,7 @@   , feConvolveMatrix_   , feDiffuseLighting_   , feDisplacementMap_+  , feDropShadow_   , feFlood_   , feFuncA_   , feFuncB_@@ -84,352 +136,282 @@   , feImage_   , feMerge_   , feMergeNode_-  , feMorhpology_+  , feMorphology_   , feOffset_   , feSpecularLighting_   , feTile_   , feTurbulence_-  -- * Light source elements+  -- *** Light source   , feDistantLight_   , fePointLight_   , feSpotLight_-  -- * Miscellaneous+  -- *** Misc.+  , foreignObject_   , clipPath_-  , colorProfile_-  , cursor_   , filter_   , script_   , style_   , view_   ) where--import           Miso.Html.Internal hiding (style_)-import           Miso.String        (MisoString)-import qualified Prelude            as P---- | Used to construct a `VNode` with namespace "svg"+-----------------------------------------------------------------------------+import           Miso.Types  hiding (text_)+-----------------------------------------------------------------------------+-- | Used to construct a @VNode@ with namespace *"svg"* -- -- > document.createElementNS('http://www.w3.org/2000/svg', 'circle'); ---nodeSvg_ :: MisoString -> [Attribute action] -> [View action] -> View action-nodeSvg_ = P.flip (node SVG) P.Nothing---- | Creates an svg tag-svg_ :: [Attribute action] -> [View action] -> View action-svg_ = nodeSvg_ "svg"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/foreignObject>-foreignObject_ :: [Attribute action] -> [View action] -> View action-foreignObject_ = nodeSvg_ "foreignObject"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/circle>-circle_ :: [Attribute action] -> [View action] -> View action-circle_ = nodeSvg_ "circle"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/ellipse>-ellipse_ :: [Attribute action] -> [View action] -> View action-ellipse_ = nodeSvg_ "ellipse"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/image>-image_ :: [Attribute action] -> [View action] -> View action-image_ = nodeSvg_ "image"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/line>-line_ :: [Attribute action] -> [View action] -> View action-line_ = nodeSvg_ "line"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/path>-path_ :: [Attribute action] -> [View action] -> View action-path_ = nodeSvg_ "path"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/polygon>-polygon_ :: [Attribute action] -> [View action] -> View action-polygon_ = nodeSvg_ "polygon"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/polyline>-polyline_ :: [Attribute action] -> [View action] -> View action-polyline_ = nodeSvg_ "polyline"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/rect>-rect_ :: [Attribute action] -> [View action] -> View action-rect_ = nodeSvg_ "rect"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/use>-use_ :: [Attribute action] -> [View action] -> View action-use_ = nodeSvg_ "use"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/animate>-animate_ :: [Attribute action] -> [View action] -> View action-animate_ = nodeSvg_ "animate"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/animateColor>-animateColor_ :: [Attribute action] -> [View action] -> View action-animateColor_ = nodeSvg_ "animateColor"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/animateMotion>-animateMotion_ :: [Attribute action] -> [View action] -> View action-animateMotion_ = nodeSvg_ "animateMotion"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/animateTransform>-animateTransform_ :: [Attribute action] -> [View action] -> View action-animateTransform_ = nodeSvg_ "animateTransform"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/mpath>-mpath_ :: [Attribute action] -> [View action] -> View action-mpath_ = nodeSvg_ "mpath"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/set>-set_ :: [Attribute action] -> [View action] -> View action-set_ = nodeSvg_ "set"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/desc>-desc_ :: [Attribute action] -> [View action] -> View action-desc_ = nodeSvg_ "desc"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/metadata>-metadata_ :: [Attribute action] -> [View action] -> View action-metadata_ = nodeSvg_ "metadata"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/title>-title_ :: [Attribute action] -> [View action] -> View action-title_ = nodeSvg_ "title"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/a>-a_ :: [Attribute action] -> [View action] -> View action-a_ = nodeSvg_ "a"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/defs>-defs_ :: [Attribute action] -> [View action] -> View action-defs_ = nodeSvg_ "defs"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/g>-g_ :: [Attribute action] -> [View action] -> View action-g_ = nodeSvg_ "g"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/marker>-marker_ :: [Attribute action] -> [View action] -> View action-marker_ = nodeSvg_ "marker"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/mask>-mask_ :: [Attribute action] -> [View action] -> View action-mask_ = nodeSvg_ "mask"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/missingGlyph>-missingGlyph_ :: [Attribute action] -> [View action] -> View action-missingGlyph_ = nodeSvg_ "missingGlyph"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/pattern>-pattern_ :: [Attribute action] -> [View action] -> View action-pattern_ = nodeSvg_ "pattern"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/switch>-switch_ :: [Attribute action] -> [View action] -> View action-switch_ = nodeSvg_ "switch"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/symbol>-symbol_ :: [Attribute action] -> [View action] -> View action-symbol_ = nodeSvg_ "symbol"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/altGlyph>-altGlyph_ :: [Attribute action] -> [View action] -> View action-altGlyph_ = nodeSvg_ "altGlyph"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/altGlyphDef>-altGlyphDef_ :: [Attribute action] -> [View action] -> View action-altGlyphDef_ = nodeSvg_ "altGlyphDef"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/altGlyphItem>-altGlyphItem_ :: [Attribute action] -> [View action] -> View action-altGlyphItem_ = nodeSvg_ "altGlyphItem"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/glyph>-glyph_ :: [Attribute action] -> [View action] -> View action-glyph_ = nodeSvg_ "glyph"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/glyphRef>-glyphRef_ :: [Attribute action] -> [View action] -> View action-glyphRef_ = nodeSvg_ "glyphRef"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/textPath>-textPath_ :: [Attribute action] -> [View action] -> View action-textPath_ = nodeSvg_ "textPath"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/text>-text_ :: [Attribute action] -> [View action] -> View action-text_ = nodeSvg_ "text"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/tref>-tref_ :: [Attribute action] -> [View action] -> View action-tref_ = nodeSvg_ "tref"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/tspan>-tspan_ :: [Attribute action] -> [View action] -> View action-tspan_ = nodeSvg_ "tspan"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/font>-font_ :: [Attribute action] -> [View action] -> View action-font_ = nodeSvg_ "font"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/font-face>-fontFace_ :: [Attribute action] -> [View action] -> View action-fontFace_ = nodeSvg_ "font-face"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/font-face-format>-fontFaceFormat_ :: [Attribute action] -> [View action] -> View action-fontFaceFormat_ = nodeSvg_ "font-face-format"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/font-face-name>-fontFaceName_ :: [Attribute action] -> [View action] -> View action-fontFaceName_ = nodeSvg_ "font-face-name"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/font-face-src>-fontFaceSrc_ :: [Attribute action] -> [View action] -> View action-fontFaceSrc_ = nodeSvg_ "font-face-src"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/font-face-uri>-fontFaceUri_ :: [Attribute action] -> [View action] -> View action-fontFaceUri_ = nodeSvg_ "font-face-uri"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/hkern>-hkern_ :: [Attribute action] -> [View action] -> View action-hkern_ = nodeSvg_ "hkern"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/vkern>-vkern_ :: [Attribute action] -> [View action] -> View action-vkern_ = nodeSvg_ "vkern"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/linearGradient>-linearGradient_ :: [Attribute action] -> [View action] -> View action-linearGradient_ = nodeSvg_ "linearGradient"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/radialGradient>-radialGradient_ :: [Attribute action] -> [View action] -> View action-radialGradient_ = nodeSvg_ "radialGradient"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/stop>-stop_ :: [Attribute action] -> [View action] -> View action-stop_ = nodeSvg_ "stop"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feBlend>-feBlend_ :: [Attribute action] -> [View action] -> View action-feBlend_ = nodeSvg_ "feBlend"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feColorMatrix>-feColorMatrix_ :: [Attribute action] -> [View action] -> View action-feColorMatrix_ = nodeSvg_ "feColorMatrix"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feComponentTransfer>-feComponentTransfer_ :: [Attribute action] -> [View action] -> View action-feComponentTransfer_ = nodeSvg_ "feComponentTransfer"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feComposite>-feComposite_ :: [Attribute action] -> [View action] -> View action-feComposite_ = nodeSvg_ "feComposite"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feConvolveMatrix>-feConvolveMatrix_ :: [Attribute action] -> [View action] -> View action-feConvolveMatrix_ = nodeSvg_ "feConvolveMatrix"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feDiffuseLighting>-feDiffuseLighting_ :: [Attribute action] -> [View action] -> View action-feDiffuseLighting_ = nodeSvg_ "feDiffuseLighting"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feDisplacementMap>-feDisplacementMap_ :: [Attribute action] -> [View action] -> View action-feDisplacementMap_ = nodeSvg_ "feDisplacementMap"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feFlood>-feFlood_ :: [Attribute action] -> [View action] -> View action-feFlood_ = nodeSvg_ "feFlood"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feFuncA>-feFuncA_ :: [Attribute action] -> [View action] -> View action-feFuncA_ = nodeSvg_ "feFuncA"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feFuncB>-feFuncB_ :: [Attribute action] -> [View action] -> View action-feFuncB_ = nodeSvg_ "feFuncB"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feFuncG>-feFuncG_ :: [Attribute action] -> [View action] -> View action-feFuncG_ = nodeSvg_ "feFuncG"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feFuncR>-feFuncR_ :: [Attribute action] -> [View action] -> View action-feFuncR_ = nodeSvg_ "feFuncR"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feGaussianBlur>-feGaussianBlur_ :: [Attribute action] -> [View action] -> View action-feGaussianBlur_ = nodeSvg_ "feGaussianBlur"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feImage>-feImage_ :: [Attribute action] -> [View action] -> View action-feImage_ = nodeSvg_ "feImage"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feMerge>-feMerge_ :: [Attribute action] -> [View action] -> View action-feMerge_ = nodeSvg_ "feMerge"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feMergeNode>-feMergeNode_ :: [Attribute action] -> [View action] -> View action-feMergeNode_ = nodeSvg_ "feMergeNode"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feMorhpology>-feMorhpology_ :: [Attribute action] -> [View action] -> View action-feMorhpology_ = nodeSvg_ "feMorhpology"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feOffset>-feOffset_ :: [Attribute action] -> [View action] -> View action-feOffset_ = nodeSvg_ "feOffset"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feSpecularLighting>-feSpecularLighting_ :: [Attribute action] -> [View action] -> View action-feSpecularLighting_ = nodeSvg_ "feSpecularLighting"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feTile>-feTile_ :: [Attribute action] -> [View action] -> View action-feTile_ = nodeSvg_ "feTile"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feTurbulence>-feTurbulence_ :: [Attribute action] -> [View action] -> View action-feTurbulence_ = nodeSvg_ "feTurbulence"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feDistantLight>-feDistantLight_ :: [Attribute action] -> [View action] -> View action-feDistantLight_ = nodeSvg_ "feDistantLight"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/fePointLight>-fePointLight_ :: [Attribute action] -> [View action] -> View action-fePointLight_ = nodeSvg_ "fePointLight"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/feSpotLight>-feSpotLight_ :: [Attribute action] -> [View action] -> View action-feSpotLight_ = nodeSvg_ "feSpotLight"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/clipPath>-clipPath_ :: [Attribute action] -> [View action] -> View action-clipPath_ = nodeSvg_ "clipPath"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/color-profile>-colorProfile_ :: [Attribute action] -> [View action] -> View action-colorProfile_ = nodeSvg_ "color-profile"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/cursor>-cursor_ :: [Attribute action] -> [View action] -> View action-cursor_ = nodeSvg_ "cursor"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/filter>-filter_ :: [Attribute action] -> [View action] -> View action-filter_ = nodeSvg_ "filter"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/script>-script_ :: [Attribute action] -> [View action] -> View action-script_ = nodeSvg_ "script"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/style>-style_ :: [Attribute action] -> [View action] -> View action-style_ = nodeSvg_ "style"---- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/view>-view_ :: [Attribute action] -> [View action] -> View action-view_ = nodeSvg_ "view"+nodeSvg :: MisoString -> [Attribute action] -> [View model action] -> View model action+nodeSvg nodeName = node SVG nodeName+-----------------------------------------------------------------------------+-- | [\<svg\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/svg)+svg_ :: [Attribute action] -> [View model action] -> View model action+svg_ = nodeSvg "svg"+-----------------------------------------------------------------------------+-- | [\<foreignObject\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/foreignObject)+foreignObject_ :: [Attribute action] -> [View model action] -> View model action+foreignObject_ = nodeSvg "foreignObject"+-----------------------------------------------------------------------------+-- | [\<circle\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/circle)+circle_ :: [Attribute action] -> View model action+circle_ = flip (nodeSvg "circle") []+-----------------------------------------------------------------------------+-- | [\<ellipse\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/ellipse)+ellipse_ :: [Attribute action] -> View model action+ellipse_ = flip (nodeSvg "ellipse") []+-----------------------------------------------------------------------------+-- | [\<image\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/image)+image_ :: [Attribute action] -> View model action+image_ = flip (nodeSvg "image") []+-----------------------------------------------------------------------------+-- | [\<line\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/line)+line_ :: [Attribute action] -> View model action+line_ = flip (nodeSvg "line") []+-----------------------------------------------------------------------------+-- | [\<path\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/path)+path_ :: [Attribute action] -> View model action+path_ = flip (nodeSvg "path") []+-----------------------------------------------------------------------------+-- | [\<polygon\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/polygon)+polygon_ :: [Attribute action] -> View model action+polygon_ = flip (nodeSvg "polygon") []+-----------------------------------------------------------------------------+-- | [\<polyline\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/polyline)+polyline_ :: [Attribute action] -> View model action+polyline_ = flip (nodeSvg "polyline") []+-----------------------------------------------------------------------------+-- | [\<rect\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/rect)+rect_ :: [Attribute action] -> View model action+rect_ = flip (nodeSvg "rect") []+-----------------------------------------------------------------------------+-- | [\<use\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/use)+use_ :: [Attribute action] -> View model action+use_ = flip (nodeSvg "use") []+-----------------------------------------------------------------------------+-- | [\<animate\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/animate)+animate_ :: [Attribute action] -> View model action+animate_ = flip (nodeSvg "animate") []+-----------------------------------------------------------------------------+-- | [\<animateMotion\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/animateMotion)+animateMotion_ :: [Attribute action] -> View model action+animateMotion_ = flip (nodeSvg "animateMotion") []+-----------------------------------------------------------------------------+-- | [\<animateTransform\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/animateTransform)+animateTransform_ :: [Attribute action] -> View model action+animateTransform_ = flip (nodeSvg "animateTransform") []+-----------------------------------------------------------------------------+-- | [\<mpath\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/mpath)+mpath_ :: [Attribute action] -> View model action+mpath_ = flip (nodeSvg "mpath") []+-----------------------------------------------------------------------------+-- | [\<set\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/set)+set_ :: [Attribute action] -> View model action+set_ = flip (nodeSvg "set") []+-----------------------------------------------------------------------------+-- | [\<desc\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/desc)+desc_ :: [Attribute action] -> [View model action] -> View model action+desc_ = nodeSvg "desc"+-----------------------------------------------------------------------------+-- | [\<metadata\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/metadata)+metadata_ :: [Attribute action] -> [View model action] -> View model action+metadata_ = nodeSvg "metadata"+-----------------------------------------------------------------------------+-- | [\<title\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/title)+title_ :: [Attribute action] -> [View model action] -> View model action+title_ = nodeSvg "title"+-----------------------------------------------------------------------------+-- | [\<defs\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/defs)+defs_ :: [Attribute action] -> [View model action] -> View model action+defs_ = nodeSvg "defs"+-----------------------------------------------------------------------------+-- | [\<g\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/g)+g_ :: [Attribute action] -> [View model action] -> View model action+g_ = nodeSvg "g"+-----------------------------------------------------------------------------+-- | [\<marker\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/marker)+marker_ :: [Attribute action] -> [View model action] -> View model action+marker_ = nodeSvg "marker"+-----------------------------------------------------------------------------+-- | [\<mask\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/mask)+mask_ :: [Attribute action] -> [View model action] -> View model action+mask_ = nodeSvg "mask"+-----------------------------------------------------------------------------+-- | [\<pattern\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/pattern)+pattern_ :: [Attribute action] -> [View model action] -> View model action+pattern_ = nodeSvg "pattern"+-----------------------------------------------------------------------------+-- | [\<switch\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/switch)+switch_ :: [Attribute action] -> [View model action] -> View model action+switch_ = nodeSvg "switch"+-----------------------------------------------------------------------------+-- | [\<symbol\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/symbol)+symbol_ :: [Attribute action] -> [View model action] -> View model action+symbol_ = nodeSvg "symbol"+-----------------------------------------------------------------------------+-- | [\<textPath\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/textPath)+textPath_ :: [Attribute action] -> [View model action] -> View model action+textPath_ = nodeSvg "textPath"+-----------------------------------------------------------------------------+-- | [\<text\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/text)+text_ :: [Attribute action] -> [View model action] -> View model action+text_ = nodeSvg "text"+-----------------------------------------------------------------------------+-- | [\<tspan\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/tspan)+tspan_ :: [Attribute action] -> [View model action] -> View model action+tspan_ = nodeSvg "tspan"+-----------------------------------------------------------------------------+-- | [\<linearGradient\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/linearGradient)+linearGradient_ :: [Attribute action] -> [View model action] -> View model action+linearGradient_ = nodeSvg "linearGradient"+-----------------------------------------------------------------------------+-- | [\<radialGradient\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/radialGradient)+radialGradient_ :: [Attribute action] -> [View model action] -> View model action+radialGradient_ = nodeSvg "radialGradient"+-----------------------------------------------------------------------------+-- | [\<stop\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/stop)+stop_ :: [Attribute action] -> View model action+stop_ = flip (nodeSvg "stop") []+-----------------------------------------------------------------------------+-- | [\<feBlend\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feBlend)+feBlend_ :: [Attribute action] -> View model action+feBlend_ = flip (nodeSvg "feBlend") []+-----------------------------------------------------------------------------+-- | [\<feColorMatrix\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feColorMatrix)+feColorMatrix_ :: [Attribute action] -> View model action+feColorMatrix_ = flip (nodeSvg "feColorMatrix") []+-----------------------------------------------------------------------------+-- | [\<feComponentTransfer\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feComponentTransfer)+feComponentTransfer_ :: [Attribute action] -> [View model action] -> View model action+feComponentTransfer_ = nodeSvg "feComponentTransfer"+-----------------------------------------------------------------------------+-- | [\<feComposite\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feComposite)+feComposite_ :: [Attribute action] -> View model action+feComposite_ = flip (nodeSvg "feComposite") []+-----------------------------------------------------------------------------+-- | [\<feConvolveMatrix\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feConvolveMatrix)+feConvolveMatrix_ :: [Attribute action] -> View model action+feConvolveMatrix_ = flip (nodeSvg "feConvolveMatrix") []+-----------------------------------------------------------------------------+-- | [\<feDiffuseLighting\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feDiffuseLighting)+feDiffuseLighting_ :: [Attribute action] -> [View model action] -> View model action+feDiffuseLighting_ = nodeSvg "feDiffuseLighting"+-----------------------------------------------------------------------------+-- | [\<feDisplacementMap\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feDisplacementMap)+feDisplacementMap_ :: [Attribute action] -> View model action+feDisplacementMap_ = flip (nodeSvg "feDisplacementMap") []+-----------------------------------------------------------------------------+-- | [\<feDropShadow\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feDropShadow)+--+-- @since 1.9.0.0+feDropShadow_ :: [Attribute action] -> View model action+feDropShadow_ = flip (nodeSvg "feDropShadow") []+-----------------------------------------------------------------------------+-- | [\<feFlood\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feFlood)+feFlood_ :: [Attribute action] -> View model action+feFlood_ = flip (nodeSvg "feFlood") []+-----------------------------------------------------------------------------+-- | [\<feFuncA\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feFuncA)+feFuncA_ :: [Attribute action] -> [View model action] -> View model action+feFuncA_ = nodeSvg "feFuncA"+-----------------------------------------------------------------------------+-- | [\<feFuncB\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feFuncB)+feFuncB_ :: [Attribute action] -> [View model action] -> View model action+feFuncB_ = nodeSvg "feFuncB"+-----------------------------------------------------------------------------+-- | [\<feFuncG\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feFuncG)+feFuncG_ :: [Attribute action] -> [View model action] -> View model action+feFuncG_ = nodeSvg "feFuncG"+-----------------------------------------------------------------------------+-- | [\<feFuncR\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feFuncR)+feFuncR_ :: [Attribute action] -> [View model action] -> View model action+feFuncR_ = nodeSvg "feFuncR"+-----------------------------------------------------------------------------+-- | [\<feGaussianBlur\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feGaussianBlur)+feGaussianBlur_ :: [Attribute action] -> View model action+feGaussianBlur_ = flip (nodeSvg "feGaussianBlur") []+-----------------------------------------------------------------------------+-- | [\<feImage\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feImage)+feImage_ :: [Attribute action] -> View model action+feImage_ = flip (nodeSvg "feImage") []+-----------------------------------------------------------------------------+-- | [\<feMerge\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feMerge)+feMerge_ :: [Attribute action] -> [View model action] -> View model action+feMerge_ = nodeSvg "feMerge"+-----------------------------------------------------------------------------+-- | [\<feMergeNode\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feMergeNode)+feMergeNode_ :: [Attribute action] -> View model action+feMergeNode_ = flip (nodeSvg "feMergeNode") []+-----------------------------------------------------------------------------+-- | [\<feMorphology\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feMorphology)+--+-- @since 1.9.0.0+feMorphology_ :: [Attribute action] -> View model action+feMorphology_ = flip (nodeSvg "feMorphology") []+-----------------------------------------------------------------------------+-- | [\<feOffset\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feOffset)+feOffset_ :: [Attribute action] -> View model action+feOffset_ = flip (nodeSvg "feOffset") []+-----------------------------------------------------------------------------+-- | [\<feSpecularLighting\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feSpecularLighting)+feSpecularLighting_ :: [Attribute action] -> [View model action] -> View model action+feSpecularLighting_ = nodeSvg "feSpecularLighting"+-----------------------------------------------------------------------------+-- | [\<feTile\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feTile)+feTile_ :: [Attribute action] -> View model action+feTile_ = flip (nodeSvg "feTile") []+-----------------------------------------------------------------------------+-- | [\<feTurbulence\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feTurbulence)+feTurbulence_ :: [Attribute action] -> View model action+feTurbulence_ = flip (nodeSvg "feTurbulence") []+-----------------------------------------------------------------------------+-- | [\<feDistantLight\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feDistantLight)+feDistantLight_ :: [Attribute action] -> [View model action] -> View model action+feDistantLight_ = nodeSvg "feDistantLight"+-----------------------------------------------------------------------------+-- | [\<fePointLight\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/fePointLight)+fePointLight_ :: [Attribute action] -> View model action+fePointLight_ = flip (nodeSvg "fePointLight") []+-----------------------------------------------------------------------------+-- | [\<feSpotLight\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/feSpotLight)+feSpotLight_ :: [Attribute action] -> View model action+feSpotLight_ = flip (nodeSvg "feSpotLight") []+-----------------------------------------------------------------------------+-- | [\<clipPath\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/clipPath)+clipPath_ :: [Attribute action] -> [View model action] -> View model action+clipPath_ = nodeSvg "clipPath"+-----------------------------------------------------------------------------+-- | [\<filter\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/filter)+filter_ :: [Attribute action] -> [View model action] -> View model action+filter_ = nodeSvg "filter"+-----------------------------------------------------------------------------+-- | [\<script\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/script)+script_ :: [Attribute action] -> [View model action] -> View model action+script_ = nodeSvg "script"+-----------------------------------------------------------------------------+-- | [\<style\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/style)+style_ :: [Attribute action] -> [View model action] -> View model action+style_ = nodeSvg "style"+-----------------------------------------------------------------------------+-- | [\<view\>](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element/view)+view_ :: [Attribute action] -> View model action+view_ = flip (nodeSvg "view") []+-----------------------------------------------------------------------------
src/Miso/Svg/Event.hs view
@@ -1,3 +1,4 @@+----------------------------------------------------------------------------- {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE DataKinds             #-}@@ -5,27 +6,80 @@ {-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- |--- Module      :  Miso.Svg.Events--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Module      :  Miso.Svg.Event+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- 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__ (@\<animate\>@, @\<animateTransform\>@, …):+--   'onBegin', 'onEnd', 'onRepeat'+--+-- * __Document__ (fires on @\<svg\>@ 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 event handlers+  ( -- *** Animation     onBegin   , onEnd   , onRepeat-    -- * Document event attributes+    -- *** Document   , onAbort   , onError   , onResize   , onScroll-  , onLoad-  , onUnload   , onZoom-    -- * Graphical Event Attributes+    -- *** Graphical   , onActivate   , onClick   , onFocusIn@@ -36,81 +90,72 @@   , onMouseOver   , onMouseUp   ) where--import Miso.Event +-----------------------------------------------------------------------------+import Miso.Event (on, emptyDecoder) import Miso.Html.Event (onClick)-import Miso.Html.Internal-+import Miso.Types (Attribute)+----------------------------------------------------------------------------- -- | onBegin event onBegin :: action -> Attribute action-onBegin action = on "begin" emptyDecoder $ \() -> action-+onBegin action = on "begin" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onEnd event onEnd :: action -> Attribute action-onEnd action = on "end" emptyDecoder $ \() -> action-+onEnd action = on "end" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onRepeat event onRepeat :: action -> Attribute action-onRepeat action = on "repeat" emptyDecoder $ \() -> action-+onRepeat action = on "repeat" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onAbort event onAbort :: action -> Attribute action-onAbort action = on "abort" emptyDecoder $ \() -> action-+onAbort action = on "abort" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onError event onError :: action -> Attribute action-onError action = on "error" emptyDecoder $ \() -> action-+onError action = on "error" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onResize event onResize :: action -> Attribute action-onResize action = on "resize" emptyDecoder $ \() -> action-+onResize action = on "resize" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onScroll event onScroll :: action -> Attribute action-onScroll action = on "scroll" emptyDecoder $ \() -> action---- | onLoad event-onLoad :: action -> Attribute action-onLoad action = on "load" emptyDecoder $ \() -> action---- | onUnload event-onUnload :: action -> Attribute action-onUnload action = on "unload" emptyDecoder $ \() -> action-+onScroll action = on "scroll" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onZoom event onZoom :: action -> Attribute action-onZoom action = on "zoom" emptyDecoder $ \() -> action-+onZoom action = on "zoom" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onActivate event onActivate :: action -> Attribute action-onActivate action = on "activate" emptyDecoder $ \() -> action-+onActivate action = on "activate" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onFocusIn event onFocusIn :: action -> Attribute action-onFocusIn action = on "focusin" emptyDecoder $ \() -> action-+onFocusIn action = on "focusin" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onFocusOut event onFocusOut :: action -> Attribute action-onFocusOut action = on "focusout" emptyDecoder $ \() -> action-+onFocusOut action = on "focusout" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onMouseDown event onMouseDown :: action -> Attribute action-onMouseDown action = on "mousedown" emptyDecoder $ \() -> action+onMouseDown action = on "mousedown" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onMouseMove event onMouseMove :: action -> Attribute action-onMouseMove action = on "mousemove" emptyDecoder $ \() -> action-+onMouseMove action = on "mousemove" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onMouseOut event onMouseOut :: action -> Attribute action-onMouseOut action = on "mouseout" emptyDecoder $ \() -> action-+onMouseOut action = on "mouseout" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onMouseOver event onMouseOver :: action -> Attribute action-onMouseOver action = on "mouseover" emptyDecoder $ \() -> action-+onMouseOver action = on "mouseover" emptyDecoder $ \() _ -> action+----------------------------------------------------------------------------- -- | onMouseUp event onMouseUp :: action -> Attribute action-onMouseUp action = on "mouseup" emptyDecoder $ \() -> action---+onMouseUp action = on "mouseup" emptyDecoder $ \() _ -> action+-----------------------------------------------------------------------------
+ src/Miso/Svg/Property.hs view
@@ -0,0 +1,989 @@+-----------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Svg.Property+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = Overview+--+-- "Miso.Svg.Property" provides 'Miso.Types.Attribute' smart constructors+-- for all+-- <https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute SVG attributes>.+-- 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)+-- * <https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute MDN SVG attribute reference>+----------------------------------------------------------------------------+module Miso.Svg.Property+  ( -- *** Regular Attributes+    accumulate_+  , additive_+  , amplitude_+  , attributeName_+  , azimuth_+  , baseFrequency_+  , begin_+  , bias_+  , by_+  , calcMode_+  , clipPathUnits_+  , cx_+  , cy_+  , d_+  , decoding_+  , diffuseConstant_+  , divisor_+  , dur_+  , dx_+  , dy_+  , edgeMode_+  , elevation_+  , end_+  , exponent_+  , filterUnits_+  , fr_+  , from_+  , fx_+  , fy_+  , gradientTransform_+  , gradientUnits_+  , in_'+  , in2_+  , intercept_+  , k1_+  , k2_+  , k3_+  , k4_+  , kernelMatrix_+  , keyPoints_+  , keySplines_+  , keyTimes_+  , lengthAdjust_+  , limitingConeAngle_+  , markerHeight_+  , markerUnits_+  , markerWidth_+  , maskContentUnits_+  , maskUnits_+  , max_+  , media_+  , method_+  , min_+  , mode_+  , numOctaves_+  , offset_+  , operator_+  , order_+  , orient_+  , origin_+  , paintOrder_+  , path_+  , pathLength_+  , patternContentUnits_+  , patternTransform_+  , patternUnits_+  , points_+  , pointsAtX_+  , pointsAtY_+  , pointsAtZ_+  , preserveAlpha_+  , preserveAspectRatio_+  , primitiveUnits_+  , r_+  , radius_+  , refX_+  , refY_+  , repeatCount_+  , repeatDur_+  , restart_+  , result_+  , rotate_+  , rx_+  , ry_+  , scale_+  , seed_+  , side_+  , slope_+  , spacing_+  , specularConstant_+  , specularExponent_+  , spreadMethod_+  , startOffset_+  , stdDeviation_+  , stitchTiles_+  , surfaceScale_+  , systemLanguage_+  , tableValues_+  , target_+  , targetX_+  , targetY_+  , textLength_+  , to_+  , transform_+  , transformOrigin_+  , type_'+  , values_+  , vectorEffect_+  , viewBox_+  , x_+  , x1_+  , x2_+  , xChannelSelector_+  , y_+  , y1_+  , y2_+  , yChannelSelector_+  , z_+  -- *** Presentation attributes+  --+  -- | All SVG presentation attributes can be used as CSS properties.+  , alignmentBaseline_+  , baselineShift_+  , clipPath_+  , clipRule_+  , color_+  , colorInterpolation_+  , colorInterpolationFilters_+  , crossorigin_+  , cursor_+  , direction_+  , display_+  , dominantBaseline_+  , fill_+  , fillOpacity_+  , fillRule_+  , filter_+  , floodColor_+  , floodOpacity_+  , fontFamily_+  , fontSize_+  , fontSizeAdjust_+  , fontStyle_+  , fontVariant_+  , fontWeight_+  , imageRendering_+  , letterSpacing_+  , lightingColor_+  , markerEnd_+  , markerMid_+  , markerStart_+  , mask_+  , opacity_+  , overflow_+  , pointerEvents_+  , shapeRendering_+  , stopColor_+  , stopOpacity_+  , stroke_+  , strokeDasharray_+  , strokeDashoffset_+  , strokeLinecap_+  , strokeLinejoin_+  , strokeMiterlimit_+  , strokeOpacity_+  , strokeWidth_+  , textAnchor_+  , textDecoration_+  , textRendering_+  , unicodeBidi_+  , visibility_+  , wordSpacing_+  , writingMode_+  ) where+-----------------------------------------------------------------------------+import Miso.Property ( textProp )+import Miso.String ( MisoString )+import Miso.Types ( Attribute )+-----------------------------------------------------------------------------+attr :: MisoString -> MisoString -> Attribute action+attr = textProp+-----------------------------------------------------------------------------+-- | [accumulate](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/accumulate) attribute+accumulate_ ::  MisoString -> Attribute action+accumulate_ = attr "accumulate"+-----------------------------------------------------------------------------+-- | [additive](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/additive) attribute+additive_ ::  MisoString -> Attribute action+additive_ = attr "additive"+-----------------------------------------------------------------------------+-- | [amplitude](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/amplitude) attribute+amplitude_ ::  MisoString -> Attribute action+amplitude_ = attr "amplitude"+-----------------------------------------------------------------------------+-- | [attributeName](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/attributeName) attribute+attributeName_ ::  MisoString -> Attribute action+attributeName_ = attr "attributeName"+-----------------------------------------------------------------------------+-- | [azimuth](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/azimuth) attribute+azimuth_ ::  MisoString -> Attribute action+azimuth_ = attr "azimuth"+-----------------------------------------------------------------------------+-- | [baseFrequency](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/baseFrequency) attribute+baseFrequency_ ::  MisoString -> Attribute action+baseFrequency_ = attr "baseFrequency"+-----------------------------------------------------------------------------+-- | [begin](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/begin) attribute+begin_ ::  MisoString -> Attribute action+begin_ = attr "begin"+-----------------------------------------------------------------------------+-- | [bias](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/bias) attribute+bias_ ::  MisoString -> Attribute action+bias_ = attr "bias"+-----------------------------------------------------------------------------+-- | [by](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/by) attribute+by_ ::  MisoString -> Attribute action+by_ = attr "by"+-----------------------------------------------------------------------------+-- | [calcMode](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/calcMode) attribute+calcMode_ ::  MisoString -> Attribute action+calcMode_ = attr "calcMode"+-----------------------------------------------------------------------------+-- | [clipPathUnits](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/clipPathUnits) attribute+clipPathUnits_ ::  MisoString -> Attribute action+clipPathUnits_ = attr "clipPathUnits"+-----------------------------------------------------------------------------+-- | [cx](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/cx) attribute+cx_ ::  MisoString -> Attribute action+cx_ = attr "cx"+-----------------------------------------------------------------------------+-- | [cy](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/cy) attribute+cy_ ::  MisoString -> Attribute action+cy_ = attr "cy"+-----------------------------------------------------------------------------+-- | [d](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/d) attribute+d_ ::  MisoString -> Attribute action+d_ = attr "d"+-----------------------------------------------------------------------------+-- | [decoding](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/decoding) attribute+--+-- @since 1.9.0.0+decoding_ ::  MisoString -> Attribute action+decoding_ = attr "decoding"+-----------------------------------------------------------------------------+-- | [diffuseConstant](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/diffuseConstant) attribute+diffuseConstant_ ::  MisoString -> Attribute action+diffuseConstant_ = attr "diffuseConstant"+-----------------------------------------------------------------------------+-- | [divisor](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/divisor) attribute+divisor_ ::  MisoString -> Attribute action+divisor_ = attr "divisor"+-----------------------------------------------------------------------------+-- | [dur](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/dur) attribute+dur_ ::  MisoString -> Attribute action+dur_ = attr "dur"+-----------------------------------------------------------------------------+-- | [dx](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/dx) attribute+dx_ ::  MisoString -> Attribute action+dx_ = attr "dx"+-----------------------------------------------------------------------------+-- | [dy](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/dy) attribute+dy_ ::  MisoString -> Attribute action+dy_ = attr "dy"+-----------------------------------------------------------------------------+-- | [edgeMode](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/edgeMode) attribute+edgeMode_ ::  MisoString -> Attribute action+edgeMode_ = attr "edgeMode"+-----------------------------------------------------------------------------+-- | [elevation](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/elevation) attribute+elevation_ ::  MisoString -> Attribute action+elevation_ = attr "elevation"+-----------------------------------------------------------------------------+-- | [end](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/end) attribute+end_ ::  MisoString -> Attribute action+end_ = attr "end"+-----------------------------------------------------------------------------+-- | [exponent](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/exponent) attribute+exponent_ ::  MisoString -> Attribute action+exponent_ = attr "exponent"+-----------------------------------------------------------------------------+-- | [filterUnits](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/filterUnits) attribute+filterUnits_ ::  MisoString -> Attribute action+filterUnits_ = attr "filterUnits"+-----------------------------------------------------------------------------+-- | [fr](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/fr) attribute+--+-- @since 1.9.0.0+fr_ ::  MisoString -> Attribute action+fr_ = attr "fr"+-----------------------------------------------------------------------------+-- | [from](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/from) attribute+from_ ::  MisoString -> Attribute action+from_ = attr "from"+-----------------------------------------------------------------------------+-- | [fx](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/fx) attribute+fx_ ::  MisoString -> Attribute action+fx_ = attr "fx"+-----------------------------------------------------------------------------+-- | [fy](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/fy) attribute+fy_ ::  MisoString -> Attribute action+fy_ = attr "fy"+-----------------------------------------------------------------------------+-- | [gradientTransform](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/gradientTransform) attribute+gradientTransform_ ::  MisoString -> Attribute action+gradientTransform_ = attr "gradientTransform"+-----------------------------------------------------------------------------+-- | [gradientUnits](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/gradientUnits) attribute+gradientUnits_ ::  MisoString -> Attribute action+gradientUnits_ = attr "gradientUnits"+-----------------------------------------------------------------------------+-- | [in](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/in) attribute+in_' ::  MisoString -> Attribute action+in_' = attr "in"+-----------------------------------------------------------------------------+-- | [in2](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/in2) attribute+in2_ ::  MisoString -> Attribute action+in2_ = attr "in2"+-----------------------------------------------------------------------------+-- | [intercept](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/intercept) attribute+intercept_ ::  MisoString -> Attribute action+intercept_ = attr "intercept"+-----------------------------------------------------------------------------+-- | [k1](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/k1) attribute+k1_ ::  MisoString -> Attribute action+k1_ = attr "k1"+-----------------------------------------------------------------------------+-- | [k2](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/k2) attribute+k2_ ::  MisoString -> Attribute action+k2_ = attr "k2"+-----------------------------------------------------------------------------+-- | [k3](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/k3) attribute+k3_ ::  MisoString -> Attribute action+k3_ = attr "k3"+-----------------------------------------------------------------------------+-- | [k4](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/k4) attribute+k4_ ::  MisoString -> Attribute action+k4_ = attr "k4"+-----------------------------------------------------------------------------+-- | [kernelMatrix](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/kernelMatrix) attribute+kernelMatrix_ ::  MisoString -> Attribute action+kernelMatrix_ = attr "kernelMatrix"+-----------------------------------------------------------------------------+-- | [keyPoints](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/keyPoints) attribute+keyPoints_ ::  MisoString -> Attribute action+keyPoints_ = attr "keyPoints"+-----------------------------------------------------------------------------+-- | [keySplines](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/keySplines) attribute+keySplines_ ::  MisoString -> Attribute action+keySplines_ = attr "keySplines"+-----------------------------------------------------------------------------+-- | [keyTimes](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/keyTimes) attribute+keyTimes_ ::  MisoString -> Attribute action+keyTimes_ = attr "keyTimes"+-----------------------------------------------------------------------------+-- | [lengthAdjust](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/lengthAdjust) attribute+lengthAdjust_ ::  MisoString -> Attribute action+lengthAdjust_ = attr "lengthAdjust"+-----------------------------------------------------------------------------+-- | [limitingConeAngle](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/limitingConeAngle) attribute+limitingConeAngle_ ::  MisoString -> Attribute action+limitingConeAngle_ = attr "limitingConeAngle"+-----------------------------------------------------------------------------+-- | [markerHeight](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/markerHeight) attribute+markerHeight_ ::  MisoString -> Attribute action+markerHeight_ = attr "markerHeight"+-----------------------------------------------------------------------------+-- | [markerUnits](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/markerUnits) attribute+markerUnits_ ::  MisoString -> Attribute action+markerUnits_ = attr "markerUnits"+-----------------------------------------------------------------------------+-- | [markerWidth](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/markerWidth) attribute+markerWidth_ ::  MisoString -> Attribute action+markerWidth_ = attr "markerWidth"+-----------------------------------------------------------------------------+-- | [maskContentUnits](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/maskContentUnits) attribute+maskContentUnits_ ::  MisoString -> Attribute action+maskContentUnits_ = attr "maskContentUnits"+-----------------------------------------------------------------------------+-- | [maskUnits](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/maskUnits) attribute+maskUnits_ ::  MisoString -> Attribute action+maskUnits_ = attr "maskUnits"+-----------------------------------------------------------------------------+-- | [max](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/max) attribute+max_ ::  MisoString -> Attribute action+max_ = attr "max"+-----------------------------------------------------------------------------+-- | [media](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/media) attribute+media_ ::  MisoString -> Attribute action+media_ = attr "media"+-----------------------------------------------------------------------------+-- | [method](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/method) attribute+method_ ::  MisoString -> Attribute action+method_ = attr "method"+-----------------------------------------------------------------------------+-- | [min](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/min) attribute+min_ ::  MisoString -> Attribute action+min_ = attr "min"+-----------------------------------------------------------------------------+-- | [mode](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/mode) attribute+mode_ ::  MisoString -> Attribute action+mode_ = attr "mode"+-----------------------------------------------------------------------------+-- | [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+operator_ = attr "operator"+-----------------------------------------------------------------------------+-- | [order](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/order) attribute+order_ ::  MisoString -> Attribute action+order_ = attr "order"+-----------------------------------------------------------------------------+-- | [orient](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/orient) attribute+orient_ ::  MisoString -> Attribute action+orient_ = attr "orient"+-----------------------------------------------------------------------------+-- | [origin](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/origin) attribute+origin_ ::  MisoString -> Attribute action+origin_ = attr "origin"+-----------------------------------------------------------------------------+-- | [path](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/path) attribute+path_ ::  MisoString -> Attribute action+path_ = attr "path"+-----------------------------------------------------------------------------+-- | [paint-order](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/paint-order) attribute+--+-- @since 1.9.0.0+paintOrder_ ::  MisoString -> Attribute action+paintOrder_ = attr "paint-order"+-----------------------------------------------------------------------------+-- | [pathLength](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/pathLength) attribute+pathLength_ ::  MisoString -> Attribute action+pathLength_ = attr "pathLength"+-----------------------------------------------------------------------------+-- | [patternContentUnits](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/patternContentUnits) attribute+patternContentUnits_ ::  MisoString -> Attribute action+patternContentUnits_ = attr "patternContentUnits"+-----------------------------------------------------------------------------+-- | [patternTransform](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/patternTransform) attribute+patternTransform_ ::  MisoString -> Attribute action+patternTransform_ = attr "patternTransform"+-----------------------------------------------------------------------------+-- | [patternUnits](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/patternUnits) attribute+patternUnits_ ::  MisoString -> Attribute action+patternUnits_ = attr "patternUnits"+-----------------------------------------------------------------------------+-- | [points](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/points) attribute+points_ ::  MisoString -> Attribute action+points_ = attr "points"+-----------------------------------------------------------------------------+-- | [pointsAtX](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/pointsAtX) attribute+pointsAtX_ ::  MisoString -> Attribute action+pointsAtX_ = attr "pointsAtX"+-----------------------------------------------------------------------------+-- | [pointsAtY](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/pointsAtY) attribute+pointsAtY_ ::  MisoString -> Attribute action+pointsAtY_ = attr "pointsAtY"+-----------------------------------------------------------------------------+-- | [pointsAtZ](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/pointsAtZ) attribute+pointsAtZ_ ::  MisoString -> Attribute action+pointsAtZ_ = attr "pointsAtZ"+-----------------------------------------------------------------------------+-- | [preserveAlpha](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/preserveAlpha) attribute+preserveAlpha_ ::  MisoString -> Attribute action+preserveAlpha_ = attr "preserveAlpha"+-----------------------------------------------------------------------------+-- | [preserveAspectRatio](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/preserveAspectRatio) attribute+preserveAspectRatio_ ::  MisoString -> Attribute action+preserveAspectRatio_ = attr "preserveAspectRatio"+-----------------------------------------------------------------------------+-- | [primitiveUnits](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/primitiveUnits) attribute+primitiveUnits_ ::  MisoString -> Attribute action+primitiveUnits_ = attr "primitiveUnits"+-----------------------------------------------------------------------------+-- | [r](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/r) attribute+r_ ::  MisoString -> Attribute action+r_ = attr "r"+-----------------------------------------------------------------------------+-- | [radius](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/radius) attribute+radius_ ::  MisoString -> Attribute action+radius_ = attr "radius"+-----------------------------------------------------------------------------+-- | [refX](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/refX) attribute+refX_ ::  MisoString -> Attribute action+refX_ = attr "refX"+-----------------------------------------------------------------------------+-- | [refY](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/refY) attribute+refY_ ::  MisoString -> Attribute action+refY_ = attr "refY"+-----------------------------------------------------------------------------+-- | [repeatCount](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/repeatCount) attribute+repeatCount_ ::  MisoString -> Attribute action+repeatCount_ = attr "repeatCount"+-----------------------------------------------------------------------------+-- | [repeatDur](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/repeatDur) attribute+repeatDur_ ::  MisoString -> Attribute action+repeatDur_ = attr "repeatDur"+-----------------------------------------------------------------------------+-- | [restart](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/restart) attribute+restart_ ::  MisoString -> Attribute action+restart_ = attr "restart"+-----------------------------------------------------------------------------+-- | [result](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/result) attribute+result_ ::  MisoString -> Attribute action+result_ = attr "result"+-----------------------------------------------------------------------------+-- | [rotate](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/rotate) attribute+rotate_ ::  MisoString -> Attribute action+rotate_ = attr "rotate"+-----------------------------------------------------------------------------+-- | [rx](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/rx) attribute+rx_ ::  MisoString -> Attribute action+rx_ = attr "rx"+-----------------------------------------------------------------------------+-- | [ry](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/ry) attribute+ry_ ::  MisoString -> Attribute action+ry_ = attr "ry"+-----------------------------------------------------------------------------+-- | [scale](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/scale) attribute+scale_ ::  MisoString -> Attribute action+scale_ = attr "scale"+-----------------------------------------------------------------------------+-- | [seed](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/seed) attribute+seed_ ::  MisoString -> Attribute action+seed_ = attr "seed"+-----------------------------------------------------------------------------+-- | [side](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/side) attribute+--+-- @since 1.9.0.0+side_ ::  MisoString -> Attribute action+side_ = attr "side"+-----------------------------------------------------------------------------+-- | [slope](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/slope) attribute+slope_ ::  MisoString -> Attribute action+slope_ = attr "slope"+-----------------------------------------------------------------------------+-- | [spacing](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/spacing) attribute+spacing_ ::  MisoString -> Attribute action+spacing_ = attr "spacing"+-----------------------------------------------------------------------------+-- | [specularConstant](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/specularConstant) attribute+specularConstant_ ::  MisoString -> Attribute action+specularConstant_ = attr "specularConstant"+-----------------------------------------------------------------------------+-- | [specularExponent](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/specularExponent) attribute+specularExponent_ ::  MisoString -> Attribute action+specularExponent_ = attr "specularExponent"+-----------------------------------------------------------------------------+-- | [spreadMethod](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/spreadMethod) attribute+spreadMethod_ ::  MisoString -> Attribute action+spreadMethod_ = attr "spreadMethod"+-----------------------------------------------------------------------------+-- | [startOffset](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/startOffset) attribute+startOffset_ ::  MisoString -> Attribute action+startOffset_ = attr "startOffset"+-----------------------------------------------------------------------------+-- | [stdDeviation](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/stdDeviation) attribute+stdDeviation_ ::  MisoString -> Attribute action+stdDeviation_ = attr "stdDeviation"+-----------------------------------------------------------------------------+-- | [stitchTiles](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/stitchTiles) attribute+stitchTiles_ ::  MisoString -> Attribute action+stitchTiles_ = attr "stitchTiles"+-----------------------------------------------------------------------------+-- | [surfaceScale](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/surfaceScale) attribute+surfaceScale_ ::  MisoString -> Attribute action+surfaceScale_ = attr "surfaceScale"+-----------------------------------------------------------------------------+-- | [systemLanguage](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/systemLanguage) attribute+systemLanguage_ ::  MisoString -> Attribute action+systemLanguage_ = attr "systemLanguage"+-----------------------------------------------------------------------------+-- | [tableValues](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/tableValues) attribute+tableValues_ ::  MisoString -> Attribute action+tableValues_ = attr "tableValues"+-----------------------------------------------------------------------------+-- | [target](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/target) attribute+target_ ::  MisoString -> Attribute action+target_ = attr "target"+-----------------------------------------------------------------------------+-- | [targetX](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/targetX) attribute+targetX_ ::  MisoString -> Attribute action+targetX_ = attr "targetX"+-----------------------------------------------------------------------------+-- | [targetY](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/targetY) attribute+targetY_ ::  MisoString -> Attribute action+targetY_ = attr "targetY"+-----------------------------------------------------------------------------+-- | [textLength](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/textLength) attribute+textLength_ ::  MisoString -> Attribute action+textLength_ = attr "textLength"+-----------------------------------------------------------------------------+-- | [to](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/to) attribute+to_ ::  MisoString -> Attribute action+to_ = attr "to"+-----------------------------------------------------------------------------+-- | [transform](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/transform) attribute+transform_ ::  MisoString -> Attribute action+transform_ = attr "transform"+-----------------------------------------------------------------------------+-- | [transform-origin](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/transform-origin) attribute+--+-- @since 1.9.0.0+transformOrigin_ ::  MisoString -> Attribute action+transformOrigin_ = attr "transform-origin"+-----------------------------------------------------------------------------+-- | [type](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/type) attribute+type_' ::  MisoString -> Attribute action+type_' = attr "type"+-----------------------------------------------------------------------------+-- | [values](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/values) attribute+values_ ::  MisoString -> Attribute action+values_ = attr "values"+-----------------------------------------------------------------------------+-- | [vector-effect](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/vector-effect) attribute+--+-- @since 1.9.0.0+vectorEffect_ ::  MisoString -> Attribute action+vectorEffect_ = attr "vector-effect"+-----------------------------------------------------------------------------+-- | [viewBox](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/viewBox) attribute+viewBox_ ::  MisoString -> Attribute action+viewBox_ = attr "viewBox"+-----------------------------------------------------------------------------+-- | [x](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/x) attribute+x_ ::  MisoString -> Attribute action+x_ = attr "x"+-----------------------------------------------------------------------------+-- | [x1](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/x1) attribute+x1_ ::  MisoString -> Attribute action+x1_ = attr "x1"+-----------------------------------------------------------------------------+-- | [x2](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/x2) attribute+x2_ ::  MisoString -> Attribute action+x2_ = attr "x2"+-----------------------------------------------------------------------------+-- | [xChannelSelector](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/xChannelSelector) attribute+xChannelSelector_ ::  MisoString -> Attribute action+xChannelSelector_ = attr "x-channel-selector"+-----------------------------------------------------------------------------+-- | [y](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/y) attribute+y_ ::  MisoString -> Attribute action+y_ = attr "y"+-----------------------------------------------------------------------------+-- | [y1](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/y1) attribute+y1_ ::  MisoString -> Attribute action+y1_ = attr "y1"+-----------------------------------------------------------------------------+-- | [y2](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/y2) attribute+y2_ ::  MisoString -> Attribute action+y2_ = attr "y2"+-----------------------------------------------------------------------------+-- | [yChannelSelector](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/yChannelSelector) attribute+yChannelSelector_ ::  MisoString -> Attribute action+yChannelSelector_ = attr "yChannelSelector"+-----------------------------------------------------------------------------+-- | [z](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/z) attribute+z_ ::  MisoString -> Attribute action+z_ = attr "z"+-----------------------------------------------------------------------------+-- | [alignment-baseline](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/alignment-baseline) attribute+alignmentBaseline_ ::  MisoString -> Attribute action+alignmentBaseline_ = attr "alignment-baseline"+-----------------------------------------------------------------------------+-- | [baseline-shift](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/baseline-shift) attribute+baselineShift_ ::  MisoString -> Attribute action+baselineShift_ = attr "baseline-shift"+-----------------------------------------------------------------------------+-- | [clip-path](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/clip-path) attribute+clipPath_ ::  MisoString -> Attribute action+clipPath_ = attr "clip-path"+-----------------------------------------------------------------------------+-- | [clip-rule](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/clip-rule) attribute+clipRule_ ::  MisoString -> Attribute action+clipRule_ = attr "clip-rule"+-----------------------------------------------------------------------------+-- | [color-interpolation](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/color-interpolation) attribute+colorInterpolation_ ::  MisoString -> Attribute action+colorInterpolation_ = attr "color-interpolation"+-----------------------------------------------------------------------------+-- | [color-interpolation-filters](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/color-interpolation-filters) attribute+colorInterpolationFilters_ ::  MisoString -> Attribute action+colorInterpolationFilters_ = attr "color-interpolation-filters"+-----------------------------------------------------------------------------+-- | [crossorigin](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/crossorigin) attribute+--+-- @since 1.9.0.0+crossorigin_ ::  MisoString -> Attribute action+crossorigin_ = attr "crossorigin"+-----------------------------------------------------------------------------+-- | [color](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/color) attribute+color_ ::  MisoString -> Attribute action+color_ = attr "color"+-----------------------------------------------------------------------------+-- | [cursor](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/cursor) attribute+cursor_ ::  MisoString -> Attribute action+cursor_ = attr "cursor"+-----------------------------------------------------------------------------+-- | [direction](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/direction) attribute+direction_ ::  MisoString -> Attribute action+direction_ = attr "direction"+-----------------------------------------------------------------------------+-- | [display](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/display) attribute+display_ ::  MisoString -> Attribute action+display_ = attr "display"+-----------------------------------------------------------------------------+-- | [dominant-baseline](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/dominant-baseline) attribute+dominantBaseline_ ::  MisoString -> Attribute action+dominantBaseline_ = attr "dominant-baseline"+-----------------------------------------------------------------------------+-- | [fill-opacity](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/fill-opacity) attribute+fillOpacity_ ::  MisoString -> Attribute action+fillOpacity_ = attr "fill-opacity"+-----------------------------------------------------------------------------+-- | [fill-rule](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/fill-rule) attribute+fillRule_ ::  MisoString -> Attribute action+fillRule_ = attr "fill-rule"+-----------------------------------------------------------------------------+-- | [fill](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/fill) attribute+fill_ ::  MisoString -> Attribute action+fill_ = attr "fill"+-----------------------------------------------------------------------------+-- | [filter](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/filter) attribute+filter_ ::  MisoString -> Attribute action+filter_ = attr "filter"+-----------------------------------------------------------------------------+-- | [flood-color](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/flood-color) attribute+floodColor_ ::  MisoString -> Attribute action+floodColor_ = attr "flood-color"+-----------------------------------------------------------------------------+-- | [flood-opacity](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/flood-opacity) attribute+floodOpacity_ ::  MisoString -> Attribute action+floodOpacity_ = attr "flood-opacity"+-----------------------------------------------------------------------------+-- | [font-family](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/font-family) attribute+fontFamily_ ::  MisoString -> Attribute action+fontFamily_ = attr "font-family"+-----------------------------------------------------------------------------+-- | [font-size-adjust](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/font-size-adjust) attribute+fontSizeAdjust_ ::  MisoString -> Attribute action+fontSizeAdjust_ = attr "font-size-adjust"+-----------------------------------------------------------------------------+-- | [font-size](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/font-size) attribute+fontSize_ ::  MisoString -> Attribute action+fontSize_ = attr "font-size"+-----------------------------------------------------------------------------+-- | [font-style](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/font-style) attribute+fontStyle_ ::  MisoString -> Attribute action+fontStyle_ = attr "font-style"+-----------------------------------------------------------------------------+-- | [font-variant](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/font-variant) attribute+fontVariant_ ::  MisoString -> Attribute action+fontVariant_ = attr "font-variant"+-----------------------------------------------------------------------------+-- | [font-weight](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/font-weight) attribute+fontWeight_ ::  MisoString -> Attribute action+fontWeight_ = attr "font-weight"+-----------------------------------------------------------------------------+-- | [image-rendering](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/image-rendering) attribute+imageRendering_ ::  MisoString -> Attribute action+imageRendering_ = attr "image-rendering"+-----------------------------------------------------------------------------+-- | [letter-spacing](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/letter-spacing) attribute+letterSpacing_ ::  MisoString -> Attribute action+letterSpacing_ = attr "letter-spacing"+-----------------------------------------------------------------------------+-- | [lighting-color](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/lighting-color) attribute+lightingColor_ ::  MisoString -> Attribute action+lightingColor_ = attr "lighting-color"+-----------------------------------------------------------------------------+-- | [marker-end](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/marker-end) attribute+markerEnd_ ::  MisoString -> Attribute action+markerEnd_ = attr "marker-end"+-----------------------------------------------------------------------------+-- | [marker-mid](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/marker-mid) attribute+markerMid_ ::  MisoString -> Attribute action+markerMid_ = attr "marker-mid"+-----------------------------------------------------------------------------+-- | [marker-start](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/marker-start) attribute+markerStart_ ::  MisoString -> Attribute action+markerStart_ = attr "marker-start"+-----------------------------------------------------------------------------+-- | [mask](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/mask) attribute+mask_ ::  MisoString -> Attribute action+mask_ = attr "mask"+-----------------------------------------------------------------------------+-- | [opacity](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/opacity) attribute+opacity_ ::  MisoString -> Attribute action+opacity_ = attr "opacity"+-----------------------------------------------------------------------------+-- | [overflow](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/overflow) attribute+overflow_ ::  MisoString -> Attribute action+overflow_ = attr "overflow"+-----------------------------------------------------------------------------+-- | [pointer-events](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/pointer-events) attribute+pointerEvents_ ::  MisoString -> Attribute action+pointerEvents_ = attr "pointer-events"+-----------------------------------------------------------------------------+-- | [shape-rendering](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/shape-rendering) attribute+shapeRendering_ ::  MisoString -> Attribute action+shapeRendering_ = attr "shape-rendering"+-----------------------------------------------------------------------------+-- | [stop-color](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/stop-color) attribute+stopColor_ ::  MisoString -> Attribute action+stopColor_ = attr "stop-color"+-----------------------------------------------------------------------------+-- | [stop-opacity](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/stop-opacity) attribute+stopOpacity_ ::  MisoString -> Attribute action+stopOpacity_ = attr "stop-opacity"+-----------------------------------------------------------------------------+-- | [stroke-dasharray](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/stroke-dasharray) attribute+strokeDasharray_ ::  MisoString -> Attribute action+strokeDasharray_ = attr "stroke-dasharray"+-----------------------------------------------------------------------------+-- | [stroke-dashoffset](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/stroke-dashoffset) attribute+strokeDashoffset_ ::  MisoString -> Attribute action+strokeDashoffset_ = attr "stroke-dashoffset"+-----------------------------------------------------------------------------+-- | [stroke-linecap](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/stroke-linecap) attribute+strokeLinecap_ ::  MisoString -> Attribute action+strokeLinecap_ = attr "stroke-linecap"+-----------------------------------------------------------------------------+-- | [stroke-linejoin](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/stroke-linejoin) attribute+strokeLinejoin_ ::  MisoString -> Attribute action+strokeLinejoin_ = attr "stroke-linejoin"+-----------------------------------------------------------------------------+-- | [stroke-miterlimit](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/stroke-miterlimit) attribute+strokeMiterlimit_ ::  MisoString -> Attribute action+strokeMiterlimit_ = attr "stroke-miterlimit"+-----------------------------------------------------------------------------+-- | [stroke-opacity](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/stroke-opacity) attribute+strokeOpacity_ ::  MisoString -> Attribute action+strokeOpacity_ = attr "stroke-opacity"+-----------------------------------------------------------------------------+-- | [stroke-width](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/stroke-width) attribute+strokeWidth_ ::  MisoString -> Attribute action+strokeWidth_ = attr "stroke-width"+-----------------------------------------------------------------------------+-- | [stroke](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/stroke) attribute+stroke_ ::  MisoString -> Attribute action+stroke_ = attr "stroke"+-----------------------------------------------------------------------------+-- | [text-anchor](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/text-anchor) attribute+textAnchor_ ::  MisoString -> Attribute action+textAnchor_ = attr "text-anchor"+-----------------------------------------------------------------------------+-- | [text-decoration](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/text-decoration) attribute+textDecoration_ ::  MisoString -> Attribute action+textDecoration_ = attr "text-decoration"+-----------------------------------------------------------------------------+-- | [text-rendering](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/text-rendering) attribute+textRendering_ ::  MisoString -> Attribute action+textRendering_ = attr "text-rendering"+-----------------------------------------------------------------------------+-- | [unicode-bidi](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/unicode-bidi) attribute+unicodeBidi_ ::  MisoString -> Attribute action+unicodeBidi_ = attr "unicode-bidi"+-----------------------------------------------------------------------------+-- | [visibility](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/visibility) attribute+visibility_ ::  MisoString -> Attribute action+visibility_ = attr "visibility"+-----------------------------------------------------------------------------+-- | [word-spacing](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/word-spacing) attribute+wordSpacing_ ::  MisoString -> Attribute action+wordSpacing_ = attr "word-spacing"+-----------------------------------------------------------------------------+-- | [writing-mode](https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/writing-mode) attribute+writingMode_ ::  MisoString -> Attribute action+writingMode_ = attr "writing-mode"+-----------------------------------------------------------------------------
+ src/Miso/Types.hs view
@@ -0,0 +1,903 @@+-----------------------------------------------------------------------------+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ExistentialQuantification  #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE DeriveAnyClass             #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE CPP                        #-}+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -Wno-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Types+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- = 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 (@\<div\>@, @\<svg\>@, …)+-- * '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+    App+  , Component     (..)+  , ComponentId+  , SomeComponent (..)+  , View          (..)+  , Key           (..)+  , Attribute     (..)+  , Namespace     (..)+  , CSS           (..)+  , JS            (..)+  , LogLevel      (..)+  , VTree         (..)+  , VTreeType     (..)+  , Tag+  , CacheBust+  , MountPoint+  , DOMRef+  , ROOT+  , Events+  , Phase         (..)+  , URI           (..)+  -- ** Classes+  , ToKey         (..)+  -- ** Data Bindings+  , Binding       (..)+  -- ** Smart Constructors+  , emptyURI+  , component+  , vcomp+  , (-->)+  , (<--)+  , (<-->)+  , (<--->)+  , (--->)+  , (<---)+  -- ** Component mounting+  , (+>)+  , mount_+  , mountWithProps_+  , mountWithProps+  -- ** Key combinators+  , keyed+  -- ** Fragment combinators+  , fragment+  , fragment_+  , vfrag+  , vfrag_+  -- ** Utils+  , getMountPoint+  , optionalAttrs+  , optionalVoidAttrs+  , optionalChildren+  , prettyURI+  , prettyQueryString+  -- *** Combinators+  , node+  , vnode+  , text+  , vtext+  , text_+  , textRaw+  , textKey+  , textKey_+  , htmlEncode+  -- *** MisoString+  , MisoString+  , toMisoString+  , fromMisoString+  , ms+  ) where+-----------------------------------------------------------------------------+import qualified Data.Map.Strict as M+import           Data.Maybe (fromMaybe, isJust)+import           Data.String (IsString, fromString)+import qualified Data.Text as T+import           GHC.Generics+import           Prelude+-----------------------------------------------------------------------------+import           Miso.Binding ((<--), (-->), (<-->), (<---), (--->), (<--->), Binding(..))+import           Miso.DSL+import           Miso.Effect (Effect, Sub, Sink, DOMRef, ComponentId)+import           Miso.Event.Types+import           Miso.JSON (Value, ToJSON(..), encode)+import qualified Miso.String as MS+import           Miso.String (ToMisoString, MisoString, toMisoString, ms, fromMisoString)+import           Miso.CSS.Types (StyleSheet)+-----------------------------------------------------------------------------+-- | Application entry point+data Component parent props model action+  = Component+  { model :: model+  -- ^ Initial model+#ifdef SSR+  , hydrateModel :: Maybe (IO model)+#else+  , hydrateModel :: Maybe (IO model)+#endif+  -- ^ Optional 'IO' to load component 'model' state, such as reading data from page.+  --   The resulting 'model' is only used during initial hydration, not on remounts.+  , update :: action -> Effect parent props model action+  -- ^ Updates model, optionally providing effects.+  , view :: props -> model -> View model action+  -- ^ Draws 'View'+  , subs :: [ Sub action ]+  -- ^ Subscriptions to run during application lifetime+  , styles :: [CSS]+  -- ^ CSS styles expressed as either a URL ('Href') or as 'Style' text.+  -- These styles are appended dynamically to the \<head\> section of your HTML page+  -- before the initial draw on \<body\> occurs.+  --+  -- @since 1.9.0.0+  , scripts :: [JS]+  -- ^ JavaScript scripts expressed as either a URL ('Src') or raw JS text.+  -- These scripts are appended dynamically to the \<head\> section of your HTML page+  -- before the initial draw on \<body\> occurs.+  --+  -- @since 1.9.0.0+  , mountPoint :: Maybe MountPoint+  -- ^ ID of the root element for DOM diff.+  -- If 'Nothing' is provided, the entire document body is used as a mount point.+  , logLevel :: LogLevel+  -- ^ Debugging configuration for prerendering and event delegation+  , mailbox :: Value -> Maybe action+  -- ^ Receives mail from other components+  --+  -- @since 1.9.0.0+  , bindings :: [ Binding parent model ]+  -- ^ Data bindings between parent and child t'Miso.Types.Component's+  --+  -- @since 1.9.0.0+  , eventPropagation :: Bool+  -- ^ Should events bubble up past the t'Miso.Types.Component' barrier.+  --+  -- Defaults to t'False'+  --+  -- @since 1.9.0.0+  , mount :: Maybe action+  -- ^ action to execute during t'Miso.Types.Component' mount phase.+  --+  -- @since 1.9.0.0+  , unmount :: Maybe action+  -- ^ 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 \<head\> before the first draw+--+-- > 'Href' "http://domain.com/style.css" ('True' :: 'CacheBust')+-- > 'Style' "body { background-color: red; }"+--+data CSS+  = Href MisoString CacheBust+  -- ^ 'URL' linking to hosted 'CSS'+  | Style MisoString+  -- ^ Raw 'CSS' content in a 'Miso.Html.Element.style_' tag+  | Sheet StyleSheet+  -- ^ 'CSS' built with "Miso.CSS"+  deriving (Show, Eq)+-----------------------------------------------------------------------------+-- | Parameter used to indicate cache busting logic should be used.+-- If 'True' this will append a timestamp to the query. This will force cache+-- invalidation on the browser, causing a fetch of the resources.+--+type CacheBust = Bool+-----------------------------------------------------------------------------+-- | Allow users to express JS and append it to \<head\> 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\");"+-- @+--+-- @since 1.9.0.0+data JS+  = Src MisoString CacheBust+  -- ^ URL linking to hosted JS+  | Script MisoString+  -- ^ Raw JS content that you would enter in a \<script\> tag+  | Module MisoString+  -- ^ Raw JS module content that you would enter in a \<script type="module"\> tag.+  -- See [script type](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/script/type)+  | ImportMap [(MisoString,MisoString)]+  -- ^ Import map content in a \<script type="importmap"\> tag.+  -- See [importmap](https://developer.mozilla.org/en-US/docs/Web/HTML/Reference/Elements/script/type/importmap)+  deriving (Show, Eq)+-----------------------------------------------------------------------------+-- | Convenience for extracting mount point+getMountPoint :: Maybe MisoString -> MisoString+getMountPoint = fromMaybe "body"+-----------------------------------------------------------------------------+-- | Smart constructor for t'Miso.Types.Component' with sane defaults.+component+  :: model+  -- ^ model+  -> (action -> Effect parent props model action)+  -- ^ update+  -> (props -> model -> View model action)+  -- ^ view+  -> Component parent props model action+component m u v = Component+  { model = m+  , hydrateModel = Nothing+  , update = u+  , view = v+  , subs = []+  , styles = []+  , scripts = []+  , mountPoint = Nothing+  , logLevel = Off+  , mailbox = const Nothing+  , bindings = []+  , eventPropagation = False+  , mount = Nothing+  , unmount = Nothing+  , onPropsChanged = Nothing+  }+-----------------------------------------------------------------------------+-- | Synonym for 'component'+vcomp+  :: model+  -- ^ model+  -> (action -> Effect parent props model action)+  -- ^ update+  -> (props -> model -> View model action)+  -- ^ view+  -> Component parent props model action+vcomp = component  +-----------------------------------------------------------------------------+-- | A top-level t'Miso.Types.Component' can have no @parent@.+--+-- The 'ROOT' type is for disallowing a top-level mounted t'Miso.Types.Component' access+-- into its parent state. It has no inhabitants (spiritually 'Data.Void.Void')+--+data ROOT+-----------------------------------------------------------------------------+-- | 'Eq' instance for 'ROOT'+instance Eq ROOT where _ == _ = True+-----------------------------------------------------------------------------+-- | A miso application is a top-level t'Miso.Types.Component', which has no @parent@.+-- This is enforced by specializing the @parent@ type parameter to 'ROOT'.+--+type App model action = Component ROOT () model action+-----------------------------------------------------------------------------+-- | Logging configuration for debugging Miso internals (useful to see if prerendering is successful)+data LogLevel+  = Off+  -- ^ No debug logging, the default value used in 'component'+  | DebugHydrate+  -- ^ Will warn if the structure or properties of the+  -- DOM vs. Virtual DOM differ during prerendering.+  | DebugEvents+  -- ^ Will warn if an event cannot be routed to the Haskell event+  -- handler that raised it. Also will warn if an event handler is+  -- being used, yet it's not being listened for by the event+  -- delegator mount point.+  | DebugAll+  -- ^ Logs on all of the above+  deriving (Show, Eq)+-----------------------------------------------------------------------------+-- | Tag type, (e.g. 'div_', 'p_')+--+-- Meant to indicate the type of element being created.+-- Used as the first argument to @document.createElement@ for the web backend.+--+type Tag = MisoString+-----------------------------------------------------------------------------+-- | Core type for constructing a virtual DOM in Haskell+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]+  deriving Functor+-----------------------------------------------------------------------------+-- | Existential wrapper allowing nesting of t'Miso.Types.Component' in t'Miso.Types.Component'+data SomeComponent parent+   = forall model action props . (Eq model, Eq props)+  => SomeComponent props (Component parent props model action)+-----------------------------------------------------------------------------+-- | Like '+>' but operates on any 'View', not just 'Component'.+--+-- This appends a 'Key' to any 'View'.+--+-- @+-- keyed "key" ("some text" :: View model action)+-- keyed "key" $ div_ [ id_ "container" ] [ "content" ]+-- keyed "key" (mount_ calendarComponent)+-- @+--+-- @since 1.10.0.0+keyed+  :: MisoString+  -> View model action+  -> View model action+keyed key = \case+    VText _ txt ->+      VText (Just (Key key)) txt+    VComp _ comp ->+      VComp (Just (Key key)) comp+    VFrag _ kids ->+      VFrag (Just (Key key)) kids+    VNode ns tag attrs kids ->+      VNode ns tag (Property "key" (toJSON key) : attrs) kids+-----------------------------------------------------------------------------+-- | Create a fragment (keyless).+--+-- A fragment groups multiple sibling 'View' nodes without introducing+-- an extra DOM element.+--+-- Synonym for `fragment'+--+-- @since 1.10.0.0+vfrag :: [View model action] -> View model action+vfrag = fragment+-----------------------------------------------------------------------------+-- | Create a fragment (keyless).+--+-- A fragment groups multiple sibling 'View' nodes without introducing+-- an extra DOM element.+--+-- @since 1.10.0.0+fragment :: [View model action] -> View model action+fragment = VFrag Nothing+-----------------------------------------------------------------------------+-- | Like 'fragment', but keyed for efficient diffing.+--+-- @since 1.10.0.0+vfrag_ :: MisoString -> [View model action] -> View model action+vfrag_ key = VFrag (Just (Key key))+-----------------------------------------------------------------------------+-- | Like 'fragment', but keyed for efficient diffing.+--+-- @since 1.10.0.0+fragment_ :: MisoString -> [View model action] -> View model action+fragment_ key = VFrag (Just (Key key))+-----------------------------------------------------------------------------+-- | t'Miso.Types.Component' mounting combinator+--+-- Used in the @view@ function to mount a t'Miso.Types.Component' on any 'VNode'.+--+-- @+-- "component-id" +> component model noop $ \\m ->+--   div_ [ id_ "foo" ] [ text (ms m) ]+-- @+--+-- @since 1.9.0.0+(+>)+  :: forall child childAction model action . Eq child+  => MisoString+  -- ^ 'VComp' 'key_'+  -> Component model () child childAction+  -- ^ 'Component'+  -> View model action+infixr 0 +>+key +> comp = VComp (Just (toKey key)) (SomeComponent () comp)+-----------------------------------------------------------------------------+-- | t'Miso.Types.Component' mounting combinator.+--+-- Note: only use this if you're certain you won't be diffing two t'Miso.Types.Component'+-- against each other. Otherwise, you will need a key to distinguish between+-- the two t'Miso.Types.Component', to ensure unmounting and mounting occurs.+--+-- @+-- mountWithProps someProps $ component model noop $ \\m ->+--  div_ [ id_ "foo" ] [ text (ms m) ]+-- @+--+-- @since 1.11.0.0+mountWithProps+  :: (Eq child, Eq props)+  => props+  -- ^ 'props' to use+  -> Component parent props child action+  -- ^ 'Component' to mount+  -> View parent a+mountWithProps props comp  = VComp Nothing (SomeComponent props comp)+-----------------------------------------------------------------------------+-- | t'Miso.Types.Component' mounting combinator.+--+-- @+-- mountWithProps_ "key" someProps $ component model noop $ \\m ->+--  div_ [ id_ "foo" ] [ text (ms m) ]+-- @+--+-- @since 1.11.0.0+mountWithProps_+  :: (Eq child, Eq props)+  => MisoString+  -- ^ 'key' to use+  -> props+  -- ^ 'props' to use+  -> Component parent props child action+  -- ^ 'Component' to mount+  -> View parent a+mountWithProps_ key props comp  = VComp (Just (Key key)) (SomeComponent props comp)+-----------------------------------------------------------------------------+-- | t'Miso.Types.Component' mounting combinator.+--+-- Note: only use this if you're certain you won't be diffing two t'Miso.Types.Component'+-- against each other. Otherwise, you will need a key to distinguish between+-- the two t'Miso.Types.Component', to ensure unmounting and mounting occurs.+--+-- @+-- mount_ $ component model noop $ \\m ->+--  div_ [ id_ "foo" ] [ text (ms m) ]+-- @+--+-- @since 1.9.0.0+mount_+  :: Eq child+  => Component parent () child childAction+  -- ^ 'Component' to mount+  -> View parent action+mount_ comp = VComp Nothing (SomeComponent () comp)+-----------------------------------------------------------------------------+-- | DOM element namespace.+data Namespace+  = HTML+  -- ^ HTML Namespace+  | SVG+  -- ^ SVG Namespace+  | MATHML+  -- ^ MATHML Namespace+  deriving (Show, Eq)+-----------------------------------------------------------------------------+instance ToJSVal Namespace where+  toJSVal = \case+    SVG -> toJSVal ("svg" :: MisoString)+    HTML -> toJSVal ("html" :: MisoString)+    MATHML -> toJSVal ("mathml" :: MisoString)+-----------------------------------------------------------------------------+-- | Unique key for a DOM node.+--+-- This key is only used to speed up diffing the children of a DOM+-- node, the actual content is not important. The keys of the children+-- of a given DOM node must be unique. Failure to satisfy this+-- invariant gives undefined behavior at runtime.+newtype Key = Key MisoString+  deriving newtype (Show, Eq, IsString, ToJSON, ToMisoString)+-----------------------------------------------------------------------------+-- | ToJSVal instance for t'Key'+instance ToJSVal Key where+  toJSVal (Key x) = toJSVal x+-----------------------------------------------------------------------------+-- | Convert custom key types to t'Key'.+--+-- Instances of this class do not have to guarantee uniqueness of the+-- generated keys, it is up to the user to do so. @toKey@ must be an+-- injective function (different inputs must map to different outputs).+class ToKey key where+  -- | Converts any key into t'Key'+  toKey :: key -> Key+-----------------------------------------------------------------------------+-- | Identity instance+instance ToKey Key where toKey = id+-----------------------------------------------------------------------------+#ifndef VANILLA+-- | Convert 'MisoString' to t'Key'+instance ToKey MisoString where toKey = Key+#endif+-----------------------------------------------------------------------------+-- | Convert 'T.Text' to t'Key'+instance ToKey T.Text where toKey = Key . toMisoString+-----------------------------------------------------------------------------+-- | Convert 'String' to t'Key'+instance ToKey String where toKey = Key . toMisoString+-----------------------------------------------------------------------------+-- | Convert 'Int' to t'Key'+instance ToKey Int where toKey = Key . toMisoString+-----------------------------------------------------------------------------+-- | Convert 'Double' to t'Key'+instance ToKey Double where toKey = Key . toMisoString+-----------------------------------------------------------------------------+-- | Convert 'Float' to t'Key'+instance ToKey Float where toKey = Key . toMisoString+-----------------------------------------------------------------------------+-- | Convert 'Word' to t'Key'+instance ToKey Word where toKey = Key . toMisoString+-----------------------------------------------------------------------------+-- | Attribute of a vnode in a t'View'.+--+data Attribute action+  = Property MisoString Value+  | ClassList [MisoString]+  | On (Sink action -> VTree -> LogLevel -> Events -> IO ())+  -- ^ The @Sink@ callback can be used to dispatch actions which are fed back to+  -- the @update@ function. This is especially useful for event handlers+  -- like the @onclick@ attribute. The second argument represents the+  -- vnode the attribute is attached to.+  | Styles (M.Map MisoString MisoString)+  deriving Functor+-----------------------------------------------------------------------------+instance Eq (Attribute action) where+  Property k1 v1 == Property k2 v2 = k1 == k2 && v1 == v2+  ClassList x == ClassList y = x == y+  Styles x == Styles y = x == y+  _ == _ = False+-----------------------------------------------------------------------------+instance Show (Attribute action) where+  show = \case+    Property key value ->+      MS.unpack key <> "=" <> MS.unpack (ms (encode value))+    ClassList classes ->+      MS.unpack (MS.intercalate " " classes)+    On _ ->+      "<event-handler>"+    Styles styles ->+      MS.unpack $ MS.concat+        [ k <> "=" <> v <> ";"+        | (k, v) <- M.toList styles+        ]+-----------------------------------------------------------------------------+-- | 'IsString' instance+instance IsString (View model action) where+  fromString = VText Nothing . fromString+-----------------------------------------------------------------------------+-- | 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+  -- ^ Underlying JavaScript object representing the virtual DOM tree+  } deriving newtype (ToObject, ToJSVal)+-----------------------------------------------------------------------------+-- | Create a new 'Miso.Types.VNode'.+--+-- @node ns tag attrs children@ creates a new node with tag @tag@+-- in the namespace @ns@. All @attrs@ are called when+-- 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+-----------------------------------------------------------------------------+-- | Create a new 'Miso.Types.VNode'.+--+-- Synonym for 'node'+--+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+-----------------------------------------------------------------------------+-- | Create a new v'VText' with the given content.+text :: MisoString -> View model action+#ifdef SSR+text = VText Nothing . htmlEncode+#else+text = VText Nothing+#endif+-----------------------------------------------------------------------------+-- | Synonym for 'text'+vtext :: MisoString -> View model action+vtext = text+----------------------------------------------------------------------------+-- | Create a new v'VText', not subject to HTML escaping.+--+-- Like 'text', except will not escape HTML when used on the server.+--+textRaw :: MisoString -> View model action+textRaw = VText Nothing+----------------------------------------------------------------------------+-- |+-- HTML-encodes text.+--+-- Useful for escaping HTML when delivering on the server. Naive usage+-- of 'text' will ensure this as well.+--+-- >>> Data.Text.IO.putStrLn $ text "<a href=\"\">"+-- &lt;a href=&quot;&quot;&gt;+htmlEncode :: MisoString -> MisoString+htmlEncode = MS.concatMap $ \case+  '<' -> "&lt;"+  '>' -> "&gt;"+  '&' -> "&amp;"+  '"' -> "&quot;"+  '\'' -> "&#39;"+  x -> MS.singleton x+-----------------------------------------------------------------------------+-- | Create a new v'VText' containing concatenation of the given strings.+--+-- @+--   view :: View model action+--   view = div_+--     [ className "container" ]+--     [ text_+--       [ "foo"+--       , "bar"+--       ]+--     ]+-- @+--+-- Renders as @<div class="container">foo bar</div>@+--+-- A single additional space is added between elements.+--+text_ :: [MisoString] -> View model action+text_ = VText Nothing . MS.intercalate " "+-----------------------------------------------------------------------------+-- | Like 'text', but allow the node to be keyed for efficient diffing.+--+-- @+-- view :: model -> View model action+-- view = \x -> div_ [] [ textKey (1 :: Int) "text here" ]+-- @+--+-- @since 1.9.0.0+textKey :: ToKey key => key -> MisoString -> View model action+textKey k = VText (Just (toKey k))+-----------------------------------------------------------------------------+-- | Like 'text_', but allow the node to be keyed for efficient diffing.+--+-- @+-- view :: model -> View model action+-- view = \x -> div_ [] [ textKey_ (1 :: Int) [ "text", "goes", "here" ] ]+-- @+--+-- @since 1.9.0.0+textKey_ :: ToKey key => key -> [MisoString] -> View model action+textKey_ k xs = VText (Just (toKey k)) (MS.intercalate " " xs)+-----------------------------------------------------------------------------+-- | Utility function to make it easy to specify conditional attributes+--+-- @+-- view :: Bool -> View model action+-- view danger = optionalAttrs div_ [ id_ "some-div" ] danger [ class_ "danger" ] ["child"]+-- @+--+-- @since 1.9.0.0+optionalAttrs+  :: ([Attribute action] -> [View model action] -> View model action)+  -> [Attribute action] -- ^ Attributes to be added unconditionally+  -> Bool -- ^ A condition+  -> [Attribute action] -- ^ Additional attributes to add if the condition is True+  -> [View model action] -- ^ Children+  -> View model action+optionalAttrs element attrs condition opts kids =+  case element attrs kids of+    VNode ns name _ _ -> do+      let newAttrs = concat [ opts | condition ] ++ attrs+      VNode ns name newAttrs kids+    x -> x+-----------------------------------------------------------------------------+-- | Utility function to make it easy to specify conditional attributes for void elements.+--+-- @+-- view :: Bool -> View model action+-- view shouldClear = optionalVoidAttrs textarea_ [ value_ "" ] shouldClear [ id_ "text-area-id" ]+-- @+--+-- @since 1.9.0.0+optionalVoidAttrs+  :: ([Attribute action] -> View model action)+  -> [Attribute action] -- ^ Attributes to be added unconditionally+  -> Bool -- ^ A condition+  -> [Attribute action] -- ^ Additional attributes to add if the condition is True+  -> View model action+optionalVoidAttrs element attrs condition opts =+  case element attrs of+    VNode ns name _ kids -> do+      let newAttrs = concat [ opts | condition ] ++ attrs+      VNode ns name newAttrs kids+    x -> x+----------------------------------------------------------------------------+-- | Conditionally adds children.+--+-- @+-- view :: Bool -> View model action+-- view withChild = optionalChildren div_ [ id_ "txt" ] [] withChild [ "foo" ]+-- @+--+-- @since 1.9.0.0+optionalChildren+  :: ([Attribute action] -> [View model action] -> View model action)+  -> [Attribute action] -- ^ Attributes to be added unconditionally+  -> [View model action] -- ^ Children to be added unconditionally+  -> Bool -- ^ A condition+  -> [View model action] -- ^ Additional children to add if the condition is True+  -> View model action+optionalChildren element attrs kids condition opts =+  case element attrs kids of+    VNode ns name _ _ -> do+      let newKids = kids ++ concat [ opts | condition ]+      VNode ns name attrs newKids+    x -> x+----------------------------------------------------------------------------+-- | URI type. See the official [specification](https://www.rfc-editor.org/rfc/rfc3986)+--+data URI+  = URI+  { 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)+----------------------------------------------------------------------------+-- | Empty t'URI'.+emptyURI :: URI+emptyURI = URI mempty mempty mempty+----------------------------------------------------------------------------+instance ToMisoString URI where+  toMisoString = prettyURI+----------------------------------------------------------------------------+instance ToJSON URI where+  toJSON = toJSON . toMisoString+----------------------------------------------------------------------------+-- | Pretty-prints a t'URI'.+prettyURI :: URI -> MisoString+prettyURI uri@URI {..} = "/" <> uriPath <> prettyQueryString uri <> uriFragment+-----------------------------------------------------------------------------+-- | Pretty-prints a t'URI' query string.+prettyQueryString :: URI -> MisoString+prettyQueryString URI {..} = queries <> flags+  where+    queries =+      MS.concat+      [ "?" <>+        MS.intercalate "&"+        [ k <> "=" <> v+        | (k, Just v) <- M.toList uriQueryString+        ]+      | any isJust (M.elems uriQueryString)+      ]+    flags = mconcat+        [ "?" <> k+        | (k, Nothing) <- M.toList uriQueryString+        ]+-----------------------------------------------------------------------------+-- | VTreeType ADT for matching TypeScript enum+data VTreeType+  = VCompType+  | VNodeType+  | VTextType+  | VFragType+  deriving (Show, Eq)+-----------------------------------------------------------------------------+instance ToJSVal VTreeType where+  toJSVal = \case+    VCompType -> toJSVal (0 :: Int)+    VNodeType -> toJSVal (1 :: Int)+    VTextType -> toJSVal (2 :: Int)+    VFragType -> toJSVal (3 :: Int)+-----------------------------------------------------------------------------
src/Miso/Util.hs view
@@ -1,22 +1,81 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Miso.Util--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- Stability   :  experimental -- Portability :  non-portable+--+-- = 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   , conditionalViews+  , oneOf+  , enclosed+  , optionalDefault+  , exists+  , sepBy1+  , sepBy+  , between   , (=:)+  , compose   ) where--import Data.Foldable-import qualified Data.Map as M-import Miso.Html (View)-+-----------------------------------------------------------------------------+import           Control.Category+import           Data.Maybe (isJust, fromMaybe)+import           Control.Applicative (Alternative, many, empty, (<|>), optional)+import           Data.Foldable (toList)+import           Prelude hiding ((.))+----------------------------------------------------------------------------- -- | Generic @map@ function, useful for creating @View@s from the elements of -- some @Foldable@. Particularly handy for @Maybe@, as shown in the example -- below.@@ -24,25 +83,139 @@ -- @ -- view model = --     div_ [] $---      withFoldable (model ^. mSomeMaybeVal) $ \someVal ->+--      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)---- | Hides the @View@s the condition is False. Shows them when the condition+-----------------------------------------------------------------------------+-- | Conditionally includes views.+-- Hides the 'Miso.Types.View's if the condition is False. Shows them when the condition -- is True.-conditionalViews :: Bool -> [View action] -> [View action]+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     else []---- | Smart constructor for Attributes. This function is helpful when constructing numerous Attributes--- Example shown below.--- --- @ --- div_ [ style_  $ ("background" =: "red" <> "width" =: "250px" <> "height" =: "250px") ] []+-----------------------------------------------------------------------------+-- | Selects the first 'Alternative', analogous to 'Data.Foldable.asum'.+oneOf :: Alternative f => [f a] -> f a+oneOf = foldr (<|>) empty+----------------------------------------------------------------------------+-- | Convenience function for constructing parser / lexer combinators.+-- -- @-(=:) :: k -> a -> M.Map k a -a =: b = M.singleton a b+-- test :: Parser a -> Parser a+-- test = enclosed (char '(') (char ')')+-- @+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+-- in the case of parser / lexer failure.+--+-- @+-- test :: Parser MisoString+-- test = optionalDefault "foo" (string "bar")+-- @+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.+--+-- @+-- test :: Parser Bool+-- test = exists (string "foo")+-- @+exists :: Alternative f => f a -> f Bool+exists p = isJust <$> optional p+----------------------------------------------------------------------------+-- | Interleaves one parser combinator with another, must have at least one+-- successful parse.+--+-- @+-- test :: Parser [Int]+-- test = sepBy1 (char ',') number+-- @+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+-- parses.+--+-- @+-- test :: Parser [Int]+-- test = sepBy (char ',') number+-- @+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+--+-- @+-- test :: Parser (Int, Int)+-- test = between (char '*') number number+-- -- 5*5+-- @+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.+--+(=:) :: k -> v -> (k, v)+k =: v = (k,v)+----------------------------------------------------------------------------+-- | Function composition generalized to 'Category'+--+-- @+-- test :: Int -> Int+-- test = (+1) \`compose\` (+1)+-- @+compose :: Category cat => cat a b -> cat b c -> cat a c+compose = flip (.)+----------------------------------------------------------------------------
+ src/Miso/Util/Lexer.hs view
@@ -0,0 +1,339 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Util.Lexer+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- 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+    Lexer (..)+  , Stream (..)+  , Located (..)+  , Location (..)+  , LexerError (..)+    -- ** Combinators+  , getStartColumn+  , zeroLocation+  , initialLocation+  , mkStream+  , oops+  , streamError+  , string+  , string'+  , char+  , satisfy+  , peek+  , getInput+  , putInput+  , getLocation+  , setLocation+  , modifyInput+  , withLocation+  ) where+----------------------------------------------------------------------------+import           Control.Monad+#if __GLASGOW_HASKELL__ <= 865+import           Control.Monad.Fail+#endif+import           Control.Applicative+----------------------------------------------------------------------------+import           Miso.String (MisoString, ToMisoString)+import qualified Miso.String as MS+----------------------------------------------------------------------------+-- | Potential errors during lexing+data LexerError+  = LexerError MisoString Location+  | UnexpectedEOF Location+  deriving (Eq)+----------------------------------------------------------------------------+instance Show LexerError where+  show (UnexpectedEOF loc) =+    "Unexpected EOF at: " <> show loc+  show (LexerError xs loc) =+    "Unexpected \"" <> take 5 (MS.unpack xs) <> "\"... at " <> show loc+----------------------------------------------------------------------------+-- | Type to hold the location (line and column) of a Token+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+  show (Location l col) = show l <> " " <> show col+----------------------------------------------------------------------------+-- | Helper for extracting column from t'Location'+getStartColumn :: Location -> Int+getStartColumn = fst . column+----------------------------------------------------------------------------+-- | Initial t'Location'+initialLocation :: Location+initialLocation = Location 1 (1,1)+----------------------------------------------------------------------------+-- | Empty t'Location'+zeroLocation :: Location+zeroLocation = Location 0 (0,0)+----------------------------------------------------------------------------+-- | A Lexer is a state monad with optional failure the abides by the+-- maximal munch rule in its 'Alternative' instance.+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+oops :: Lexer token+oops = Lexer $ \s -> Left (streamError s)+----------------------------------------------------------------------------+-- | Smart constructor for t'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+  -- ^ Input text to lex+  -> Stream+mkStream xs = Stream xs initialLocation+----------------------------------------------------------------------------+-- | A t'Stream' of text used as input to lexing+data Stream+  = Stream+  { stream :: MisoString+    -- ^ Current t'Stream' of text+  , currentLocation :: Location+    -- ^ current t'Location' in the t'Stream'+  } deriving Eq+----------------------------------------------------------------------------+-- | A t'Located' token holds the lexed output the t'Location' at which+-- the successful lex occurred.+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+  show (Located t l) = show l <> " " <> show t+----------------------------------------------------------------------------+instance Functor Lexer where+  fmap f (Lexer l) = Lexer $ \input -> do+    (t, x) <- l input+    pure (f t, x)+----------------------------------------------------------------------------+instance Applicative Lexer where+  pure x = Lexer $ \input -> pure (x, input)+  Lexer l1 <*> Lexer l2 = Lexer $ \input -> do+    (f, x) <- l1 input+    (a, y) <- l2 x+    pure (f a, y)+----------------------------------------------------------------------------+instance Monad Lexer where+  m >>= f = Lexer $ \input -> do+    (x, s) <- runLexer m input+    runLexer (f x) s+----------------------------------------------------------------------------+instance MonadFail Lexer where+  fail _ = oops+----------------------------------------------------------------------------+instance Alternative Lexer where+  empty = Lexer $ \(Stream s l)  -> Left (unexpected s l)+  Lexer l1 <|> Lexer l2 = Lexer $ \input ->+    case (l1 input, l2 input) of+      (res, Left _) -> res+      (Left _, res) -> res+      (Right (x, Stream s sl), Right (y,Stream t tl)) ->+        if MS.length s <= MS.length t+        then Right (x, Stream s sl)+        else Right (y, Stream t tl)+----------------------------------------------------------------------------+instance MonadPlus Lexer where+  mplus = (<|>)+----------------------------------------------------------------------------+-- | Fetches the first character in the t'Stream', does not consume input+peek :: Lexer (Maybe Char)+peek = Lexer $ \ys ->+  pure $ case ys of+    Stream xs l ->+      case MS.uncons xs of+        Nothing -> (Nothing, Stream mempty l)+        Just (z,zs) -> (Just z, Stream (MS.singleton z <> zs) l)+----------------------------------------------------------------------------+-- | Predicate combinator that consumes matching input+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 ->+      case MS.uncons s of+        Nothing -> Left (unexpected s l)+        Just (z,zs)+          | predicate z -> Right (z, Stream zs l)+          | otherwise -> Left (unexpected zs l)+----------------------------------------------------------------------------+-- | Smart constructor for t'LexerError'+-- If the input is empty, an 'UnexpectedEOF' is issued.+unexpected :: MisoString -> Location -> LexerError+unexpected xs loc | MS.null xs = UnexpectedEOF loc+unexpected cs loc = LexerError cs loc+----------------------------------------------------------------------------+-- | Retrieves current input from t'Lexer'+getInput :: Lexer Stream+getInput = Lexer $ \s -> Right (s, s)+----------------------------------------------------------------------------+-- | Overrides current t'Stream' in t'Lexer' to user-specified t'Stream'.+putInput+  :: Stream+  -- ^ Replacement stream; replaces the current lexer input+  -> Lexer ()+putInput s = Lexer $ \_ -> Right ((), s)+----------------------------------------------------------------------------+-- | Retrieves the current t'Stream' t'Location'+getLocation :: Lexer Location+getLocation = Lexer $ \(Stream s l) -> pure (l, Stream s l)+----------------------------------------------------------------------------+-- | Sets the current t'Stream' t'Location'+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)+  -- ^ 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+  -- ^ The exact character to consume+  -> Lexer Char+char c = satisfy (== c)+----------------------------------------------------------------------------+-- | Lexer combinator for matching a 'String'+string'+  :: String+  -- ^ Literal string prefix to consume character by character+  -> Lexer String+string' = traverse char+----------------------------------------------------------------------------+-- | Lexer combinator for matching a 'MisoString'+string+  :: MisoString+  -- ^ Literal string prefix to consume from the input+  -> Lexer MisoString+string prefix = Lexer $ \s ->+  case s of+    Stream ys l+      | prefix `MS.isPrefixOf` ys ->+          Right (prefix, Stream (MS.drop (MS.length prefix) ys) l)+      | otherwise ->+          Left (unexpected ys l)+----------------------------------------------------------------------------+-- | Lexer combinator for executing a t'Lexer' with annotated t'Location' information+withLocation+  :: ToMisoString token+  => Lexer token+  -- ^ Inner lexer whose result is wrapped with its source 'Location'+  -> Lexer (Located token)+withLocation lexer = do+  result <- lexer+  let+    adjustLoc :: Location -> MisoString -> Location+    adjustLoc l = MS.foldl' adjust (next l)++  setLocation =<< adjustLoc <$> getLocation <*> pure (MS.ms result)+  Located result <$> getLocation+    where+      next :: Location -> Location+      next (Location l (_, end)) = Location l (end, end)++      adjust :: Location -> Char -> Location+      adjust (Location l (_, _)) '\n'       = Location (l + 1) (1,1)+      adjust (Location l (start, end)) '\t' = Location l (start, end + 8)+      adjust (Location l (start, end))   _  = Location l (start, end + 1)+----------------------------------------------------------------------------
+ src/Miso/Util/Parser.hs view
@@ -0,0 +1,234 @@+-----------------------------------------------------------------------------+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE CPP                  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Miso.Util.Parser+-- Copyright   :  (C) 2016-2026 David M. Johnson+-- License     :  BSD3-style (see the file LICENSE)+-- Maintainer  :  David M. Johnson <code@dmj.io>+-- 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+    Parser+  , ParserT (..)+  , ParseError (..)+    -- ** Combinators+  , parse+  , anyToken+  , satisfy+  , peek+  , token_+  , errorOut+  , allTokens+  , modifyTokens+  , askParser+  , endOfInput+  ) where+----------------------------------------------------------------------------+#if __GLASGOW_HASKELL__ <= 881+import           Control.Monad.Fail (MonadFail (..))+#endif+import           Control.Applicative+import           Control.Monad+import           Data.Maybe (isNothing)+----------------------------------------------------------------------------+import           Miso.Util.Lexer (LexerError)+----------------------------------------------------------------------------+-- | A type for expressing failure during parsing.+data ParseError a token+  = UnexpectedParse [token]+  | LexicalError LexerError+  | Ambiguous [(a, [token])]+  | NoParses token+  | EmptyStream+  deriving (Show, Eq)+----------------------------------------------------------------------------+-- | Executes a parser against a series of tokens.+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+    []        -> Left (NoParses (last tokens))+    [(x, [])] -> Right x+    [(_, xs)] -> Left (UnexpectedParse xs)+    xs        -> Left (Ambiguous xs)+----------------------------------------------------------------------------+-- | Convenience synonym when defining parser combinators+type Parser token a = ParserT () [token] [] a+----------------------------------------------------------------------------+-- | Core type for parsing+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+  fmap f (Parser run) = Parser $ \r input ->+    case run r input of+      tokens -> [ (f x, toks) | (x, toks) <- tokens ]+----------------------------------------------------------------------------+instance Applicative (ParserT r token []) where+  pure x = Parser $ \_ s -> pure (x,s)+  Parser f <*> Parser g = Parser $ \r input -> do+    (k, s) <- f r input+    (x, t) <- g r s+    pure (k x, t)+----------------------------------------------------------------------------+instance Alternative (ParserT r token []) where+  empty = Parser $ \_ _ -> []+  Parser f <|> Parser g =+    Parser $ \r tokens ->+      case f r tokens of+        [] -> g r tokens+        x  -> x+----------------------------------------------------------------------------+instance Monad (ParserT r token []) where+  return = pure+  Parser f >>= k = Parser $ \r tokens -> do+    (x, tokens') <- f r tokens+    runParserT (k x) r tokens'+----------------------------------------------------------------------------+instance MonadFail (ParserT r token []) where+  fail _ = empty+----------------------------------------------------------------------------+instance MonadPlus (ParserT r token [])+----------------------------------------------------------------------------+-- | Match any token.+anyToken :: ParserT r [a] [] a+anyToken = Parser $ \_ input ->+  case input of+    t : ts -> [(t, ts)]+    _ -> []+----------------------------------------------------------------------------+-- | Succeeds for any token for which the predicate @f@ returns 'True'.+-- Returns the parsed token.+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)+  pure t+----------------------------------------------------------------------------+-- | Succeeds if the next token in the stream matches the given one.+-- Returns the parsed token.+token_+  :: Eq token+  => token+  -- ^ Expected token value+  -> Parser token token+token_ t = satisfy (==t)+----------------------------------------------------------------------------+-- | Returns all input from a parser+allTokens :: ParserT r a [] a+allTokens = Parser $ \_ input -> [(input, input)]+----------------------------------------------------------------------------+-- | Modifies tokens+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+askParser :: ParserT r token [] r+askParser = Parser $ \r input -> [(r, input)]+----------------------------------------------------------------------------+-- | Views the next token without consuming input+peek :: Parser a a+peek = Parser $ \_ tokens ->+  case tokens of+    [] -> []+    (x:xs) -> [(x, x:xs)]+----------------------------------------------------------------------------+-- | Parser combinator that always fails+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.+endOfInput :: Parser a ()+endOfInput = guard . isNothing =<< optional anyToken+----------------------------------------------------------------------------
src/Miso/WebSocket.hs view
@@ -1,105 +1,299 @@+-----------------------------------------------------------------------------+{-# LANGUAGE TypeApplications           #-} {-# LANGUAGE CPP                        #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE RankNTypes                 #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module      :  Miso.WebSocket--- Copyright   :  (C) 2016-2018 David M. Johnson+-- Copyright   :  (C) 2016-2026 David M. Johnson -- License     :  BSD3-style (see the file LICENSE)--- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>+-- Maintainer  :  David M. Johnson <code@dmj.io> -- Stability   :  experimental -- Portability :  non-portable+--+-- = Overview+--+-- "Miso.WebSocket" provides a full-duplex+-- <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket WebSocket>+-- 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+--   <https://developer.mozilla.org/en-US/docs/Web/API/CloseEvent/code RFC 6455>.+-- * '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-  ( -- * Types-    WebSocket   (..)-  , URL         (..)-  , Protocols   (..)+  ( -- *** t'WebSocket'+    connect+  , connectJSON+  , connectText+  , connectBLOB+  , connectArrayBuffer+  , sendText+  , sendJSON+  , sendBLOB+  , sendArrayBuffer+  , close+  , socketState+  -- *** Defaults+  , emptyWebSocket+  -- *** Types+  , WebSocket   (..)+  , URL   , SocketState (..)   , CloseCode   (..)-  , WasClean    (..)-  , Reason      (..)+  , Closed      (..)+  , Payload     (..)+  , Blob        (..)+  , ArrayBuffer (..)   ) where--import GHC.Generics-import Prelude                hiding (map)-#ifdef __GHCJS__-import GHCJS.Marshal-#endif--import Miso.String---- | WebSocket connection messages-data WebSocket action-  = WebSocketMessage action-  | WebSocketClose CloseCode WasClean Reason-  | WebSocketOpen-  | WebSocketError MisoString-    deriving (Show, Eq)---- | URL of Websocket server-newtype URL = URL MisoString-  deriving (Show, Eq)---- | Protocols for Websocket connection-newtype Protocols = Protocols [MisoString]-  deriving (Show, Eq)---- | Wether or not the connection closed was done so cleanly-newtype WasClean = WasClean Bool deriving (Show, Eq)---- | Reason for closed connection-newtype Reason = Reason MisoString deriving (Show, Eq)---- | `SocketState` corresponding to current WebSocket connection-data SocketState-  = CONNECTING -- ^ 0-  | OPEN       -- ^ 1-  | CLOSING    -- ^ 2-  | CLOSED     -- ^ 3-  deriving (Show, Eq, Ord, Enum)---- | Code corresponding to a closed connection--- https://developer.mozilla.org/en-US/docs/Web/API/CloseEvent-data CloseCode-  = CLOSE_NORMAL-   -- ^ 1000, Normal closure; the connection successfully completed whatever purpose for which it was created.-  | CLOSE_GOING_AWAY-   -- ^ 1001, The endpoint is going away, either because of a server failure or because the browser is navigating away from the page that opened the connection.-  | CLOSE_PROTOCOL_ERROR-   -- ^ 1002, The endpoint is terminating the connection due to a protocol error.-  | CLOSE_UNSUPPORTED-   -- ^ 1003, The connection is being terminated because the endpoint received data of a type it cannot accept (for example, a textonly endpoint received binary data).-  | CLOSE_NO_STATUS-   -- ^ 1005, Reserved.  Indicates that no status code was provided even though one was expected.-  | CLOSE_ABNORMAL-   -- ^ 1006, Reserved. Used to indicate that a connection was closed abnormally (that is, with no close frame being sent) when a status code is expected.-  | Unsupported_Data-   -- ^ 1007, The endpoint is terminating the connection because a message was received that contained inconsistent data (e.g., nonUTF8 data within a text message).-  | Policy_Violation-   -- ^ 1008, The endpoint is terminating the connection because it received a message that violates its policy. This is a generic status code, used when codes 1003 and 1009 are not suitable.-  | CLOSE_TOO_LARGE-   -- ^ 1009, The endpoint is terminating the connection because a data frame was received that is too large.-  | Missing_Extension-   -- ^ 1010, The client is terminating the connection because it expected the server to negotiate one or more extension, but the server didn't.-  | Internal_Error-   -- ^ 1011, The server is terminating the connection because it encountered an unexpected condition that prevented it from fulfilling the request.-  | Service_Restart-   -- ^ 1012, The server is terminating the connection because it is restarting.-  | Try_Again_Later-   -- ^ 1013, The server is terminating the connection due to a temporary condition, e.g. it is overloaded and is casting off some of its clients.-  | TLS_Handshake-   -- ^ 1015, Reserved. Indicates that the connection was closed due to a failure to perform a TLS handshake (e.g., the server certificate can't be verified).-  | OtherCode Int-   -- ^ OtherCode that is reserved and not in the range 0999-  deriving (Show, Eq, Generic)--#ifdef __GHCJS__--- Defined here to avoid an orphan instance-instance ToJSVal CloseCode-instance FromJSVal CloseCode-#endif+-----------------------------------------------------------------------------+import           Miso.Effect+import           Miso.JSON+import           Miso.Runtime+import           Miso.String (MisoString)+import           Miso.FFI (Blob(..), ArrayBuffer(..))+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket>+--+-- Establishes a t'WebSocket' server that receives potentially multiple different t'Payload'.+--+-- It's more common to use 'connectJSON' or 'connectText'. But 'connect' can be used to received multiple+-- different kinds of data from a t'WebSocket' server.+--+connect+  :: FromJSON json+  => URL+  -- ^ URL endpoint for a t'WebSocket' connection+  -> (WebSocket -> action)+  -- ^ @onOpen@ callback w/ t'WebSocket' object for successful connection. t'WebSocket' is used here to send messages.+  -> (Closed -> action)+  -- ^ @onClosed@ method that is called when a t'WebSocket' connection has closed.+  -> (Payload json -> action)+  -- ^ @onMessage@ is a callback invoked when a message has been received from the t'WebSocket' server.+  -> (MisoString -> action)+  -- ^ Error message callback+  -> Effect parent props model action+connect = websocketConnect+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket>+--+-- Establishes a t'WebSocket' server that assumes a JSON-encoded protocol.+--+connectJSON+  :: FromJSON json+  => URL+  -- ^ URL endpoint for a t'WebSocket' connection+  -> (WebSocket -> action)+  -- ^ @onOpen@ callback w/ t'WebSocket' object for successful connection. t'WebSocket' is used here to send messages.+  -> (Closed -> action)+  -- ^ @onClosed@ method that is called when a t'WebSocket' connection has closed.+  -> (json -> action)+  -- ^ @onMessage@ is a callback invoked when a JSON-encoded message has been received from the t'WebSocket' server.+  -> (MisoString -> action)+  -- ^ Error message callback+  -> Effect parent props model action+connectJSON = websocketConnectJSON+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket>+--+-- Establishes a t'WebSocket' server that assumes a text-encoded protocol.+--+connectText+  :: URL+  -- ^ URL endpoint for a t'WebSocket' connection+  -> (WebSocket -> action)+  -- ^ @onOpen@ callback w/ t'WebSocket' object for successful connection. t'WebSocket' is used here to send messages.+  -> (Closed -> action)+  -- ^ @onClosed@ method that is called when a t'WebSocket' connection has closed.+  -> (MisoString -> action)+  -- ^ @onMessage@ is a callback invoked when a text-encoded message has been received from the t'WebSocket' server.+  -> (MisoString -> action)+  -- ^ Error message callback+  -> Effect parent props model action+connectText = websocketConnectText+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket>+--+-- Establishes a t'WebSocket' server that assumes a binary-encoded protocol.+--+connectBLOB+  :: URL+  -- ^ URL endpoint for a t'WebSocket' connection+  -> (WebSocket -> action)+  -- ^ @onOpen@ callback w/ t'WebSocket' object for successful connection. t'WebSocket' is used here to send messages.+  -> (Closed -> action)+  -- ^ @onClosed@ method that is called when a t'WebSocket' connection has closed.+  -> (Blob -> action)+  -- ^ @onMessage@ is a callback invoked when a binary-encoded message has been received from the t'WebSocket' server.+  -> (MisoString -> action)+  -- ^ @onError@ callback+  -> Effect parent props model action+connectBLOB = websocketConnectBLOB+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket>+--+-- Establishes a t'WebSocket' server that assumes an t'ArrayBuffer' protocol.+--+connectArrayBuffer+  :: URL+  -- ^ URL endpoint for a t'WebSocket' connection+  -> (WebSocket -> action)+  -- ^ @onOpen@ callback w/ t'WebSocket' object for successful connection. t'WebSocket' is used here to send messages.+  -> (Closed -> action)+  -- ^ @onClosed@ method that is called when a t'WebSocket' connection has closed.+  -> (ArrayBuffer -> action)+  -- ^ @onMessage@ is a callback invoked when an t'ArrayBuffer' message has been received from the t'WebSocket' server.+  -> (MisoString -> action)+  -- ^ @onError@ callback+  -> Effect parent props model action+connectArrayBuffer = websocketConnectArrayBuffer+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/send>+--+-- @+--+-- data Person = Person { name :: MisoString, age :: Int }+--   deriving (Show, Eq)+--+-- instance ToJSON Person where+--   toJSON (Person name age) = object [ "name" .= name, "age" .= age ]+--+-- test :: WebSocket -> Effect parent props model action+-- test connection = do+--   sendJSON (connection :: WebSocket) (Person "alice" 42)+--   sendJSON (connection :: WebSocket) (Person "bob" 42)+--+-- @+--+sendJSON+  :: ToJSON json+  => WebSocket+  -- ^ t'WebSocket' descriptor required to send a message to the server.+  -> json+  -- ^ A JSON-encoded message+  -> Effect parent props model action+sendJSON socket x = websocketSend socket (JSON x)+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/send>+sendBLOB+  :: WebSocket+  -- ^ t'WebSocket' descriptor required to send a message to the server.+  -> Blob+  -- ^ An t'Blob' payload to send to the t'WebSocket' server+  -> Effect parent props model action+sendBLOB socket x = websocketSend @() socket (blob x)+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/send>+sendArrayBuffer+  :: WebSocket+  -- ^ t'WebSocket' descriptor required to send a message to the server.+  -> ArrayBuffer+  -- ^ An t'ArrayBuffer' payload to send to the t'WebSocket' server+  -> Effect parent props model action+sendArrayBuffer socket x = websocketSend @() socket (arrayBuffer x)+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/send>+sendText+  :: WebSocket+  -- ^ t'WebSocket' descriptor required to send a message to the server.+  -> MisoString+  -- ^ A text payload to send to t'WebSocket' server+  -> Effect parent props model action+sendText socket x = websocketSend @() socket (TEXT x)+-----------------------------------------------------------------------------+-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/close>+--+-- It is very important to close the t'WebSocket', otherwise leaks can occur.+--+-- 'close' is a no-op if invoked multiple times.+--+close+  :: WebSocket+  -- ^ t'WebSocket' descriptor required to close the socket on the server.+  -> Effect parent props model action+close = websocketClose+-----------------------------------------------------------------------------
− tests/Main.hs 
@@ -1,178 +0,0 @@-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE BangPatterns             #-}-{-# LANGUAGE ScopedTypeVariables      #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE OverloadedStrings        #-}-{-# LANGUAGE NamedFieldPuns           #-}-module Main where--import           Control.Exception hiding (assert)-import           Control.Monad-import           Control.Monad.IO.Class     (liftIO)-import           Control.Monad.Trans.State-import           Data.Aeson                 hiding (Result(..))-import qualified Data.HashMap.Strict        as H-import           Data.Scientific-import qualified Data.Vector                as V-import           Debug.Trace-import           GHCJS.Marshal-import           GHCJS.Types-import qualified JavaScript.Object.Internal as OI-import           System.IO.Unsafe-import           Test.QuickCheck hiding (total)-import           Test.QuickCheck.Instances-import           Test.QuickCheck.Monadic--import           Miso--instance Arbitrary Value where-  arbitrary = sized sizedArbitraryValue--sizedArbitraryValue :: Int -> Gen Value-sizedArbitraryValue n-  | n <= 0 = oneof [pure Null, bool, number, string]-  | otherwise = resize n' $ oneof [pure Null, bool, string, number, array, object']-  where-    n' = n `div` 2-    bool = Bool <$> arbitrary-    number = Number <$> arbitrary-    string = String <$> arbitrary-    array = Array <$> arbitrary-    object' = Object <$> arbitrary--compareValue :: Value -> Value -> Bool-compareValue (Object x) (Object y) = and $ zipWith compareValue (H.elems x) (H.elems y)-compareValue (Array x) (Array y)   = and $ zipWith compareValue (V.toList x) (V.toList y)-compareValue (String x) (String y) = x == y-compareValue (Bool x) (Bool y)     = x == y-compareValue Null Null             = True-compareValue (Number x) (Number y) = closeEnough x y-compareValue _ _ = False--closeEnough x y-  = let d = max (abs x) (abs y)-        relDiff = if (d == 0.0) then d else abs (x - y) / d-    in relDiff <= 0.00001--main :: IO ()-main = runTests $ do-  storageTests-  roundTripJSVal--storageTests :: TestM ()-storageTests = do-  it "should write to and read from local storage" $ do-    let obj = object [ "foo" .= ("bar" :: String) ]-    setLocalStorage "foo" obj-    Right r <- getLocalStorage "foo"-    r `shouldBe` obj-  it "should write to and read from session storage" $ do-    let obj = object [ "foo" .= ("bar" :: String) ]-    setSessionStorage "foo" obj-    Right r <- getLocalStorage "foo"-    r `shouldBe` obj--roundTripJSVal :: TestM ()-roundTripJSVal =-  it "Should round trip JSVal" $ do-    propTest iso_prop--roundTrip-  :: Value-  -> IO Bool-roundTrip x = do-  Just y <- fromJSVal =<< toJSVal x-  pure $ compareValue x y == True--iso_prop :: Value -> Property-iso_prop = monadicIO . run . roundTrip--propTest :: Testable prop => prop -> IO (Bool, String)-propTest prop = do-  r <- flip quickCheckWithResult prop stdArgs { chatty = False }-  pure $ case r of-    Success { output = o } -> (True, o)-    GaveUp { output = o } -> (False, o)-    Failure { output = o } -> (False, o)-    NoExpectedFailure { output = o } -> (False, o)--foreign import javascript unsafe "window.global_test_results = $1;"-  writeToGlobalObject :: JSVal -> IO ()--runTests :: TestM () -> IO ()-runTests t = do-  results <- toJSVal =<< toResult <$> execStateT t []-  consoleLogJSVal results-  writeToGlobalObject results-    where-      toResult :: [Test] -> TestResult-      toResult xs = TestResult failed' passed' total' duration' xs-        where-          passed'   = length (filter result xs)-          failed'   = length (filter (not . result) xs)-          total'    = length xs-          duration' = sum (map duration xs)--instance ToJSVal TestResult where-  toJSVal t = do-    o@(OI.Object j) <- OI.create-    set "passed" (passed t) o-    set "failed" (failed t) o-    set "total" (total t) o-    set "duration" (duration' t) o-    set "tests" (tests t) o-    pure j--instance ToJSVal Test where-  toJSVal t = do-    o@(OI.Object j) <- OI.create-    set "name" (name t) o-    set "result" (result t) o-    set "message" (message t) o-    set "duration" (duration t) o-    pure j--it :: String -> IO (Bool, String) -> TestM ()-it name test = do-  (result, msg, time) <- liftIO $ (do-     ((x,msg),t) <- clock test-     pure (x,msg,t))-      `catch` (\(e :: SomeException) ->-         pure (False, show e, 0))-  modify (Test name result msg time:)--data TestResult-  = TestResult-  { failed :: Int-  , passed :: Int-  , total :: Int-  , duration' :: Double-  , tests :: [Test]-  } deriving (Show, Eq)--data Test-  = Test-  { name :: String-  , result :: Bool-  , message :: String-  , duration :: Double-  } deriving (Show, Eq)--type TestM a = StateT [Test] IO a--shouldBe :: (Show a, Eq a, Applicative f) => a -> a -> f (Bool, String)-shouldBe x y =-  pure $-    if x == y-      then (True, mempty)-      else (False, "Expecting: " ++ show y ++ " but got: " ++ show x)--infix 0 `shouldBe`---- | Measure in seconds-clock :: IO a -> IO (a, Double)-clock action = do-  start <- now-  x <- action-  stop <- now-  pure (x, (stop - start) / 1000)