Repository: fable-elmish/elmish
Branch: v5.x
Commit: 2f2312b78240
Files: 50
Total size: 133.1 KB
Directory structure:
gitextract_g05siaj6/
├── .gitattributes
├── .github/
│ ├── CONTRIBUTING.md
│ ├── ISSUE_TEMPLATE.md
│ └── workflows/
│ ├── ci.yml
│ └── publish.yml
├── .gitignore
├── .nacara/
│ └── _partials/
│ └── footer.js
├── .npmrc
├── .vscode/
│ ├── settings.json
│ └── tasks.json
├── Elmish.slnx
├── LICENSE.md
├── README.md
├── RELEASE_NOTES.md
├── appveyor.yml
├── babel.config.json
├── build.fsx
├── docs/
│ ├── _partials/
│ │ └── footer.jsx
│ ├── docs/
│ │ ├── basics.fsx
│ │ ├── menu.json
│ │ ├── parent-child.fsx
│ │ ├── subscription.fsx
│ │ └── subscriptionv3.fsx
│ ├── index.md
│ ├── release_notes.md
│ ├── scss/
│ │ └── fable-font.scss
│ ├── static/
│ │ └── img/
│ │ ├── commands.wsd
│ │ ├── flow.wsd
│ │ └── parent-child.wsd
│ └── style.scss
├── global.json
├── nacara.config.json
├── netstandard/
│ └── Elmish.fsproj
├── package.json
├── src/
│ ├── Fable.Elmish.fsproj
│ ├── cmd.fs
│ ├── cmd.obsolete.fs
│ ├── prelude.fs
│ ├── program.fs
│ ├── ring.fs
│ └── sub.fs
├── tests/
│ ├── Attributes.fs
│ ├── CmdTests.fs
│ ├── Elmish.Tests.fsproj
│ ├── ProgramTest.fs
│ ├── RingTest.fs
│ └── SubTests.fs
└── websharper/
├── WebSharper.Elmish.fsproj
├── prelude.fs
└── wsconfig.json
================================================
FILE CONTENTS
================================================
================================================
FILE: .gitattributes
================================================
* text=auto
================================================
FILE: .github/CONTRIBUTING.md
================================================
### Contributor guidelines
First of all - thanks for taking the time to contribute!
With that in mind, elmish is a young project and as such while we welcome the contributions from non-member there are certain things we'd like to get more right than fast. To make everyone's experience as enjoyable as possible please keep the following things in mind:
* Unless it's a trivial fix, consider opening an issue first to discuss it with the team.
* If you are just looking for something to take on, check the [help wanted](/elmish/elmish/issues?q=is%3Aissue+is%3Aopen+label%3A%22help+wanted%22) labeled items
### Opening an Issue
* Before you do, please check if there's a known work around, existing issue or already a work in progress to address it.
* If you just don't know how to do something consider asking in the gitter, there are always helpful people around.
* Provide as much info as possible - follow the template if it makes sense, attach screenshots or logs if applicable.
### Pull requests
To make it easier to review the changes and get you code into the repo keep the commit history clean:
* [rebase your pulls](https://coderwall.com/p/tnoiug/rebase-by-default-when-doing-git-pull) on the latest from repo
* only push the commits relevant to the PR
* consider [squashing](https://robots.thoughtbot.com/git-interactive-rebase-squash-amend-rewriting-history) multiple commits to keep the history clean (you *can* force push to your fork!)
If adding a feature, also consider adding a sample (or link to one).
================================================
FILE: .github/ISSUE_TEMPLATE.md
================================================
### Description
Please provide a succinct description of your issue.
### Repro code
Please provide the F# code to reproduce the problem.
Ideally, it should be possibe to easily turn this code into a unit test.
### Expected and actual results
Please provide the expected and actual results.
### Related information
* elmish version:
* fable-compiler version:
* fable-core version:
* Operating system:
================================================
FILE: .github/workflows/ci.yml
================================================
name: .NET
on:
push:
branches: [ v4.x ]
pull_request:
branches: [ v4.x ]
jobs:
build:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v4
- name: Setup .NET
uses: actions/setup-dotnet@v4
with:
global-json-file: global.json
- name: Build
run: ./build.fsx
================================================
FILE: .github/workflows/publish.yml
================================================
name: Publish
on:
push:
branches:
- v4.x
workflow_dispatch:
jobs:
build:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v4
- name: Setup .NET
uses: actions/setup-dotnet@v4
with:
global-json-file: global.json
- name: Setup Node.js
uses: actions/setup-node@v4
with:
node-version: '16'
- name: Install and use custom npm version
run: npm i -g npm@7
- name: Install NPM dependencies
run: npm install
- name: Build site
run: ./build.fsx -t GenerateDocs
- name: Deploy site
uses: peaceiris/actions-gh-pages@v4
with:
personal_token: ${{ secrets.GITHUB_TOKEN }}
publish_dir: ./docs_deploy
================================================
FILE: .gitignore
================================================
# OSX
#
.DS_Store
# node.js
#
**/node_modules/
**/npm/
npm-debug.log
# F#
.fake/
packages/
build/
obj
bin
out
# git
*.orig
.vs
*.log
docs/output
docs/temp
Directory.Build.props
temp
paket-files
.ionide
docs_deploy/
================================================
FILE: .nacara/_partials/footer.js
================================================
import React from 'react';
const SitemapSection = ({
title,
children
}) => /*#__PURE__*/React.createElement("div", {
className: "sitemap-section"
}, /*#__PURE__*/React.createElement("div", {
className: "sitemap-section-title"
}, title), /*#__PURE__*/React.createElement("ul", {
className: "sitemap-section-list"
}, children));
const SitemapSectionItem = ({
text,
icon,
url
}) => /*#__PURE__*/React.createElement("li", null, /*#__PURE__*/React.createElement("a", {
href: url,
className: "icon-text sitemap-section-list-item"
}, /*#__PURE__*/React.createElement("span", {
className: "icon"
}, /*#__PURE__*/React.createElement("i", {
className: icon
})), /*#__PURE__*/React.createElement("span", {
className: "sitemap-section-list-item-text"
}, text)));
const CopyrightScript = () => /*#__PURE__*/React.createElement("script", {
dangerouslySetInnerHTML: {
__html: `
const year = new Date().getFullYear();
document.getElementById('copyright-end-year').innerHTML = year;
`
}
});
export default /*#__PURE__*/React.createElement("div", {
className: "is-size-5"
}, /*#__PURE__*/React.createElement("div", {
className: "sitemap"
}, /*#__PURE__*/React.createElement(SitemapSection, {
title: "Project ressources"
}, /*#__PURE__*/React.createElement(SitemapSectionItem, {
text: "Repository",
icon: "fas fa-file-code",
url: "https://github.com/elmish/elmish"
}), /*#__PURE__*/React.createElement(SitemapSectionItem, {
text: "Release notes",
icon: "fas fa-list",
url: "/elmish/release_notes.html"
}), /*#__PURE__*/React.createElement(SitemapSectionItem, {
text: "License",
icon: "fas fa-id-card",
url: "https://github.com/elmish/elmish/blob/v4.x/LICENSE.md"
})), /*#__PURE__*/React.createElement(SitemapSection, {
title: "Elmish modules"
}, /*#__PURE__*/React.createElement(SitemapSectionItem, {
text: "Fable.Elmish",
icon: "fa fa-book",
url: "https://elmish.github.io/elmish/"
}), /*#__PURE__*/React.createElement(SitemapSectionItem, {
text: "Fable.Elmish.Browser",
icon: "fa fa-book",
url: "https://elmish.github.io/browser/"
}), /*#__PURE__*/React.createElement(SitemapSectionItem, {
text: "Fable.Elmish.UrlParser",
icon: "fa fa-book",
url: "https://elmish.github.io/urlParser/"
}), /*#__PURE__*/React.createElement(SitemapSectionItem, {
text: "Fable.Elmish.Debugger",
icon: "fa fa-book",
url: "https://elmish.github.io/debugger/"
}), /*#__PURE__*/React.createElement(SitemapSectionItem, {
text: "Fable.Elmish.React",
icon: "fa fa-book",
url: "https://elmish.github.io/react/"
}), /*#__PURE__*/React.createElement(SitemapSectionItem, {
text: "Fable.Elmish.HMR",
icon: "fa fa-book",
url: "https://elmish.github.io/hmr/"
})), /*#__PURE__*/React.createElement(SitemapSection, {
title: "Other Links"
}, /*#__PURE__*/React.createElement(SitemapSectionItem, {
text: "Fable",
icon: "faf faf-fable",
url: "https://fable.io"
}), /*#__PURE__*/React.createElement(SitemapSectionItem, {
text: "Fable Gitter",
icon: "fab fa-gitter",
url: "https://gitter.im/fable-compiler/Fable"
}), /*#__PURE__*/React.createElement(SitemapSectionItem, {
text: "F# Slack",
icon: "fab fa-slack",
url: "https://fsharp.org/guides/slack/"
}), /*#__PURE__*/React.createElement(SitemapSectionItem, {
text: "F# Software Foundation",
icon: "faf faf-fsharp-org",
url: "https://fsharp.org/"
}))), /*#__PURE__*/React.createElement("p", {
className: "has-text-centered"
}, "Built with ", /*#__PURE__*/React.createElement("a", {
className: "is-underlined",
href: "https://mangelmaxime.github.io/Nacara/"
}, "Nacara")), /*#__PURE__*/React.createElement("p", {
className: "has-text-centered mt-2"
}, "Copyright \xA9 2021-", /*#__PURE__*/React.createElement("span", {
id: "copyright-end-year"
}), " Elmish contributors."), /*#__PURE__*/React.createElement(CopyrightScript, null));
================================================
FILE: .npmrc
================================================
engine-strict=true
================================================
FILE: .vscode/settings.json
================================================
{
"plantuml.exportOutDir": "docs/files/img",
"plantuml.diagramsRoot": "docs/content",
"plantuml.exportSubFolder": false
}
================================================
FILE: .vscode/tasks.json
================================================
{
// See https://go.microsoft.com/fwlink/?LinkId=733558
// for the documentation about the tasks.json format
"version": "2.0.0",
"tasks": [
{
"label": "build",
"command": "dotnet",
"type": "shell",
"args": [
"build",
"netstandard",
// Ask dotnet build to generate full paths for file names.
"/property:GenerateFullPaths=true",
// Do not generate summary otherwise it leads to duplicate errors in Problems panel
"/consoleloggerparameters:NoSummary"
],
"group": "build",
"presentation": {
"reveal": "silent"
},
"problemMatcher": "$msCompile"
}
]
}
================================================
FILE: Elmish.slnx
================================================
<Solution>
<Folder Name="/Solution Items/">
<File Path="build.fsx" />
<File Path="global.json" />
<File Path="package.json" />
<File Path="README.md" />
<File Path="RELEASE_NOTES.md" />
</Folder>
<Project Path="netstandard/Elmish.fsproj" />
<Project Path="src/Fable.Elmish.fsproj" />
<Project Path="tests/Elmish.Tests.fsproj" />
<Project Path="websharper/WebSharper.Elmish.fsproj" />
</Solution>
================================================
FILE: LICENSE.md
================================================
Copyright 2016-2020 elmish contributors
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
================================================
FILE: README.md
================================================
Elmish: Elm-like abstractions for F# applications.
=======
[](https://gitter.im/fable-compiler/Fable)
[](https://ci.appveyor.com/project/et1975/elmish/branch/v4.x)
[](https://badge.fury.io/nu/Fable.Elmish)
Elmish implements core abstractions that can be used to build applications following the “model view update” style of architecture, as made famous by Elm.
The library however does not model any "view" and is intended for use in conjuction with a DOM/renderer, like React/ReactNative or VirtualDOM.
Those familiar with Redux may find Elmish a more natural fit when targeting React or ReactNative as it allows one to stay completely in idiomatic F#.
Elmish abstractions have been carefully designed to resemble Elm's "look and feel" and anyone familiar with post-Signal Elm terminology will find themselves right at home.
See the [docs site](https://elmish.github.io/elmish/) for more information.
Using Elmish
------
v2.0 and above releases use `dotnet` SDK and can be installed with `dotnet nuget` or `paket`:
For use in a Fable project:
`paket add nuget Fable.Elmish -i`
For use in a WebSharper project:
`paket add nuget WebSharper.Elmish -i`
If targeting CLR, please use Elmish package:
`paket add nuget Elmish -i`
For v1.x release information please see the [v1.x branch](https://github.com/elmish/elmish/tree/v1.x)
For v2.x release information please see the [v2.x branch](https://github.com/elmish/elmish/tree/v2.x)
For v3.x release information please see the [v3.x branch](https://github.com/elmish/elmish/tree/v3.x)
For v4.x release information please see the [v3.x branch](https://github.com/elmish/elmish/tree/v4.x)
Building Elmish
------
Elmish depends on [dotnet SDK 8](https://www.microsoft.com/net/download/core):
* `dotnet fsi build.fsx` or `./build.fsx` on a *nix system.
Contributing
------
Please have a look at the [guidelines](https://github.com/elmish/elmish/blob/master/.github/CONTRIBUTING.md).
================================================
FILE: RELEASE_NOTES.md
================================================
## 5.0.2
* Fix: OfTask.attempt signature
## 5.0.1
* Fix: Conditions around ValueTask for target platforms
## 5.0.0
* Implement native support for Task and ValueTask by (@xperiandri) (#303)
## 4.3.0
* CE Cmds handle more exceptions (#300)
## 4.2.0
* reintroduce try/catch in the dispatch loop
## 4.1.0
* Reverse order of subs and cmds evaluation [#66](https://github.com/elmish/browser/issues/66)
## 4.0.2
* Loosen the tasks contraint when we don't care about the result (#277).
## 4.0.1
* Elmish targeting .NET runtime was imposing v6 FSharp.Core despite 4.7 being the reference (#267), thanks @JordanMarr.
## 4.0.0
* Breaking: `withSubscription` replaces existing subscription, use `mapSubscription` to add/accumulate the subscribers
* Obsolete all `Cmd.xxx.result` functions
* Breaking: subs receive current model, automatically started/stopped as needed (#248), thanks Kasey Speakman!
## 4.0.0-beta-6
* WebSharper support by @granicz (Adam Granicz)
## 4.0.0-beta-5
* Breaking: subs receive current model, automatically started/stopped as needed (#248), thanks Kasey Speakman!
## 4.0.0-beta-4
* Move to .NET 6 SDK
* Breaking: dropping .NET 4.6.1 as the target
## 4.0.0-beta-3
* Breaking: `withSubscription` replaces existing subscription, use `mapSubscription` to add/accumulate the subscribers
## 4.0.0-beta-2
* Obsolete all `Cmd.xxx.result` functions
## 4.0.0-beta-1
* Move to .NET 5 SDK
* Deferring `Cmd` and `Sub` changes to v5
* For end-user compatibility with v3 keep `Program.runWith` signature and introduce `Program.runWithDispatch` to allow for multi-threaded sync function.
## 4.0.0-alpha-2
* Changing `Cmd` and `Sub` aliases to DUs
* Changing `ofSub` to take the error mapper
* Dropping netstandard1.6 from Elmish (for CLR) targets
## 4.0.0-alpha-1
* Adding termination
* Moving `syncDispatch` into `runWith` args
## 3.1.0
* Changing Cmd.OfAsync/OfAsyncImmediate `result` implementation to allow exceptions to escape into the dispatch loop.
## 3.0.6
* Changing Cmd.OfAsync implementations to start via 0-interval StartImmediate to mimic .NET behavior
## 3.0.5
* Changing Cmd.OfAsync implementations to start on thread pool to restore v2.x experience
* Adding Cmd.OfAsyncImmediate implementations
* Adding Cmd.OfAsyncWith for custom async start implementations
## 3.0.4
* Access to `Program`'s error handler
## 3.0.3
* Reordering: call `trace` with updated state
## 3.0.1
* Bugfix for ring resizing
## 3.0.0
* Releasing stable 3.0
## 3.0.0-beta-8
* Making `Program` type opaque and reorganizing `Cmd` functions
## 3.0.0-beta-5
* Fable 3 conversion courtesy of Alfonso
## 3.0.0-beta-4
* Ditching PowerPack in favour of Fable.Promise
## 3.0.0-beta-2
* Ditching MailboxProcessor
## 2.0.3
* Adding `Cmd.ofTask` for netstandard
## 2.0.1
* Adding `Cmd.exec`
## 2.0.0
* Stable release
## 2.0.0-beta-4
* re-releasing v1.x for Fable2
## 1.0.3
* re-releasing with azure-functions compatible FSharp.Core dependency
## 1.0.2
* backporting CLR (platform) support
## 1.0.1
* handle exceptions raising from initial subscription
## 1.0.0
* dotnet 2.0 SDK build
## 0.9.2
* `withErrorHandler` modifier
* cumulative `withSubscription`
## 0.9.1
* packaging fix: Console.WriteLine replaced with console, as commited
* Fable 1.1.3 dependency
## 0.9.0
* Releasing using fable 1.x "stable"
* Console tracing from @forki
## 0.9.0-beta-9
* Paket!
## 0.9.0-beta-7
* standalone package repo
## 0.9.0-beta-5
* BREAKING: Moved browser-specific stuff (navigation, urlparser) to elmish-browser
## 0.8.2
* Stricter signatures
## 0.8.1
* Browser navigation: working around IE11/Edge lack of `popstate` event
## 0.8.0
* Expanding `Program` to accommodate plugabble error reporting
## 0.7.2
* Fable dev tools bump
## 0.7.1
* Stable release
## 0.7.1-alpha.3
* Update dependencies
## 0.7.1-alpha.2
* Rearranging `Program` API to prepare for debugger
## 0.7.0-alpha.4
* Update README
## 0.7.0-alpha.3
* Update libraries
## 0.7.0-alpha.2
* Move Promise extensions to `Elmish.Cmd` module
## 0.7.0-alpha.1
* Migrate to Fable 0.7
================================================
FILE: appveyor.yml
================================================
image: Visual Studio 2022
install:
- ps: Install-Product node 17 x64
build_script:
- cmd: dotnet fsi build.fsx
cache:
- "%LOCALAPPDATA%\\Yarn"
================================================
FILE: babel.config.json
================================================
{
"presets": [
"@babel/preset-react"
]
}
================================================
FILE: build.fsx
================================================
#!/usr/bin/env -S dotnet fsi
#r "nuget: Fake.Core.Target, 5.23.1"
#r "nuget: Fake.IO.FileSystem, 5.23.1"
#r "nuget: Fake.DotNet.Cli, 5.23.1"
#r "nuget: Fake.Core.Target, 5.23.1"
#r "nuget: Fake.Core.ReleaseNotes, 5.23.1"
#r "nuget: Fake.Tools.Git, 5.23.1"
#r "nuget: MSBuild.StructuredLogger, 2.2.441"
open Fake.Core
open Fake.Core.TargetOperators
open Fake.DotNet
open Fake.Tools
open Fake.IO
open Fake.IO.FileSystemOperators
open Fake.IO.Globbing.Operators
open System
open System.IO
// Filesets
let projects =
!! "src/**.fsproj"
++ "netstandard/**.fsproj"
++ "websharper/**.fsproj"
System.Environment.GetCommandLineArgs()
|> Array.skip 2 // fsi.exe; build.fsx
|> Array.toList
|> Context.FakeExecutionContext.Create false __SOURCE_FILE__
|> Context.RuntimeContext.Fake
|> Context.setExecutionContext
Target.create "Clean" (fun _ ->
Shell.cleanDir "src/obj"
Shell.cleanDir "src/bin"
Shell.cleanDir "netstandard/obj"
Shell.cleanDir "netstandard/bin"
Shell.cleanDir "websharper/obj"
Shell.cleanDir "websharper/bin"
)
Target.create "Restore" (fun _ ->
projects
|> Seq.iter (Path.GetDirectoryName >> DotNet.restore id)
)
Target.create "Build" (fun _ ->
projects
|> Seq.iter (Path.GetDirectoryName >> DotNet.build id)
)
Target.create "Test" (fun _ ->
DotNet.test (fun a -> a.WithCommon id) "tests"
)
let release = ReleaseNotes.load "RELEASE_NOTES.md"
Target.create "Meta" (fun _ ->
[ "<Project xmlns=\"http://schemas.microsoft.com/developer/msbuild/2003\">"
"<ItemGroup>"
"<None Include=\"../docs/static/img/logo.png\" Pack=\"true\" PackagePath=\"\\\"/>"
"<PackageReference Include=\"Microsoft.SourceLink.GitHub\" Version=\"1.0.0\" PrivateAssets=\"All\"/>"
"</ItemGroup>"
"<PropertyGroup>"
"<EmbedUntrackedSources>true</EmbedUntrackedSources>"
"<AllowedOutputExtensionsInPackageBuildOutputFolder>$(AllowedOutputExtensionsInPackageBuildOutputFolder);.pdb</AllowedOutputExtensionsInPackageBuildOutputFolder>"
"<PackageProjectUrl>https://github.com/elmish/elmish</PackageProjectUrl>"
"<PackageLicenseExpression>Apache-2.0</PackageLicenseExpression>"
"<PackageIconUrl>https://raw.githubusercontent.com/elmish/elmish/master/docs/files/img/logo.png</PackageIconUrl>"
"<PackageIcon>logo.png</PackageIcon>"
"<RepositoryUrl>https://github.com/elmish/elmish.git</RepositoryUrl>"
sprintf "<PackageReleaseNotes>%s</PackageReleaseNotes>" (List.head release.Notes)
"<PackageTags>MVU;fsharp</PackageTags>"
"<Authors>Eugene Tolmachev</Authors>"
sprintf "<Version>%s</Version>" (string release.SemVer)
"</PropertyGroup>"
"</Project>"]
|> File.write false "Directory.Build.props"
)
// --------------------------------------------------------------------------------------
// Build a NuGet package
Target.create "Package" (fun _ ->
projects
|> Seq.iter (Path.GetDirectoryName >> DotNet.pack id)
)
Target.create "PublishNuget" (fun _ ->
let exec dir = DotNet.exec (DotNet.Options.withWorkingDirectory dir)
let args = sprintf "push Fable.Elmish.%s.nupkg -s nuget.org -k %s" (string release.SemVer) (Environment.environVar "nugetkey")
let result = exec "src/bin/Release" "nuget" args
if (not result.OK) then failwithf "%A" result.Errors
let args = sprintf "push WebSharper.Elmish.%s.nupkg -s nuget.org -k %s" (string release.SemVer) (Environment.environVar "nugetkey")
let result = exec "websharper/bin/Release" "nuget" args
if (not result.OK) then failwithf "%A" result.Errors
let args = sprintf "push Elmish.%s.nupkg -s nuget.org -k %s" (string release.SemVer) (Environment.environVar "nugetkey")
let result = exec "netstandard/bin/Release" "nuget" args
if (not result.OK) then
failwithf "%A" result.Errors
)
// --------------------------------------------------------------------------------------
// Generate the documentation
Target.create "GenerateDocs" (fun _ ->
let res = Shell.Exec("npm", "run docs:build")
if res <> 0 then
failwithf "Failed to generate docs"
)
Target.create "WatchDocs" (fun _ ->
let res = Shell.Exec("npm", "run docs:watch")
if res <> 0 then
failwithf "Failed to watch docs: %d" res
)
// --------------------------------------------------------------------------------------
// Release Scripts
Target.create "ReleaseDocs" (fun _ ->
let res = Shell.Exec("npm", "run docs:publish")
if res <> 0 then
failwithf "Failed to publish docs: %d" res
)
Target.create "Publish" ignore
// Build order
"Clean"
==> "Meta"
==> "Restore"
==> "Build"
==> "Test"
==> "Package"
==> "PublishNuget"
==> "Publish"
// start build
Target.runOrDefault "Test"
================================================
FILE: docs/_partials/footer.jsx
================================================
import React from 'react';
const SitemapSection = ({ title, children }) => (
<div className="sitemap-section">
<div className="sitemap-section-title">
{title}
</div>
<ul className="sitemap-section-list">
{children}
</ul>
</div>
)
const SitemapSectionItem = ({ text, icon, url }) => (
<li>
<a href={url} className="icon-text sitemap-section-list-item">
<span className="icon">
<i className={icon}></i>
</span>
<span className="sitemap-section-list-item-text">
{text}
</span>
</a>
</li>
)
const CopyrightScript = () => (
<script dangerouslySetInnerHTML={{
__html: `
const year = new Date().getFullYear();
document.getElementById('copyright-end-year').innerHTML = year;
`
}} />
)
export default (
<div className="is-size-5">
<div className="sitemap">
<SitemapSection title="Project ressources">
<SitemapSectionItem
text="Repository"
icon="fas fa-file-code"
url="https://github.com/elmish/elmish" />
<SitemapSectionItem
text="Release notes"
icon="fas fa-list"
url="/elmish/release_notes.html" />
<SitemapSectionItem
text="License"
icon="fas fa-id-card"
url="https://github.com/elmish/elmish/blob/v4.x/LICENSE.md" />
</SitemapSection>
<SitemapSection title="Elmish modules">
<SitemapSectionItem
text="Fable.Elmish"
icon="fa fa-book"
url="https://elmish.github.io/elmish/" />
<SitemapSectionItem
text="Fable.Elmish.Browser"
icon="fa fa-book"
url="https://elmish.github.io/browser/" />
<SitemapSectionItem
text="Fable.Elmish.UrlParser"
icon="fa fa-book"
url="https://elmish.github.io/urlParser/" />
<SitemapSectionItem
text="Fable.Elmish.Debugger"
icon="fa fa-book"
url="https://elmish.github.io/debugger/" />
<SitemapSectionItem
text="Fable.Elmish.React"
icon="fa fa-book"
url="https://elmish.github.io/react/" />
<SitemapSectionItem
text="Fable.Elmish.HMR"
icon="fa fa-book"
url="https://elmish.github.io/hmr/" />
</SitemapSection>
<SitemapSection title="Other Links">
<SitemapSectionItem
text="Fable"
icon="faf faf-fable"
url="https://fable.io" />
<SitemapSectionItem
text="Fable Gitter"
icon="fab fa-gitter"
url="https://gitter.im/fable-compiler/Fable" />
<SitemapSectionItem
text="F# Slack"
icon="fab fa-slack"
url="https://fsharp.org/guides/slack/" />
<SitemapSectionItem
text="F# Software Foundation"
icon="faf faf-fsharp-org"
url="https://fsharp.org/" />
</SitemapSection>
</div>
<p className="has-text-centered">
Built with <a className="is-underlined" href="https://mangelmaxime.github.io/Nacara/">Nacara</a>
</p>
<p className="has-text-centered mt-2">
Copyright © 2021-<span id="copyright-end-year"/> Elmish contributors.
</p>
<CopyrightScript />
</div>
)
================================================
FILE: docs/docs/basics.fsx
================================================
(**
---
layout: standard
title: Basics
---
**)
(*** hide ***)
// This block of code is omitted in the generated HTML documentation. Use
// it to define helpers that you do not want to show in the documentation.
#I "../../src/bin/Debug/netstandard2.0"
(**
This is a very basic example of an Elmish app - it simply prints the current state in the Console.
First, let's import our dependencies. In a real application, these imports will be in your project file and/or `paket.references`.
*)
#r "Fable.Elmish.dll"
(**
Let's define our `Model` and `Msg` types. `Model` will hold the current state and `Msg` will tell us the nature of the change that we need to apply to the current state.
*)
type Model =
{
Value : int
}
type Msg =
| Increment
| Decrement
(**
Now we define the `init` function that will produce initial state once the program starts running.
It can take any arguments, but we'll just use `unit`. We'll need the [`Cmd`](cmd.html) type, so we'll open Elmish for that:
*)
open Elmish
let init () =
{
Value = 0
}
, Cmd.ofMsg Increment
(**
Notice that we return a tuple. The first field of the tuple tells the program the initial state. The second field holds the command to issue an `Increment` message.
The `update` function will receive the change required by `Msg`, and the current state. It will produce a new state and potentially new command(s).
*)
let update msg model =
match msg with
| Increment when model.Value < 2 ->
{ model with
Value = model.Value + 1
}
, Cmd.ofMsg Increment
| Increment ->
{ model with
Value = model.Value + 1
}
, Cmd.ofMsg Decrement
| Decrement when model.Value > 1 ->
{ model with
Value = model.Value - 1
}
, Cmd.ofMsg Decrement
| Decrement ->
{ model with
Value = model.Value - 1
}
, Cmd.ofMsg Increment
(**
Again we return a tuple: new state, command.
If we execute this as Elmish program, it will keep updating the model from 0 to 3 and back, printing the current state to the console:
*)
Program.mkProgram init update (fun model _ -> printf "%A\n" model)
|> Program.run
================================================
FILE: docs/docs/menu.json
================================================
[
{
"type": "section",
"label": "Step by step",
"items": [
"docs/basics",
"docs/parent-child",
"docs/subscription",
"docs/subscriptionv3"
]
}
]
================================================
FILE: docs/docs/parent-child.fsx
================================================
(**
---
layout: standard
title: Parent-child composition
---
**)
(*** hide ***)
// This block of code is omitted in the generated HTML documentation. Use
// it to define helpers that you do not want to show in the documentation.
#I "../../src/bin/Debug/netstandard2.0"
#r "Fable.Elmish.dll"
(**
This is an example of nesting logic, where each child looks like an individual app.
It knows nothing about what contains it or how it's run, and that's a good thing, as it allows for great flexibility in how things are put together.
Let's define our `Counter` module to hold child logic:
*)
open Elmish
module Counter =
type Model =
{
count : int
}
let init() =
{
count = 0
}
, Cmd.none // no initial command
type Msg =
| Increment
| Decrement
let update msg model =
match msg with
| Increment ->
{ model with
count = model.count + 1
}
, Cmd.none
| Decrement ->
{ model with
count = model.count - 1
}
, Cmd.none
(**
Now we'll define types to hold two counters `top` and `bottom`, and message cases for each counter instance:
*)
type Model =
{
top : Counter.Model
bottom : Counter.Model
}
type Msg =
| Reset
| Top of Counter.Msg
| Bottom of Counter.Msg
(**
And our initialization logic, where we ask for two counters to be initialized:
*)
let init() =
let top, topCmd = Counter.init()
let bottom, bottomCmd = Counter.init()
{
top = top
bottom = bottom
}
, Cmd.batch [
Cmd.map Top topCmd
Cmd.map Bottom bottomCmd
]
(**
`Cmd.map` is used to "elevate" the Counter message into the container type, using corresponding `Top`/`Bottom` case constructors as the mapping function.
We batch the commands together to produce a single command for our entire container.
Note that even though we've implemented the counter as not issuing any commands,
in a real application we still may want to map the commands to facilitate encapsulation - if at any point the child does emit some messages, we'll be in a position to handle them correctly.
And finally our update function:
*)
let update msg model : Model * Cmd<Msg> =
match msg with
| Reset ->
let top, topCmd = Counter.init()
let bottom, bottomCmd = Counter.init()
{
top = top
bottom = bottom
}
, Cmd.batch [
Cmd.map Top topCmd
Cmd.map Bottom bottomCmd
]
| Top msg' ->
let res, cmd = Counter.update msg' model.top
{ model with
top = res
}
, Cmd.map Top cmd
| Bottom msg' ->
let res, cmd = Counter.update msg' model.bottom
{ model with
bottom = res
}
, Cmd.map Bottom cmd
(**
Here we see how pattern matching is used to extract counter message from `Top` and `Bottom` cases into `msg'` and it's routed to the appropriate child.
And again, we map the command issued by the child back to the container `Msg` type.
This may seem like a lot of work, but what we've done is recruited the compiler to make sure that our parent-child relationship is correctly established!
*)
(**
And finally, we execute this as an Elmish program:
*)
Program.mkProgram init update (fun model _ -> printf "%A\n" model)
|> Program.run
================================================
FILE: docs/docs/subscription.fsx
================================================
(**
---
layout: standard
title: Subscriptions
---
**)
(*** hide ***)
// This block of code is omitted in the generated HTML documentation. Use
// it to define helpers that you do not want to show in the documentation.
#I "../../src/bin/Debug/netstandard2.0"
#r "Fable.Elmish.dll"
#r "nuget: Fable.Core"
#r "nuget: Feliz"
(**
> Subscriptions changed in v4. For v3 and earlier subscription, see [Subscriptions (v3)](./subscriptionv3.html).
> Or see [Migrating from v3](#migrating-from-v3) below.
## Working with external sources of events
Sometimes we have a source of events that runs independently of Elmish, like a timer.
We can use subscriptions control when those sources are running, and forward its events to our `update` function.
Let's define our `Model` and `Msg` types. `Model` will hold the current state and `Msg` will tell us the nature of the change that we need to apply to the current state.
*)
open Elmish
open Fable.Core
open System
module BasicTimer =
type Model =
{
current : DateTime
}
type Msg =
| Tick of DateTime
(**
Now let's define `init` and `update`.
*)
let init () =
{
current = DateTime.MinValue
}, []
let update msg model =
match msg with
| Tick current ->
{ model with
current = current
}, []
(**
Now lets define our timer subscription:
*)
let timer onTick =
let start dispatch =
let intervalId =
JS.setInterval
(fun _ -> dispatch (onTick DateTime.Now))
1000
{ new IDisposable with
member _.Dispose() = JS.clearInterval intervalId }
start
let subscribe model =
[ ["timer"], timer Tick ]
Program.mkProgram init update (fun model _ -> printf "%A\n" model)
|> Program.withSubscription subscribe
|> Program.run
(**
`subscribe` answers the question: "Which subscriptions should be running?" `subscribe` is provided the current program state, `model`, to use for decisions.
When the model changes, `subscribe` is called. Elmish then starts or stops subscriptions to match what is returned.
A subscription has an ID, `["timer"]` here, and a start function. The ID needs to be unique within that page.
> **ID is a list?**
>
> This allows us to include dependencies. Later we will use this to change the timer's interval.
## Conditional subscriptions
In the above example, the timer subscription is always returned from `subscribe`, so it will stay running as long as the program is running.
Let's look at an example where the timer can be turned off.
First we add the field `enabled` and a msg `Toggle` to change it.
*)
module ToggleTimer =
type Model =
{
current : DateTime
enabled : bool
}
type Msg =
| Tick of now: DateTime
| Toggle of enabled: bool
let init () =
{
current = DateTime.MinValue
enabled = true
}, []
(**
Now let's handle the `Toggle` message.
*)
let update msg model =
match msg with
| Tick now ->
{ model with
current = now
}, []
| Toggle enabled ->
{ model with
enabled = enabled
}, []
(**
`timer` is the same as before.
*)
let timer onTick =
let start dispatch =
let intervalId =
JS.setInterval
(fun _ -> dispatch (onTick DateTime.Now))
1000
{ new IDisposable with
member _.Dispose() = JS.clearInterval intervalId }
start
(**
Next, we change the subscribe function to check `enabled` before including the timer subscription.
*)
let subscribe model =
[ if model.enabled then
["timer"], timer Tick ]
(**
Now let's add an HTML view to visualize and control the timer.
*)
open Feliz
let view model dispatch =
let timestamp = model.current.ToString("yyyy-MM-dd HH:mm:ss.ffff")
Html.div [
Html.div [Html.text timestamp]
Html.div [
Html.label [
prop.children [
Html.input [
prop.type' "checkbox"
prop.isChecked model.enabled
prop.onCheckedChange (fun b -> dispatch (Toggle b))
]
Html.text " enabled"
]
]
]
]
Program.mkProgram init update view
|> Program.withSubscription subscribe
|> Program.run
(**
Here is the running program.
*)
(**
## Aggregating multiple subscribers
If you need to aggregate multiple subscriptions follow the same pattern as when implementing `init`, `update`, and `view` functions - delegate to child components to setup their own subscriptions.
For example:
*)
module Sub =
// now usable for different intervals
let timer intervalMs onTick =
let start dispatch =
let intervalId =
JS.setInterval
(fun _ -> dispatch (onTick DateTime.Now))
intervalMs
{ new IDisposable with
member _.Dispose() = JS.clearInterval intervalId }
start
module Second =
type Msg =
| Second of int
type Model = int
let init () =
0, []
let update (Second seconds) model =
seconds, []
let subscribe model =
[ ["timer"], Sub.timer 1000 (fun now -> Second now.Second) ]
module Hour =
type Msg =
| Hour of int
type Model = int
let init () =
0, []
let update (Hour hour) model =
hour, []
let subscribe model =
[ ["timer"], Sub.timer (60*1000) (fun now -> Hour now.Hour) ]
module App =
type Model =
{
seconds : Second.Model
hours : Hour.Model
}
type Msg =
| SecondMsg of Second.Msg
| HourMsg of Hour.Msg
let init () =
let seconds, secondsCmd = Second.init ()
let hours, hoursCmd = Hour.init ()
{
seconds = seconds
hours = hours
}, Cmd.batch [Cmd.map SecondMsg secondsCmd; Cmd.map HourMsg hoursCmd]
let update msg model =
match msg with
| HourMsg msg ->
let hours, hoursCmd = Hour.update msg model.hours
{ model with
hours = hours
}, Cmd.map HourMsg hoursCmd
| SecondMsg msg ->
let seconds, secondsCmd = Second.update msg model.seconds
{ model with
seconds = seconds
}, Cmd.map SecondMsg secondsCmd
let subscribe model =
Sub.batch [
Sub.map "hour" HourMsg (Hour.subscribe model.hours)
Sub.map "second" SecondMsg (Second.subscribe model.seconds)
]
Program.mkProgram init update (fun model _ -> printf "%A\n" model)
|> Program.withSubscription subscribe
|> Program.run
(**
Notice `Sub.map` takes an id prefix as its first parameter. This helps keep subscriptions distinct from each other.
Before `Sub.map`, Second and Hour have the same ID: `["timer"]`. After `Sub.map`, their IDs are: `["hour"; "timer"]` and `["second"; "timer"]`.
It is common for parent pages to have one active child page. This partial example shows `subscribe` in that case.
*)
(*** hide ***)
module ActiveChildPage =
open App
(**
*)
type Msg =
| SecondMsg of Second.Msg
| HourMsg of Hour.Msg
type Page =
| Second of Second.Model
| Hour of Hour.Model
type Model =
{
page: Page
}
let subscribe model =
match model.page with
| Second model_ ->
Sub.map "second" SecondMsg (Second.subscribe model_)
| Hour model_ ->
Sub.map "hour" HourMsg (Hour.subscribe model_)
(**
When the active page changes, the old page's subscriptions are stopped and the new page's subscriptions are started.
*)
(**
## Subscription reusability
> 📌 **Effect**
>
> The `Effect` type was known as `Sub` in v3. With the change to subscriptions, `Sub` would have been an overloaded and confusing term.
> Helper functions have also been renamed. For example, `Cmd.ofSub` is now `Cmd.ofEffect`.
> This is a change in name only -- `Effect` works exactly the same as v3 `Sub`.
In the last section, we increased reusability of the timer by taking the interval as a parameter.
We can use Effect to factor out the hard-coded `DateTime.Now` behavior for even more reuse.
First let's turn `DateTime.Now` into an Effect.
*)
module EffectTimer =
module Time =
let now (tag: DateTime -> 'msg) : Effect<'msg> =
let effectFn dispatch =
dispatch (tag DateTime.Now)
effectFn
(**
> Strange as it seems, `DateTime.Now` is a side effect. This property reads from a clock and may return a different value each time. Code that uses it becomes nondeterministic.
Now let's change timer to run an `Effect` when the interval fires.
*)
module Sub =
let timer intervalMs (effect: Effect<'msg>) =
let start dispatch =
let intervalId =
JS.setInterval (fun _ -> effect dispatch) intervalMs
{ new IDisposable with
member _.Dispose() = JS.clearInterval intervalId }
start
(**
And finally, here is the updated `subscribe` function.
*)
type Model =
{
current : DateTime
intervalMs : int
}
type Msg =
| Tick of DateTime
let subscribe model =
[ ["timer"], Sub.timer model.intervalMs (Time.now Tick) ]
(**
The timer subscription can now run any kind of effect. Calling an API, playing a sound, etc.
`Time.now` is also usable for Cmds.
*)
let init () =
{
current = DateTime.MinValue
intervalMs = 1000
}
, Cmd.ofEffect (Time.now Tick)
(**
## IDs and dependencies
Earlier we noted that ID is a list so that you can add dependencies to it. We'll use that to improve the last example.
In that example, the timer's interval came from the model:
```fsharp
Sub.timer model.intervalMs (Time.now Tick)
```
But nothing happens to the subscription if `model.intervalMs` changes. Let's fix that.
*)
(*** hide ***)
module IdDeps =
open EffectTimer // reuse last example's code
(**
*)
let subscribe model =
let subId = ["timer"; string model.intervalMs]
[ subId, Sub.timer model.intervalMs (Time.now Tick) ]
(**
Now that `intervalMs` is part of the ID, the timer will stop the old interval then start with the new interval whenever the interval changes.
How does it work? It is taking advantage of ID uniqueness.
Let's say that `intervalMs` is initially 1000. The sub ID is `["timer"; "1000"]`, Elmish starts the subscription.
Then `intervalMs` changes to 2000. The sub ID becomes `["timer"; "2000"]`.
Elmish sees that `["timer"; "1000"]` is no longer active and stops it. Then it starts the "new" subscription `["timer"; "2000"]`.
To Elmish each interval is a different subscription. But to `subscribe` this is a single timer that changes intervals.
Let's look at another example: multiple timers. This one will be a full-fledged example including UI forms to take user input.
*)
module MultipleTimers =
module Time =
let now (tag: DateTime -> 'msg) : Effect<'msg> =
let effectFn dispatch =
dispatch (tag DateTime.Now)
effectFn
module Sub =
let timer intervalMs (effect: Effect<'msg>) =
let start dispatch =
let intervalId =
JS.setInterval (fun _ -> effect dispatch) intervalMs
{ new IDisposable with
member _.Dispose() = JS.clearInterval intervalId }
start
(**
This includes the same `Sub.timer` subscription and `Time.now` effect from the last example.
Now let's create a reusable form that accepts timer interval changes and validates them.
*)
// type aliases to make the model more legible, in theory
type TimerId = int
type IntervalMs = int
type FormState =
| Unchanged
| NewValue of IntervalMs
| Invalid of error: string
type IntervalForm =
{
current : IntervalMs
userEntry : string
state : FormState
}
module IntervalForm =
let [<Literal>] NoInterval = -1
let empty =
{
current = NoInterval
userEntry = ""
state = Unchanged
}
let create intervalMs =
{
current = intervalMs
userEntry = string intervalMs
state = Unchanged
}
let reset form =
let userEntry =
if form.current = NoInterval then
""
else
string form.current
{form with userEntry = userEntry; state = Unchanged}
let validate form =
match Int32.TryParse form.userEntry with
| false, _ when form.current = NoInterval && form.userEntry = "" ->
{form with state = Unchanged}
| false, _ when form.userEntry = "" ->
{form with state = Invalid "cannot be blank"}
| false, _ ->
{form with state = Invalid "must be an integer"}
| true, interval when interval <= 0 ->
{form with state = Invalid "must be greater than zero"}
| true, interval when interval = form.current ->
{form with state = Unchanged}
| true, interval ->
{form with state = NewValue interval}
let userEntry text form =
validate {form with userEntry = text}
(**
Now let's create the overall model to manage timers.
*)
type Model =
{
// lookup by TimerId, last tick and interval settings
timers : Map<TimerId, DateTime * IntervalForm>
// incrementing ID
nextId : TimerId
// form for the user to add a new interval
addForm : IntervalForm
}
type Msg =
| AddFormReset
| AddFormUserEntry of text: string
| ChangeFormReset of timerId: int
| ChangeFormUserEntry of timerId: int * text: string
| AddTimer of intervalMs: int
| RemoveTimer of timerId: int
| ChangeInterval of timerId: int * intervalMs: int
| Tick of timerId: int * now: DateTime
module Model =
let updateTimer timerId f model =
{ model with
timers =
model.timers
|> Map.change timerId (Option.map f)
}
let updateForm timerId f model =
model |> updateTimer timerId (fun (now, form) -> now, f form)
let updateNow timerId newNow model =
model |> updateTimer timerId (fun (now, form) -> newNow, form)
let init () =
{
timers = Map.empty
nextId = 1
addForm = IntervalForm.empty
}, []
let update msg model =
match msg with
// form changes
| AddFormReset ->
{ model with
addForm = IntervalForm.reset model.addForm
}, []
| AddFormUserEntry text ->
{ model with
addForm = IntervalForm.userEntry text model.addForm
}, []
| ChangeFormReset timerId ->
Model.updateForm timerId IntervalForm.reset model, []
| ChangeFormUserEntry (timerId, text) ->
Model.updateForm timerId (IntervalForm.userEntry text) model, []
// timer changes
| AddTimer intervalMs ->
{ model with
timers =
let form = IntervalForm.create intervalMs
Map.add model.nextId (DateTime.MinValue, form) model.timers
nextId = model.nextId + 1
addForm = IntervalForm.empty
}, [Time.now (fun now -> Tick (model.nextId, now))]
| RemoveTimer timerId ->
{ model with
timers = Map.remove timerId model.timers
}, []
| ChangeInterval (timerId, intervalMs) ->
let form = IntervalForm.create intervalMs
Model.updateForm timerId (fun _ -> form) model, []
| Tick (timerId, now) ->
Model.updateNow timerId now model, []
let subscribe model =
[
for timerId, (_now, {current = intervalMs}) in Map.toList model.timers do
let subId = ["timer"; string timerId; string intervalMs]
let tick now = Tick (timerId, now)
subId, Sub.timer intervalMs (Time.now tick)
]
(**
In the subscription IDs, we included `timerId` and `intervalMs`. Each serves a slightly different purpose.
We can't use just "timer" because it won't be unique. `timerId` provides a unique (auto-incrementing) ID, so it satisfies that requirement.
Any data we add to the ID beyond that, like `intervalMs` will cause the subscription to restart when that data changes. This is perfect for settings that affect the subscription runtime behavior, like interval changes.
Note that "timer" isn't needed in the ID here. Since timerId is providing uniqueness, "timer" is only a prefix now.
A prefix might still be useful if there are other subscriptions on that page.
Let's finish things off with view functions.
*)
open Feliz
let formView resetTag userEntryTag saveTag (saveText: string) form dispatch =
Html.div [
Html.text " "
Html.input [
prop.type'.text
prop.value form.userEntry
prop.onChange (fun (text: string) -> dispatch (userEntryTag text))
]
Html.text " "
Html.button [
prop.type'.button
prop.text saveText
match form.state with
| Unchanged | Invalid _ ->
prop.disabled true
| NewValue intervalMs ->
prop.onClick (fun _ -> dispatch (saveTag intervalMs))
]
Html.text " "
Html.a [
prop.text "Reset"
prop.style [style.userSelect.none]
match form.state with
| Unchanged ->
prop.disabled true
prop.style [style.color.gray; style.pointerEvents.none; style.userSelect.none]
| _ ->
prop.onClick (fun _ -> dispatch resetTag)
]
Html.text " "
Html.br []
match form.state with
| Unchanged | NewValue _ ->
Html.span [
prop.style [style.visibility.hidden]
prop.text "no error"
]
| Invalid error ->
Html.span [
prop.style [style.color.orangeRed; style.fontSize (length.rem 0.8)]
prop.text error
]
]
let view model dispatch =
Html.div [
prop.style [style.padding (length.px 12)]
prop.children [
Html.style
"""
table {border-collapse: collapse; border-spacing: 0; box-sizing: border-box; border: 1px solid gray}
table th, table td {padding: 3px 12px}
"""
Html.h4 "Add a timer"
formView AddFormReset AddFormUserEntry AddTimer "Add" model.addForm dispatch
Html.h4 "Timers"
Html.table [
Html.thead [
Html.tr [
Html.th " "
Html.th " Timer ID "
Html.th " Last Tick "
Html.th " Interval (ms) "
]
]
Html.tbody [
for timerId, (now, form) in Map.toList model.timers do
Html.tr [
prop.key timerId
prop.children [
Html.td [
Html.text " "
Html.button [
prop.type' "button"
prop.onClick (fun _ -> dispatch (RemoveTimer timerId))
prop.text " X "
]
Html.text " "
]
Html.td [
prop.style [style.textAlign.right]
prop.text (" " + string timerId + " ")
]
Html.td [
Html.div [
prop.key (string now.Ticks)
let timestampStr = now.ToString("yyyy-MM-dd HH:mm:ss.ffff")
prop.text timestampStr
]
]
Html.td [
let reset = ChangeFormReset timerId
let userEntry text = ChangeFormUserEntry (timerId, text)
let save intervalMs = ChangeInterval (timerId, intervalMs)
formView reset userEntry save "Save" form dispatch
]
]
]
]
]
]
]
Program.mkProgram init update view
|> Program.withSubscription subscribe
|> Program.run
(**
Here is a demo.
## Migrating from v3
Migrating from Elmish v3 is fairly simple. First we will look at what we have from V3.
### v3 example
*)
// from v3 docs
module V3Sub =
open System
type Model =
{
current : DateTime
}
type Msg =
| Tick of DateTime
let init () =
{
current = DateTime.Now
}
let update msg model =
match msg with
| Tick current ->
{ model with
current = current
}
(**
Here is the main part we are concerned with: the subscription. Type annotations have been added.
*)
open Elmish
open Fable.Core
let timer (initial: Model) : Cmd<Msg> =
let sub dispatch =
JS.setInterval
(fun _ ->
dispatch (Tick DateTime.Now)
)
1000
|> ignore
Cmd.ofSub sub
Program.mkSimple init update (fun model _ -> printf "%A\n" model)
|> Program.withSubscription timer
|> Program.run
(**
### v4 conversion
First, let's see the v4-migrated `timer` function. Then we'll go through the differences.
*)
(*** hide ***)
module V4Sub =
open V3Sub
(**
*)
let timer (model: Model) : (SubId * Subscribe<Msg>) list =
let sub dispatch : IDisposable =
JS.setInterval
(fun _ ->
dispatch (Tick DateTime.Now)
)
1000
|> ignore
{new IDisposable with member _.Dispose() = ()}
[ ["timer"], sub ]
Program.mkSimple init update (fun model _ -> printf "%A\n" model)
|> Program.withSubscription timer
|> Program.run
(*** hide ***)
module V4SubExplained =
open V3Sub
(**
### Differences
First, the function signature is different.
*)
//vvvvvvvvvvvvvvvvvvvvvvvvvvvvv
let timer (model: Model) : (SubId * Subscribe<Msg>) list =
(**
Instead of returning `Cmd<Msg>`, the subscription now returns a list containing `SubId`s and their associated `Subscribe` functions in a tuple.
To convert `sub` into a `Subscribe<Msg>` function, the only change is that it returns an `IDisposable` instead of `unit`.
*)
//vvvvvvvvvvv
let sub dispatch : IDisposable =
JS.setInterval
(fun _ ->
dispatch (Tick DateTime.Now)
)
1000
|> ignore
{new IDisposable with member _.Dispose() = ()}
//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
(**
The `IDisposable` is meant to provide a way to stop the subscription. We used an empty `IDisposable` because v3 subscriptions did not have "stop" functionality. So this matches v3 behavior.
> If "stop" functionality was needed in v3, it had to be manually coded. By behaving like v3, the above remains compatible with any such code.
> Then the full v4 subscription functionality can be implemented when and if it is convenient.
Now let's examine the return value.
*)
[ ["timer"], sub ]
(**
The return value is a list containing a single element: a combination of `["timer"]` (the subscription ID) and `sub` (the subscribe function) in a tuple.
The subscription ID should be unique among other subscriptions in the list. For more info on why the ID is a list, see the section [IDs and dependencies](#ids-and-dependencies).
This is all that's necessary to migrate v3 subs to v4 to get an existing code base working.
Subscriptions in v4 offer new functionality, such as automatically stopping or restarting subscriptions when the model changes.
For more information, please consult the previous sections in this document. They offer a step-by-step guide to the new features.
*)
(**
## Style used in this guide
This guide uses a named fn, `start`, inside subscriptions for increased explicitness. The pattern looks like this:
*)
(*** hide ***)
module Style2 =
(**
*)
let timer intervalMs onTick =
let start dispatch = // define start fn
((* . . . *))
start // return start fn
(**
In the source code of Elmish libraries, you will typically find anonymous function returns instead. Like this:
*)
(*** hide ***)
module Style1 =
(**
*)
let timer intervalMs onTick =
fun dispatch ->
((* . . . *))
(**
Both styles are equivalent in functionality. Feel free to use whichever you prefer.
*)
================================================
FILE: docs/docs/subscriptionv3.fsx
================================================
(**
---
layout: standard
title: Subscriptions (v3)
---
**)
(*** hide ***)
// This block of code is omitted in the generated HTML documentation. Use
// it to define helpers that you do not want to show in the documentation.
#I "../../src/bin/Debug/netstandard2.0"
#r "Fable.Elmish.dll"
#r "nuget: Fable.Core"
(**
## Working with external sources of events
Sometimes we have a source of events that doesn't depend on the current state of the model, like a timer.
We can setup forwarding of those events to be processed by our `update` function like any other change.
Let's define our `Model` and `Msg` types. `Model` will hold the current state and `Msg` will tell us the nature of the change that we need to apply to the current state.
*)
open System
type Model =
{
current : DateTime
}
type Msg =
| Tick of DateTime
(**
This time we'll define the "simple" version of `init` and `update` functions, that don't produce commands:
*)
let init () =
{
current = DateTime.Now
}
let update msg model =
match msg with
| Tick current ->
{ model with
current = current
}
(**
Note that "simple" is not a requirement and is just a matter of convenience for the purpose of the example!
Now lets define our timer subscription:
*)
open Elmish
open Fable.Core
let timer initial =
let sub dispatch =
JS.setInterval
(fun _ ->
dispatch (Tick DateTime.Now)
)
1000
|> ignore
Cmd.ofSub sub
Program.mkSimple init update (fun model _ -> printf "%A\n" model)
|> Program.withSubscription timer
|> Program.run
(**
In this example program initialization will call our subscriber (once) with inital `Model` state, passing the `dispatch` function to be called whenever an event occurs.
However, any time you need to issue a message (for example from a callback) you can use `Cmd.ofSub`.
*)
(**
## Aggregating multiple subscribers
If you need to aggregate multiple subscriptions follow the same pattern as when implementing `init`, `update`, and `view` functions - delegate to child components to setup their own subscriptions.
For example:
*)
module Second =
type Msg =
| Second of int
type Model = int
let subscribe initial =
let sub dispatch =
JS.setInterval
(fun _ ->
dispatch (Second DateTime.Now.Second)
)
1000
|> ignore
Cmd.ofSub sub
let init () =
0
let update (Second seconds) model =
seconds
module Hour =
type Msg =
| Hour of int
type Model = int
let init () =
0
let update (Hour hours) model =
hours
let subscribe initial =
let sub dispatch =
JS.setInterval
(fun _ ->
dispatch (Hour DateTime.Now.Hour)
)
1000*60
|> ignore
Cmd.ofSub sub
module App =
type Model =
{
seconds : Second.Model
hours : Hour.Model
}
type Msg =
| SecondMsg of Second.Msg
| HourMsg of Hour.Msg
let init () =
{
seconds = Second.init()
hours = Hour.init()
}
let update msg model =
match msg with
| HourMsg msg ->
{ model with
hours = Hour.update msg model.hours
}
| SecondMsg msg ->
{ model with
seconds = Second.update msg model.seconds
}
let subscription model =
Cmd.batch [
Cmd.map HourMsg (Hour.subscribe model.hours)
Cmd.map SecondMsg (Second.subscribe model.seconds)
]
Program.mkSimple init update (fun model _ -> printf "%A\n" model)
|> Program.withSubscription subscription
|> Program.run
================================================
FILE: docs/index.md
================================================
---
layout: standard
toc: false
title: Elmish
---
>`-ish` <br />
> a suffix used to convey the sense of “having some characteristics of”
Elmish implements core abstractions that can be used to build F# applications following the [“model view update”](https://guide.elm-lang.org/architecture/) style of architecture, as made famous by Elm.
The goal of the architecture is to provide a solid UI-independent core to build the rest of the functionality around.
Elm architecture operates using the following concepts, as they translate to Elmish:
* **Model** <br />
This is a snapshot of your application's state, defined as an immutable data structure.
<div/> <!-- Add a small gap -->
* **Message** <br />
This an event representing a change (delta) in the state of your application, defined as a discriminated union.
<div/> <!-- Add a small gap -->
* **Command** <br />
This is a carrier of instructions, that when evaluated may produce one or more messages.
<div/> <!-- Add a small gap -->
* **Init** <br />
This is a pure function that produces the inital state of your application and, optionally, commands to process.
<div/> <!-- Add a small gap -->
* **Update** <br />
This is a pure function that produces a new state of your application given the previous state and, optionally, new commands to process.
<div/> <!-- Add a small gap -->
* **View** <br />
This is a pure function that produces a new UI layout/content given the current state, defined as an F# function that uses a renderer (such as React) to declaratively build a UI.
<div/> <!-- Add a small gap -->
* **Program** <br />
This is an opaque data structure that combines all of the above plus a `setState` function to produce a view from the model.
See the [`Program`](program.html) module for more details.
### Installation
```sh
dotnet add package Fable.Elmish
```
Concepts
---------------
### Dispatch loop
Once started, Program runs a dispatch loop, producing a new Model given the current state and an input Message.
See the [basics example](docs/basics.html) for details.
### Parent-child composition and user interaction
Parent-child hierarchy is made explicit by wrapping model and message types of the child with those of the parent.
Following diagrams show interactions between components in case of a user interacting with an example web app.
Note that Elmish doesn't depend on any specific UI such as HTML rendering (it actually does not require any UI at all), and HTML is used just for explanation purposes.
First the UI is initialised:
1. `program` requests the initial model from the parent, top-level component (`Main`)
2. Parent component requests the initial model from its child subcomponent (`Widget`)
3. `Widget.initialModel` returns its initial model to the parent
4. `Main.initialModel` wraps child's model and returns the top-level initial model to the program
5. Program sends the model to the parent's `Main.view`
6. Parent unwraps the child's component model from its model and sends it to child's `Widget.view`
7. `Widget.view` returns a rendered `HTML` page
8. `Main.view` embeds child's `HTML` page in its `HTML` page
9. The resulting `HTML` page is send to the user
Then the user interacts with the browser:
1. User clicks on the increase button
2. `Widget.view` dispatches an `Increase` message
3. `Main.view` has augemented the `dispatch` so the message becomes `WidgetMsg Increase` as it is sent along to `program`
4. `program` calls `Main.update` with this message and `mainModel`
5. As the message was tagged with `WidgetMsg`, `Main.update` delegates the update to `Widget.update`, sending along the way the `widgetModel` part of `mainModel`
6. `Widget.update` modifies the model according to the given message, in this case `Increase`, and returns the modified `widgetModel` plus a command
7. `Main.update` returns the updated `mainModel` to `program`
8. `program` then renders the view again passing the updated `mainModel`
See the [example](docs/parent-child.html) for details.
### Tasks and side-effects
Tasks such as reading a database or making a Web API call are performed using `async` and `promise` blocks or just plain functions.
These operations may return immediately but complete (or fail) at some later time.
To feed the results back into the dispatch loop, instead of executing the operations directly, we instruct Elmish to do it for us by wrapping the instruction in a command.
### Commands
Commands are carriers of instructions, which you issue from the `init` and `update` functions.
Once evaluated, a command may produce one or more new messages, mapping success or failure as instructed ahead of time.
As with any message dispatch, in the case of Parent-Child composition, child commands need to be mapped to the parent's type:
1. `Program` calls the `Main.update` with a message
2. `Main.update` does its own update and/or delegates to `Child.update`
3. `Child.update` does its own update and/or delegates to `GrandChild.update`
4. `GrandChild.update` returns with its model and `Cmd` (of GrandChild message type)
5. `Child.update` processes GrandChild's model and maps its `Cmd` into `Cmd` of Child's message type and batches it with its own `Cmd`, if any
6. `Main.update` processes Child's model and maps its `Cmd` into `Cmd` of Main's message type and batches it with its own `Cmd`, if any
Here we collect commands from three different levels. At the end we send all these commands to our `Program` instance to run.
See the [`Cmd`](cmd.html) module for ways to construct, map and batch commands.
### Subscriptions
Most of the messages (changes in the state) will originate within your code, but some will come from the outside, for example from a timer or a websocket.
These sources can be tapped into with subscriptions, defined as F# functions that can dispatch new messages as they happen.
See the [subscriptions example](docs/subscription.html) for details.
### View
The core is independent of any particular technolgy, instead relying on a renderer library to implement `setState` in any way seen fit.
In fact, an Elmish app can run entirely without a UI!
At the moment, there are two UI technologies for which rendering has been implemented: React and React Native.
For details please see [elmish-react](https://elmish.github.io/react).
### Interacting with a browser
Larger Elmish applications for the browser may benefit from advanced features like routing and explicit navigation control.
For information about these features please see [elmish-browser](https://elmish.github.io/browser).
### Controlling termination
Hot reloading requires the new version of the application loop to be started. To faciliate the interaction with libraries that implement this functionality the v4 elmish extends the abstractions with "termination". Use `withTermination` function to specify the predicate that can evaluate incoming messages and decide if the dispatch loop should stop processing the messages, as well as specify how to release the resources.
### Observing the state changes
Every message going through the dispatch loop can be traced, along with the current state of the app.
Just augument the program instance with a trace function:
```fs
open Elmish
Program.mkProgram init update view
|> Program.withConsoleTrace
|> Program.run
```
And start seeing the state and messages as updates happen in the browser developer console.
For more advanced debugging capabilities please see [elmish-debugger](https://elmish.github.io/debugger).
================================================
FILE: docs/release_notes.md
================================================
---
layout: changelog
changelog_path: ./../RELEASE_NOTES.md
---
================================================
FILE: docs/scss/fable-font.scss
================================================
@font-face {
font-family: 'fable-font';
src: url('/static/fonts/fable-font/fable-font.eot?qh7nog');
src: url('/static/fonts/fable-font/fable-font.eot?qh7nog#iefix') format('embedded-opentype'),
url('/static/fonts/fable-font/fable-font.ttf?qh7nog') format('truetype'),
url('/static/fonts/fable-font/fable-font.woff?qh7nog') format('woff'),
url('/static/fonts/fable-font/fable-font.svg?qh7nog#fable-font') format('svg');
font-weight: normal;
font-style: normal;
}
// Prepare bulma to accept our customs icons
.icon {
.faf {
font-size: 21px;
}
&.is-small {
height: 1rem;
width: 1rem;
.faf {
font-size: 14px;
}
}
&.is-medium {
height: 2rem;
width: 2rem;
.faf {
// font-size: 28px;
font-size: 1.33333em;
line-height: 0.75em;
vertical-align: -.0667em;
}
}
&.is-large {
height: 3rem;
width: 3rem;
.faf {
font-size: 42px;
}
}
}
.faf {
display: inline-block;
font: normal normal normal 14px/1 'fable-font';
font-size: inherit;
text-rendering: auto;
-webkit-font-smoothing: antialiased;
-moz-osx-font-smoothing: grayscale;
}
$icons: (
fable: "\e900",
fsharp-org: "\e901"
);
@each $name, $icon in $icons {
.faf-#{$name}:after {
content: $icon;
}
}
================================================
FILE: docs/static/img/commands.wsd
================================================
@startuml
autonumber "<b>(#)"
' © Sebastian Porto 2016,
' licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International License.
participant program #white
participant Main.update as MU #white
participant Child.update as CU #white
participant GrandChild.update as GC #white
program -> MU: update
MU -> CU: update
CU -> GC: update
GC --> CU: (model, command)
CU --> MU: (model, command)
MU -> program : (model, command)
@enduml
================================================
FILE: docs/static/img/flow.wsd
================================================
@startuml
' © Sebastian Porto 2016,
' licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International License.
autonumber
participant program #white
participant update #white
participant view #white
program -> view : Render view
|||
view -> program : Trigger message e.g. Expand
program -> update : Send message with the current state
update --> program : Return updated state and command
program -> view : Render view
@enduml
================================================
FILE: docs/static/img/parent-child.wsd
================================================
@startuml "parent-child"
' © Sebastian Porto 2016,
' licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International License.
autonumber "<b>(#)"
participant User #white
participant program #white
participant Main.initialModel as Mim #white
participant Main.view as MV #white
participant Main.update as MU #white
participant Widget.initialModel as Wim #white
participant Widget.view as WV #white
participant Widget.update as WU #white
program -> Mim: initialModel
Mim -> Wim: initialModel
Wim --> Mim: widgetModel
Mim --> program: mainModel
program -> MV : mainModel
MV -> WV : widgetModel
WV --> MV : Html
MV --> program : Html
program -> User : Html
newpage
autonumber 1 "<b>(#)"
User -> WV : Click
WV -> MV: Increase
MV -> program: (WidgetMsg Increase)
program -> MU: (WidgetMsg Increase) mainModel
MU -> WU : Increase widgetModel
WU --> MU: (updated widgetModel, command)
MU --> program: (updated mainModel, command)
program -> MV : mainModel
MV -> WV : widgetModel
WV --> MV : Html
MV --> program : Html
@enduml
================================================
FILE: docs/style.scss
================================================
@import "./../node_modules/bulma/sass/utilities/initial-variables";
// Color palette
// https://lospec.com/palette-list/fluffy8
/////////////////////////////////
/// Customize Bulma
/////////////////////////////////
$primary: #2d3947;
$text: #2b2b2b;
$danger: #c43636;
@import "./../node_modules/bulma/sass/utilities/derived-variables";
/////////////////////////////////
/// nacara-layout-standard customizations
/// Do not touch unless you know what you are doing
/////////////////////////////////
$navbar-breakpoint: 0px;
$navbar-padding-vertical: 0.5rem;
$navbar-padding-horizontal: 1rem;
/////////////////////////////////
// Specific to gatsby-remark-vscode usage
$content-pre-padding: unset;
/////////////////////////////////
/// Customize Bulma
/////////////////////////////////
$navbar-item-color: $white;
$navbar-background-color: $primary;
$navbar-item-active-color: $white;
$navbar-item-active-background-color: lighten($primary, 12%);
$navbar-item-hover-color: $white;
$navbar-item-hover-background-color: lighten($primary, 12%);;
$navbar-dropdown-item-active-background-color: $primary;
$navbar-dropdown-item-hover-background-color: $primary;
$navbar-dropdown-item-hover-color: $white;
$navbar-dropdown-item-active-color: $white;
$menu-item-active-background-color: $primary;
$menu-item-active-color: $white;
$menu-item-hover-color: $primary;
$menu-item-hover-background-color: transparent;
$menu-label-font-size: $size-6;
$menu-item-radius: $radius-large $radius-large;
$footer-background-color: $primary;
$footer-color: $white;
$code: $red;
$nacara-navbar-dropdown-floating-max-width: 450px;
$body-size: 14px;
@import "../node_modules/bulma/sass/utilities/_all.sass";
@import "./../node_modules/bulma/bulma.sass";
@import "./../node_modules/nacara-layout-standard/scss/nacara.scss";
@import "./scss/fable-font.scss";
// Begin gatsby-remark-vscode specific
:root {
--grvsc-padding-v: 1.25rem;
}
// Make the code use the full width for when user use line highlighting
.content {
pre > code {
width: 100%;
}
}
// End gatsby-remark-vscode specific
// Override bulma
.navbar {
.navbar-dropdown {
@include desktop {
// Force navbar item text color otherwise it is the same as $navbar-item-color
// Which is white in our case...
.navbar-item {
color: $text;
}
}
}
.navbar-link {
&:not(.is-arrowless)::after {
border-color: $white;
}
}
}
.footer a {
color: $white;
}
.sitemap {
max-width: 1024px;
margin: 0 auto 2rem;
display: grid;
grid-gap: 4rem;
grid-template-columns: repeat(auto-fit, minmax(200px, 1fr));
font-size: $size-6;
@include mobile {
grid-template-columns: 1fr;
grid-gap: 1rem;
}
a {
color : white;
}
.sitemap-section {
width: 100%;
.sitemap-section-title {
font-size: $size-4;
font-weight: $weight-bold;
text-align: center;
padding-bottom: 1rem;
@include mobile {
text-align: left;
}
}
.sitemap-section-list {
li {
border-top: 2px solid lighten($primary, 8%);
}
.sitemap-section-list-item {
padding: 1rem 0.5rem;
width: 100%;
&:hover {
background-color: lighten($primary, 4%);
}
.icon-text:hover {
.sitemap-section-list-item-text {
text-decoration: underline;
}
}
}
}
}
}
================================================
FILE: global.json
================================================
{
"sdk": {
"version": "8.0.401",
"rollForward": "latestMinor"
}
}
================================================
FILE: nacara.config.json
================================================
{
"siteMetadata": {
"title": "Elmish",
"url": "https://elmish.github.io",
"baseUrl": "/elmish/",
"editUrl" : "https://github.com/elmish/elmish/edit/v4.x/docs",
"favIcon": "img/logo.png"
},
"navbar": {
"start": [
{
"pinned": true,
"label": "Docs",
"url": "/elmish/docs/basics.html"
}
],
"end": [
{
"url": "https://github.com/elmish/elmish",
"icon": "fab fa-2x fa-github",
"label": "GitHub"
}
]
},
"remarkPlugins": [
{
"resolve": "gatsby-remark-vscode",
"property": "remarkPlugin",
"options": {
"theme": "Atom One Light",
"extensions": [
"vscode-theme-onelight"
]
}
}
],
"layouts": [
"nacara-layout-standard"
]
}
================================================
FILE: netstandard/Elmish.fsproj
================================================
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<Description>Elmish core for .NET apps</Description>
<TargetFrameworks>netstandard2.0;net8.0</TargetFrameworks>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<DisableImplicitFSharpCoreReference>True</DisableImplicitFSharpCoreReference>
</PropertyGroup>
<ItemGroup>
<Compile Include="../src/prelude.fs" />
<Compile Include="../src/cmd.fs" />
<Compile Include="../src/sub.fs" />
<Compile Include="../src/ring.fs" />
<Compile Include="../src/program.fs" />
</ItemGroup>
<ItemGroup>
<ImportPackage Update="FSharp.Core" Version="4.7.*" />
</ItemGroup>
</Project>
================================================
FILE: package.json
================================================
{
"name": "hmr",
"private": true,
"type": "module",
"engines": {
"node": "^12.20.0 || ^14.13.1 || >=16.0.0",
"npm": ">=7.0.0"
},
"scripts": {
"docs:watch": "nacara watch",
"docs:build": "nacara build",
"docs:publish": "nacara build && gh-pages -d docs_deploy"
},
"repository": {
"type": "git",
"url": "git+https://github.com/elmish/hmr.git"
},
"devDependencies": {
"@babel/preset-react": "^7.16.0",
"bulma": "^0.9.3",
"gatsby-remark-vscode": "^3.3.1",
"nacara-layout-standard": "^1.8.0",
"react": "^18.2.0",
"react-dom": "^18.2.0",
"unified": "^10.1.1",
"vscode-theme-onelight": "github:akamud/vscode-theme-onelight"
},
"dependencies": {
"nacara": "^1.8.0",
"remark-parse": "^10.0.1"
}
}
================================================
FILE: src/Fable.Elmish.fsproj
================================================
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>netstandard2.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<DefineConstants>$(DefineConstants);FABLE_COMPILER</DefineConstants>
<Description>Elmish for Fable apps</Description>
</PropertyGroup>
<ItemGroup>
<Compile Include="prelude.fs" />
<Compile Include="cmd.fs" />
<Compile Include="cmd.obsolete.fs" />
<Compile Include="sub.fs" />
<Compile Include="ring.fs" />
<Compile Include="program.fs" />
</ItemGroup>
<ItemGroup>
<Content Include="*.fsproj; *.fs" PackagePath="fable\" />
</ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.7.*" />
<PackageReference Include="Fable.Core" Version="4.0.0" />
</ItemGroup>
</Project>
================================================
FILE: src/cmd.fs
================================================
(**
Cmd
---------
Core abstractions for dispatching messages in Elmish.
*)
namespace Elmish
open System
/// Dispatch - feed new message into the processing loop
type Dispatch<'msg> = 'msg -> unit
/// Effect - return immediately, but may schedule dispatch of a message at any time
type Effect<'msg> = Dispatch<'msg> -> unit
/// Cmd - container for effects that may produce messages
type Cmd<'msg> = Effect<'msg> list
/// Cmd module for creating and manipulating commands
[<RequireQualifiedAccess>]
module Cmd =
/// Execute the commands using the supplied dispatcher
let internal exec onError (dispatch: Dispatch<'msg>) (cmd: Cmd<'msg>) =
cmd |> List.iter (fun call -> try call dispatch with ex -> onError ex)
/// None - no commands, also known as `[]`
let none : Cmd<'msg> =
[]
/// When emitting the message, map to another type
let map (f: 'a -> 'msg) (cmd: Cmd<'a>) : Cmd<'msg> =
cmd |> List.map (fun g -> (fun dispatch -> f >> dispatch) >> g)
/// Aggregate multiple commands
let batch (cmds: #seq<Cmd<'msg>>) : Cmd<'msg> =
cmds |> List.concat
/// Command to call the effect
let ofEffect (effect: Effect<'msg>) : Cmd<'msg> =
[effect]
module OfFunc =
/// Command to evaluate a simple function and map the result
/// into success or error (of exception)
let either (task: 'a -> _) (arg: 'a) (ofSuccess: _ -> 'msg) (ofError: _ -> 'msg) : Cmd<'msg> =
let bind dispatch =
try
task arg
|> (ofSuccess >> dispatch)
with x ->
x |> (ofError >> dispatch)
[bind]
/// Command to evaluate a simple function and map the success to a message
/// discarding any possible error
let perform (task: 'a -> _) (arg: 'a) (ofSuccess: _ -> 'msg) : Cmd<'msg> =
let bind dispatch =
try
task arg
|> (ofSuccess >> dispatch)
with _ ->
()
[bind]
/// Command to evaluate a simple function and map the error (in case of exception)
let attempt (task: 'a -> unit) (arg: 'a) (ofError: _ -> 'msg) : Cmd<'msg> =
let bind dispatch =
try
task arg
with x ->
x |> (ofError >> dispatch)
[bind]
module OfAsyncWith =
/// Command that will evaluate an async block and map the result
/// into success or error (of exception)
let either (start: Async<unit> -> unit)
(task: 'a -> Async<_>)
(arg: 'a)
(ofSuccess: _ -> 'msg)
(ofError: _ -> 'msg) : Cmd<'msg> =
let bind dispatch =
async {
try
let! r = task arg
dispatch (ofSuccess r)
with x -> dispatch (ofError x)
}
[bind >> start]
/// Command that will evaluate an async block and map the success
let perform (start: Async<unit> -> unit)
(task: 'a -> Async<_>)
(arg: 'a)
(ofSuccess: _ -> 'msg) : Cmd<'msg> =
let bind dispatch =
async {
try
let! r = task arg
dispatch (ofSuccess r)
with _ -> ()
}
[bind >> start]
/// Command that will evaluate an async block and map the error (of exception)
let attempt (start: Async<unit> -> unit)
(task: 'a -> Async<_>)
(arg: 'a)
(ofError: _ -> 'msg) : Cmd<'msg> =
let bind dispatch =
async {
try
let! _ = task arg
()
with x -> dispatch (ofError x)
}
[bind >> start]
module OfAsync =
[<Obsolete("Use `AsyncHelpers.start` instead")>]
#if FABLE_COMPILER
let start x = Timer.delay 1 (fun _ -> Async.StartImmediate x)
#else
let inline start x = Async.Start x
#endif
/// Command that will evaluate an async block and map the result
/// into success or error (of exception)
let inline either (task: 'a -> Async<_>)
(arg: 'a)
(ofSuccess: _ -> 'msg)
(ofError: _ -> 'msg) : Cmd<'msg> =
OfAsyncWith.either AsyncHelpers.start task arg ofSuccess ofError
/// Command that will evaluate an async block and map the success
let inline perform (task: 'a -> Async<_>)
(arg: 'a)
(ofSuccess: _ -> 'msg) : Cmd<'msg> =
OfAsyncWith.perform AsyncHelpers.start task arg ofSuccess
/// Command that will evaluate an async block and map the error (of exception)
let inline attempt (task: 'a -> Async<_>)
(arg: 'a)
(ofError: _ -> 'msg) : Cmd<'msg> =
OfAsyncWith.attempt AsyncHelpers.start task arg ofError
module OfAsyncImmediate =
/// Command that will evaluate an async block and map the result
/// into success or error (of exception)
let inline either (task: 'a -> Async<_>)
(arg: 'a)
(ofSuccess: _ -> 'msg)
(ofError: _ -> 'msg) : Cmd<'msg> =
OfAsyncWith.either Async.StartImmediate task arg ofSuccess ofError
/// Command that will evaluate an async block and map the success
let inline perform (task: 'a -> Async<_>)
(arg: 'a)
(ofSuccess: _ -> 'msg) : Cmd<'msg> =
OfAsyncWith.perform Async.StartImmediate task arg ofSuccess
/// Command that will evaluate an async block and map the error (of exception)
let inline attempt (task: 'a -> Async<_>)
(arg: 'a)
(ofError: _ -> 'msg) : Cmd<'msg> =
OfAsyncWith.attempt Async.StartImmediate task arg ofError
#if FABLE_COMPILER
module OfPromise =
/// Command to call `promise` block and map the results
let either (task: 'a -> Fable.Core.JS.Promise<_>)
(arg:'a)
(ofSuccess: _ -> 'msg)
(ofError: #exn -> 'msg) : Cmd<'msg> =
let bind dispatch =
try
(task arg)
.``then``(ofSuccess >> dispatch)
.catch(unbox >> ofError >> dispatch)
|> ignore
with x -> x |> unbox |> ofError |> dispatch
[bind]
/// Command to call `promise` block and map the success
let perform (task: 'a -> Fable.Core.JS.Promise<_>)
(arg:'a)
(ofSuccess: _ -> 'msg) =
let bind dispatch =
try
(task arg)
.``then``(ofSuccess >> dispatch)
|> ignore
with _ -> ()
[bind]
/// Command to call `promise` block and map the error
let attempt (task: 'a -> Fable.Core.JS.Promise<_>)
(arg:'a)
(ofError: #exn -> 'msg) : Cmd<'msg> =
let bind dispatch =
try
(task arg)
.catch(unbox >> ofError >> dispatch)
|> ignore
with x -> x |> unbox |> ofError |> dispatch
[bind]
#else
open System.Threading.Tasks
#if WEBSHARPER
module OfTask =
/// Command to call a task and map the results
let inline either (task: 'a -> Task<_>)
(arg:'a)
(ofSuccess: _ -> 'msg)
(ofError: _ -> 'msg) : Cmd<'msg> =
OfAsync.either (task >> Async.AwaitTask) arg ofSuccess ofError
/// Command to call a task and map the success
let inline perform (task: 'a -> Task<_>)
(arg:'a)
(ofSuccess: _ -> 'msg) : Cmd<'msg> =
OfAsync.perform (task >> Async.AwaitTask) arg ofSuccess
/// Command to call a task and map the error
let inline attempt (task: 'a -> #Task)
(arg:'a)
(ofError: _ -> 'msg) : Cmd<'msg> =
OfAsync.attempt (task >> Async.AwaitTask) arg ofError
#else
module OfTask =
/// Command to call a task and map the results
let either (task: 'a -> Task<'b>)
(arg:'a)
(ofSuccess: 'b -> 'msg)
(ofError: exn -> 'msg) : Cmd<'msg> =
let bind dispatch =
try
TaskBuilder.task {
try
let! r = task arg in dispatch (ofSuccess r)
with ex ->
dispatch (ofError ex)
} |> ignore
with x ->
dispatch (ofError x)
[bind]
/// Command to call a task and map the success
let perform (task: 'a -> Task<'b>)
(arg:'a)
(ofSuccess: 'b -> 'msg) : Cmd<'msg> =
let bind dispatch =
try
TaskBuilder.task {
try
let! r = task arg in dispatch (ofSuccess r)
with _ -> ()
} |> ignore
with _ -> ()
[bind]
/// Command to call a task and map the error
let attempt (task: 'a -> #Task)
(arg:'a)
(ofError: exn -> 'msg) : Cmd<'msg> =
let bind dispatch =
try
TaskBuilder.task {
try
do! (task arg :> Task)
with ex ->
dispatch (ofError ex)
} |> ignore
with x ->
dispatch (ofError x)
[bind]
#endif // WEBSHARPER
#endif // FABLE_COMPILER
#if NET8_0_OR_GREATER && !(FABLE_COMPILER || WEBSHARPER)
module OfValueTask =
open System.Threading.Tasks
/// Command to call a value task and map the results
let either (task: 'a -> ValueTask<'b>)
(arg:'a)
(ofSuccess: 'b -> 'msg)
(ofError: exn -> 'msg) : Cmd<'msg> =
let bind dispatch =
try
let vt: ValueTask<'b> = task arg
if vt.IsCompleted then
if not vt.IsCompletedSuccessfully then
try
vt.GetAwaiter().GetResult() |> ignore
with ex ->
dispatch (ofError ex)
else
dispatch (ofSuccess vt.Result)
else
TaskBuilder.task {
try
let! r = vt in dispatch (ofSuccess r)
with ex ->
dispatch (ofError ex)
} |> ignore
with x ->
dispatch (ofError x)
[bind]
/// Command to call a value task and map the success
let perform (task: 'a -> ValueTask<'b>)
(arg:'a)
(ofSuccess: 'b -> 'msg) : Cmd<'msg> =
let bind dispatch =
try
let vt: ValueTask<'b> = task arg
if vt.IsCompleted then
if not vt.IsCompletedSuccessfully then
try
vt.GetAwaiter().GetResult() |> ignore
with _ -> ()
else
dispatch (ofSuccess vt.Result)
else
TaskBuilder.task {
try
let! r = vt in dispatch (ofSuccess r)
with _ -> ()
} |> ignore
with _ -> ()
[bind]
/// Command to call a value task and map the error
let attempt (task: 'a -> ValueTask)
(arg:'a)
(ofError: exn -> 'msg) : Cmd<'msg> =
let bind dispatch =
try
let vt: ValueTask = task arg
if vt.IsCompleted then
if not vt.IsCompletedSuccessfully then
try
vt.GetAwaiter().GetResult()
with ex ->
dispatch (ofError ex)
else
TaskBuilder.task {
try
let! _ = vt in ()
with ex ->
dispatch (ofError ex)
} |> ignore
with x ->
dispatch (ofError x)
[bind]
#endif
/// Command to issue a specific message
let inline ofMsg (msg:'msg) : Cmd<'msg> =
[fun dispatch -> dispatch msg]
================================================
FILE: src/cmd.obsolete.fs
================================================
namespace Elmish
open System
#nowarn "44"
[<AutoOpen>]
module Obsolete =
/// Cmd module for creating and manipulating commands
[<RequireQualifiedAccess>]
module Cmd =
module OfFunc =
/// Command to issue a specific message
[<Obsolete("Use `either`,`attempt` or `perform` instead")>]
let result (msg:'msg) : Cmd<'msg> =
[fun dispatch -> dispatch msg]
module OfAsyncWith =
/// Command that will evaluate an async block to the message
[<Obsolete("Use `either`,`attempt` or `perform` instead")>]
let result (start: Async<unit> -> unit)
(task: Async<'msg>) : Cmd<'msg> =
let bind dispatch =
async {
let! r = task
dispatch r
}
[bind >> start]
module OfAsync =
/// Command that will evaluate an async block to the message
[<Obsolete("Use `either`,`attempt` or `perform` instead")>]
let inline result (task: Async<'msg>) : Cmd<'msg> =
OfAsyncWith.result Cmd.OfAsync.start task
module OfAsyncImmediate =
/// Command that will evaluate an async block to the message
[<Obsolete("Use `either`,`attempt` or `perform` instead")>]
let inline result (task: Async<'msg>) : Cmd<'msg> =
OfAsyncWith.result Async.StartImmediate task
#if FABLE_COMPILER
module OfPromise =
/// Command to dispatch the `promise` result
[<Obsolete("Use `either`,`attempt` or `perform` instead")>]
let result (task: Fable.Core.JS.Promise<'msg>) : Cmd<'msg> =
let bind dispatch =
task.``then`` dispatch
|> ignore
[bind]
#else
open System.Threading.Tasks
module OfTask =
/// Command and map the task success
[<Obsolete("Use `either`,`attempt` or `perform` instead")>]
let inline result (task: Task<'msg>) : Cmd<'msg> =
OfAsync.result (task |> Async.AwaitTask)
#endif
================================================
FILE: src/prelude.fs
================================================
namespace Elmish
(**
Log
---------
Basic cross-platform logging API.
*)
module internal Log =
#if FABLE_COMPILER
open Fable.Core.JS
let onError (text: string, ex: exn) = console.error (text,ex)
let toConsole(text: string, o: #obj) = console.log(text,o)
#else
#if NETSTANDARD2_0
let onError (text: string, ex: exn) = System.Diagnostics.Trace.TraceError("{0}: {1}", text, ex)
let toConsole(text: string, o: #obj) = printfn "%s: %A" text o
#else
let onError (text: string, ex: exn) = System.Console.Error.WriteLine("{0}: {1}", text, ex)
let toConsole(text: string, o: #obj) = printfn "%s: %A" text o
#endif
#endif
#if FABLE_COMPILER
module internal Timer =
open System.Timers
let delay interval callback =
let t = new Timer(float interval, AutoReset = false)
t.Elapsed.Add callback
t.Enabled <- true
t.Start()
#endif
module AsyncHelpers =
#if FABLE_COMPILER
let start x = Timer.delay 1 (fun _ -> Async.StartImmediate x)
#else
let inline start x = Async.Start x
#endif
================================================
FILE: src/program.fs
================================================
(**
Program
---------
Core abstractions for creating and running the dispatch loop.
*)
namespace Elmish
/// Program type captures various aspects of program behavior
type Program<'arg, 'model, 'msg, 'view> = private {
init : 'arg -> 'model * Cmd<'msg>
update : 'msg -> 'model -> 'model * Cmd<'msg>
subscribe : 'model -> Sub<'msg>
view : 'model -> Dispatch<'msg> -> 'view
setState : 'model -> Dispatch<'msg> -> unit
onError : (string*exn) -> unit
termination : ('msg -> bool) * ('model -> unit)
}
/// Program module - functions to manipulate program instances
[<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Program =
/// Typical program, new commands are produced by `init` and `update` along with the new state.
let mkProgram
(init : 'arg -> 'model * Cmd<'msg>)
(update : 'msg -> 'model -> 'model * Cmd<'msg>)
(view : 'model -> Dispatch<'msg> -> 'view) =
{ init = init
update = update
view = view
setState = fun model -> view model >> ignore
subscribe = fun _ -> Sub.none
onError = Log.onError
termination = (fun _ -> false), ignore }
/// Simple program that produces only new state with `init` and `update`.
let mkSimple
(init : 'arg -> 'model)
(update : 'msg -> 'model -> 'model)
(view : 'model -> Dispatch<'msg> -> 'view) =
{ init = init >> fun state -> state, Cmd.none
update = fun msg -> update msg >> fun state -> state, Cmd.none
view = view
setState = fun model -> view model >> ignore
subscribe = fun _ -> Sub.none
onError = Log.onError
termination = (fun _ -> false), ignore }
/// Subscribe to external source of events, overrides existing subscription.
/// Return the subscriptions that should be active based on the current model.
/// Subscriptions will be started or stopped automatically to match.
let withSubscription (subscribe : 'model -> Sub<'msg>) (program: Program<'arg, 'model, 'msg, 'view>) =
{ program with
subscribe = subscribe }
/// Map existing subscription to external source of events.
let mapSubscription map (program: Program<'arg, 'model, 'msg, 'view>) =
{ program with
subscribe = map program.subscribe }
/// Trace all the updates to the console
let withConsoleTrace (program: Program<'arg, 'model, 'msg, 'view>) =
let traceInit (arg:'arg) =
let initModel,cmd = program.init arg
Log.toConsole ("Initial state:", initModel)
initModel,cmd
let traceUpdate msg model =
Log.toConsole ("New message:", msg)
let newModel,cmd = program.update msg model
Log.toConsole ("Updated state:", newModel)
newModel,cmd
let traceSubscribe model =
let sub = program.subscribe model
Log.toConsole ("Updated subs:", sub |> List.map fst)
sub
{ program with
init = traceInit
update = traceUpdate
subscribe = traceSubscribe }
/// Trace all the messages as they update the model and subscriptions
let withTrace trace (program: Program<'arg, 'model, 'msg, 'view>) =
let update msg model =
let state,cmd = program.update msg model
let subIds = program.subscribe state |> List.map fst
trace msg state subIds
state,cmd
{ program with
update = update }
/// Handle dispatch loop exceptions
let withErrorHandler onError (program: Program<'arg, 'model, 'msg, 'view>) =
{ program with
onError = onError }
/// Exit criteria and the handler, overrides existing.
let withTermination (predicate: 'msg -> bool) (terminate: 'model -> unit) (program: Program<'arg, 'model, 'msg, 'view>) =
{ program with
termination = predicate, terminate }
/// Map existing criteria and the handler.
let mapTermination map (program: Program<'arg, 'model, 'msg, 'view>) =
{ program with
termination = map program.termination }
/// Map existing error handler and return new `Program`
let mapErrorHandler map (program: Program<'arg, 'model, 'msg, 'view>) =
{ program with
onError = map program.onError }
/// Get the current error handler
let onError (program: Program<'arg, 'model, 'msg, 'view>) =
program.onError
/// Function to render the view with the latest state
let withSetState (setState:'model -> Dispatch<'msg> -> unit)
(program: Program<'arg, 'model, 'msg, 'view>) =
{ program with
setState = setState }
/// Return the function to render the state
let setState (program: Program<'arg, 'model, 'msg, 'view>) =
program.setState
/// Return the view function
let view (program: Program<'arg, 'model, 'msg, 'view>) =
program.view
/// Return the init function
let init (program: Program<'arg, 'model, 'msg, 'view>) =
program.init
/// Return the update function
let update (program: Program<'arg, 'model, 'msg, 'view>) =
program.update
/// Map the program type
let map mapInit mapUpdate mapView mapSetState mapSubscribe mapTermination
(program: Program<'arg, 'model, 'msg, 'view>) =
{ init = mapInit program.init
update = mapUpdate program.update
view = mapView program.view
setState = mapSetState program.setState
subscribe = mapSubscribe program.subscribe
onError = program.onError
termination = mapTermination program.termination }
module Subs = Sub.Internal
/// Start the program loop.
/// syncDispatch: specify how to serialize dispatch calls.
/// arg: argument to pass to the init() function.
/// program: program created with 'mkSimple' or 'mkProgram'.
let runWithDispatch (syncDispatch: Dispatch<'msg> -> Dispatch<'msg>) (arg: 'arg) (program: Program<'arg, 'model, 'msg, 'view>) =
let (model,cmd) = program.init arg
let sub = program.subscribe model
let toTerminate, terminate = program.termination
let rb = RingBuffer 10
let mutable reentered = false
let mutable state = model
let mutable activeSubs = Subs.empty
let mutable terminated = false
let rec dispatch msg =
if not terminated then
rb.Push msg
if not reentered then
reentered <- true
processMsgs ()
reentered <- false
and dispatch' = syncDispatch dispatch // serialized dispatch
and processMsgs () =
let mutable nextMsg = rb.Pop()
while not terminated && Option.isSome nextMsg do
let msg = nextMsg.Value
try
if toTerminate msg then
Subs.Fx.stop program.onError activeSubs
terminate state
terminated <- true
else
let (model',cmd') = program.update msg state
let sub' = program.subscribe model'
program.setState model' dispatch'
activeSubs <- Subs.diff activeSubs sub' |> Subs.Fx.change program.onError dispatch'
cmd' |> Cmd.exec (fun ex -> program.onError (sprintf "Error handling the message: %A" msg, ex)) dispatch'
state <- model'
with ex ->
program.onError (sprintf "Unable to process the message: %A" msg, ex)
nextMsg <- rb.Pop()
reentered <- true
program.setState model dispatch'
activeSubs <- Subs.diff activeSubs sub |> Subs.Fx.change program.onError dispatch'
cmd |> Cmd.exec (fun ex -> program.onError (sprintf "Error intitializing:", ex)) dispatch'
processMsgs ()
reentered <- false
/// Start the single-threaded dispatch loop.
/// arg: argument to pass to the 'init' function.
/// program: program created with 'mkSimple' or 'mkProgram'.
let runWith (arg: 'arg) (program: Program<'arg, 'model, 'msg, 'view>) = runWithDispatch id arg program
/// Start the dispatch loop with `unit` for the init() function.
let run (program: Program<unit, 'model, 'msg, 'view>) = runWith () program
================================================
FILE: src/ring.fs
================================================
namespace Elmish
open System
[<Struct>]
type internal RingState<'item> =
| Writable of wx:'item array * ix:int
| ReadWritable of rw:'item array * wix:int * rix:int
type internal RingBuffer<'item>(size) =
let doubleSize ix (items: 'item array) =
seq { yield! items |> Seq.skip ix
yield! items |> Seq.take ix
for _ in 0..items.Length do
yield Unchecked.defaultof<'item> }
|> Array.ofSeq
let mutable state : 'item RingState =
Writable (Array.zeroCreate (max size 10), 0)
member __.Pop() =
match state with
| ReadWritable (items, wix, rix) ->
let rix' = (rix + 1) % items.Length
match rix' = wix with
| true ->
state <- Writable(items, wix)
| _ ->
state <- ReadWritable(items, wix, rix')
Some items.[rix]
| _ ->
None
member __.Push (item:'item) =
match state with
| Writable (items, ix) ->
items.[ix] <- item
let wix = (ix + 1) % items.Length
state <- ReadWritable(items, wix, ix)
| ReadWritable (items, wix, rix) ->
items.[wix] <- item
let wix' = (wix + 1) % items.Length
match wix' = rix with
| true ->
state <- ReadWritable(items |> doubleSize rix, items.Length, 0)
| _ ->
state <- ReadWritable(items, wix', rix)
================================================
FILE: src/sub.fs
================================================
namespace Elmish
open System
/// SubId - Subscription ID, alias for string list
type SubId = string list
/// Subscribe - Starts a subscription, returns IDisposable to stop it
type Subscribe<'msg> = Dispatch<'msg> -> IDisposable
/// Subscription - Generates new messages when running
type Sub<'msg> = (SubId * Subscribe<'msg>) list
module Sub =
/// None - no subscriptions, also known as `[]`
let none : Sub<'msg> =
[]
/// Aggregate multiple subscriptions
let batch (subs: #seq<Sub<'msg>>) : Sub<'msg> =
subs |> List.concat
/// When emitting the message, map to another type.
/// To avoid ID conflicts with other components, scope SubIds with a prefix.
let map (idPrefix: string) (f: 'a -> 'msg) (sub: Sub<'a>) : Sub<'msg> =
sub |> List.map (fun (subId, subscribe) ->
idPrefix :: subId,
fun dispatch -> subscribe (f >> dispatch))
module Internal =
module SubId =
let toString (subId: SubId) =
String.Join("/", subId)
module Fx =
let warnDupe onError subId =
let ex = exn "Duplicate SubId"
onError ("Duplicate SubId: " + SubId.toString subId, ex)
let tryStop onError (subId, sub: IDisposable) =
try
sub.Dispose()
with ex ->
onError ("Error stopping subscription: " + SubId.toString subId, ex)
let tryStart onError dispatch (subId, start) : (SubId * IDisposable) option =
try
Some (subId, start dispatch)
with ex ->
onError ("Error starting subscription: " + SubId.toString subId, ex)
None
let stop onError subs =
subs |> List.iter (tryStop onError)
let change onError dispatch (dupes, toStop, toKeep, toStart) =
dupes |> List.iter (warnDupe onError)
toStop |> List.iter (tryStop onError)
let started = toStart |> List.choose (tryStart onError dispatch)
List.append toKeep started
module NewSubs =
let (_dupes, _newKeys, _newSubs) as init =
List.empty, Set.empty, List.empty
let update (subId, start) (dupes, newKeys, newSubs) =
if Set.contains subId newKeys then
subId :: dupes, newKeys, newSubs
else
dupes, Set.add subId newKeys, (subId, start) :: newSubs
let calculate subs =
List.foldBack update subs init
let empty = List.empty<SubId * IDisposable>
let diff (activeSubs: (SubId * IDisposable) list) (sub: Sub<'msg>) =
let keys = activeSubs |> List.map fst |> Set.ofList
let dupes, newKeys, newSubs = NewSubs.calculate sub
if keys = newKeys then
dupes, [], activeSubs, []
else
let toKeep, toStop = activeSubs |> List.partition (fun (k, _) -> Set.contains k newKeys)
let toStart = newSubs |> List.filter (fun (k, _) -> not (Set.contains k keys))
dupes, toStop, toKeep, toStart
================================================
FILE: tests/Attributes.fs
================================================
namespace Elmish.Tests
open NUnit.Framework
[<assembly: Parallelizable(ParallelScope.All)>]
do ()
================================================
FILE: tests/CmdTests.fs
================================================
module Elmish.CmdTests
open NUnit.Framework
open Swensen.Unquote
open Elmish
type Msg =
| OnError of exn
| OnSuccess of string
[<Test>]
let ``Cmd.OfAsync.either - works`` () =
let myTask () =
async {
return "Task completed"
}
let init () = "initial", Cmd.OfAsync.either myTask () OnSuccess OnError
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Task completed"
[<Test>]
let ``Cmd.OfAsync.attempt - works`` () =
let mutable result = ""
let myTask () =
async {
// Cmd.OfAsync.attempt don't notifiy about success
// so we use a mutable variable to check if the task was called
result <- "Task called"
return "Task completed"
}
let init () = "initial", Cmd.OfAsync.attempt myTask () OnError
let update msg _ =
match msg with
| OnError ex -> "Error was captured", Cmd.none
| OnSuccess res -> res, Cmd.none
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Task called"
[<Test>]
let ``Cmd.OfAsync.perform - works`` () =
let myTask () =
async {
return "Task completed"
}
let init () = "initial", Cmd.OfAsync.perform myTask () OnSuccess
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Task completed"
[<Test>]
let ``Cmd.OfAsync.either - thrown exception when generating task should be captured`` () =
let myTask () =
failwith "Boom!"
async {
return "Task completed"
}
let init () = "initial", Cmd.OfAsync.either myTask () OnSuccess OnError
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Boom!"
[<Test>]
let ``Cmd.OfAsync.attempt - thrown exception when generating task should be captured`` () =
let myTask () =
failwith "Boom!"
async {
return "Task completed"
}
let init () = "initial", Cmd.OfAsync.attempt myTask () OnError
let update msg _ =
match msg with
| OnError ex -> "Error was captured", Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Error was captured"
[<Test>]
let ``Cmd.OfAsync.perform - thrown exception when generating task should be discarded`` () =
let myTask () =
failwith "Boom!"
async {
return "Task completed"
}
let init () = "initial", Cmd.OfAsync.perform myTask () OnSuccess
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "initial"
[<Test>]
let ``Cmd.OfAsync.either - thrown exception from inside task should be captured`` () =
let myTask () =
async {
failwith "Boom!"
return "Task completed"
}
let init () = "initial", Cmd.OfAsync.either myTask () OnSuccess OnError
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Boom!"
[<Test>]
let ``Cmd.OfAsync.attempt - thrown exception from inside task should be captured`` () =
let myTask () =
async {
failwith "Boom!"
return "Task completed"
}
let init () = "initial", Cmd.OfAsync.attempt myTask () OnError
let update msg _ =
match msg with
| OnError ex -> "Error was captured", Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Error was captured"
[<Test>]
let ``Cmd.OfAsync.perform - thrown exception from inside task should be discarded`` () =
let myTask () =
async {
failwith "Boom!"
return "Task completed"
}
let init () = "initial", Cmd.OfAsync.perform myTask () OnSuccess
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "initial"
#if !FABLE_COMPILER
[<Test>]
let ``Cmd.OfTask.either - works`` () =
let myTask () =
System.Threading.Tasks.Task.FromResult("Task completed")
let init () = "initial", Cmd.OfTask.either myTask () OnSuccess OnError
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Task completed"
[<Test>]
let ``Cmd.OfTask.attempt - works`` () =
let mutable result = ""
let myTask () =
// Cmd.OfTask.attempt don't notify about success
// so we use a mutable variable to check if the task was called
result <- "Task called"
System.Threading.Tasks.Task.CompletedTask
let init () = "initial", Cmd.OfTask.attempt myTask () OnError
let update msg _ =
match msg with
| OnError ex -> "Error was captured", Cmd.none
| OnSuccess res -> res, Cmd.none
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Task called"
[<Test>]
let ``Cmd.OfTask.perform - works`` () =
let myTask () =
System.Threading.Tasks.Task.FromResult("Task completed")
let init () = "initial", Cmd.OfTask.perform myTask () OnSuccess
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Task completed"
[<Test>]
let ``Cmd.OfTask.either - thrown exception when generating task should be captured`` () =
let myTask () =
failwith "Boom!"
System.Threading.Tasks.Task.FromResult("Task completed")
let init () = "initial", Cmd.OfTask.either myTask () OnSuccess OnError
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Boom!"
[<Test>]
let ``Cmd.OfTask.attempt - thrown exception when generating task should be captured`` () =
let myTask () =
failwith "Boom!"
System.Threading.Tasks.Task.CompletedTask
let init () = "initial", Cmd.OfTask.attempt myTask () OnError
let update msg _ =
match msg with
| OnError ex -> "Error was captured", Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Error was captured"
[<Test>]
let ``Cmd.OfTask.perform - thrown exception when generating task should be discarded`` () =
let myTask () =
failwith "Boom!"
System.Threading.Tasks.Task.FromResult("Task completed")
let init () = "initial", Cmd.OfTask.perform myTask () OnSuccess
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "initial"
[<Test>]
let ``Cmd.OfTask.either - faulted task should be captured`` () =
let myTask () =
System.Threading.Tasks.Task.FromException<string>(System.Exception("Task failed"))
let init () = "initial", Cmd.OfTask.either myTask () OnSuccess OnError
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Task failed"
[<Test>]
let ``Cmd.OfTask.attempt - faulted task should be captured`` () =
let myTask () =
System.Threading.Tasks.Task.FromException(System.Exception("Task failed"))
let init () = "initial", Cmd.OfTask.attempt myTask () OnError
let update msg _ =
match msg with
| OnError ex -> "Error was captured", Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Error was captured"
[<Test>]
let ``Cmd.OfTask.perform - faulted task should be discarded`` () =
let myTask () =
System.Threading.Tasks.Task.FromException<string>(System.Exception("Task failed"))
let init () = "initial", Cmd.OfTask.perform myTask () OnSuccess
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "initial"
#endif
#if !FABLE_COMPILER && !NETSTANDARD2_0
open System.Threading.Tasks
open System
[<Test>]
let ``Cmd.OfValueTask.either - works`` () =
let myTask () = ValueTask<string>("ValueTask completed")
let init () = "initial", Cmd.OfValueTask.either myTask () OnSuccess OnError
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "ValueTask completed"
[<Test>]
let ``Cmd.OfValueTask.perform - works`` () =
let myTask () = ValueTask<string>("ValueTask completed")
let init () = "initial", Cmd.OfValueTask.perform myTask () OnSuccess
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "ValueTask completed"
[<Test>]
let ``Cmd.OfValueTask.attempt - works`` () =
let mutable result = ""
let myTask () =
result <- "ValueTask called"
ValueTask.CompletedTask
let init () = "initial", Cmd.OfValueTask.attempt myTask () OnError
let update msg _ =
match msg with
| OnError ex -> "Error was captured", Cmd.none
| OnSuccess res -> res, Cmd.none
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "ValueTask called"
[<Test>]
let ``Cmd.OfValueTask.either - thrown exception when generating task should be captured`` () =
let myTask () =
failwith "Boom!"
ValueTask<string>("ValueTask completed")
let init () = "initial", Cmd.OfValueTask.either myTask () OnSuccess OnError
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Boom!"
[<Test>]
let ``Cmd.OfValueTask.attempt - thrown exception when generating task should be captured`` () =
let myTask () =
failwith "Boom!"
ValueTask.CompletedTask
let init () = "initial", Cmd.OfValueTask.attempt myTask () OnError
let update msg _ =
match msg with
| OnError ex -> "Error was captured", Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Error was captured"
[<Test>]
let ``Cmd.OfValueTask.perform - thrown exception when generating task should be discarded`` () =
let myTask () =
failwith "Boom!"
ValueTask<string>("ValueTask completed")
let init () = "initial", Cmd.OfValueTask.perform myTask () OnSuccess
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "initial"
[<Test>]
let ``Cmd.OfValueTask.either - faulted ValueTask should be captured`` () =
let myTask () = ValueTask<string>(Task.FromException<string>(Exception("ValueTask failed")))
let init () = "initial", Cmd.OfValueTask.either myTask () OnSuccess OnError
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "ValueTask failed"
[<Test>]
let ``Cmd.OfValueTask.attempt - faulted ValueTask should be captured`` () =
let myTask () = ValueTask(Task.FromException(Exception("ValueTask failed")))
let init () = "initial", Cmd.OfValueTask.attempt myTask () OnError
let update msg _ =
match msg with
| OnError ex -> "Error was captured", Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "Error was captured"
[<Test>]
let ``Cmd.OfValueTask.perform - faulted ValueTask should be discarded`` () =
let myTask () = ValueTask<string>(Task.FromException<string>(Exception("ValueTask failed")))
let init () = "initial", Cmd.OfValueTask.perform myTask () OnSuccess
let update msg _ =
match msg with
| OnError ex -> ex.Message, Cmd.none
| OnSuccess res -> res, Cmd.none
let mutable result = ""
let view model _ = result <- model
async {
Program.mkProgram init update view
|> Program.run
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
result =! "initial"
#endif
================================================
FILE: tests/Elmish.Tests.fsproj
================================================
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
<ProjectReference Include="../netstandard/Elmish.fsproj" />
</ItemGroup>
<ItemGroup>
<Compile Include="../src/ring.fs" />
<Compile Include="SubTests.fs" />
<Compile Include="RingTest.fs" />
<Compile Include="ProgramTest.fs" />
<Compile Include="CmdTests.fs" />
<Compile Include="Attributes.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FsCheck" Version="3.3.0" />
<PackageReference Include="FsCheck.NUnit" Version="3.3.0" />
<PackageReference Include="NUnit" Version="4.3.2" />
<PackageReference Include="NUnit3TestAdapter" Version="5.0.0">
<IncludeAssets>runtime; build; native; contentfiles; analyzers; buildtransitive</IncludeAssets>
<PrivateAssets>all</PrivateAssets>
</PackageReference>
<PackageReference Include="Unquote" Version="7.0.1" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.14.1" />
</ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="9.0.300" />
</ItemGroup>
</Project>
================================================
FILE: tests/ProgramTest.fs
================================================
module Elmish.ProgramTests
open NUnit.Framework
open FsCheck.NUnit
open Swensen.Unquote
open Elmish
type Model = int
type Msg =
| Increment
| Decrement
| Increment10Times
[<Property(MaxTest = 10, EndSize = 100)>]
let dispatchesBatch (msgs: Msg list) =
let init msgs = 0, msgs |> List.map Cmd.ofMsg |> Cmd.batch
let update msg m =
match msg with
| Increment -> m + 1, Cmd.none
| Decrement -> m - 1, Cmd.none
| Increment10Times -> m, Cmd.batch [ for _ in 1..10 -> Cmd.ofMsg Increment ]
printfn "Folding..."
let expected =
(0, msgs)
||> List.fold (fun s -> function Increment -> s + 1 | Decrement -> s - 1 | Increment10Times -> s + 10)
let mutable counted = 0
let count m _ = counted <- m
printfn "Starting..."
async {
Program.mkProgram init update count
|> Program.runWith msgs
} |> Async.Start
System.Threading.Thread.Sleep (1_000)
counted =! expected
[<Test>]
let ``update throwing exception should not crash the program`` () =
let o = obj()
let syncDispatch dispatch = lock o (fun () -> dispatch)
let init _ = 0, Cmd.OfAsync.perform async.Return Increment id
let update _ _ = failwith "Boom!"
let view _ = ignore
let mutable called = false
let onError _ = called <- true
Program.mkProgram init update view
|> Program.withConsoleTrace
|> Program.mapErrorHandler (fun _ -> onError)
|> Program.runWithDispatch syncDispatch ()
System.Threading.Thread.Sleep (1_000)
called =! true
================================================
FILE: tests/RingTest.fs
================================================
module Elmish.RingTests
open FsCheck
open FsCheck.NUnit
open System.Collections.Generic
open Swensen.Unquote
type Op =
| Pop
| Push of PositiveInt
type OpResult =
| Poped of PositiveInt option
| Pushed
let internal applyQOps (ops:Op list) (q:PositiveInt Queue) =
ops
|> List.map (function
| Pop ->
match q.TryDequeue() with (true, v) -> Some v | _ -> None
|> Poped
| Push v ->
q.Enqueue v
Pushed)
let internal applyRBOps (ops:Op list) (rb:PositiveInt RingBuffer) =
ops
|> List.map (function
| Pop ->
Poped <| rb.Pop()
| Push v ->
rb.Push v
Pushed)
[<Property(MaxTest = 1000, EndSize = 1000)>]
let actsLikeAQueue (ops:Op list) =
let q = Queue()
let rb = RingBuffer 10
(q |> applyQOps ops) =! (rb |> applyRBOps ops)
// have to have these here or dotnet won't find the nunit tests :/
open NUnit.Framework
[<Test>]
let ok() =
1 =! 1
================================================
FILE: tests/SubTests.fs
================================================
module Elmish.SubTests
open Elmish
open NUnit.Framework
open Swensen.Unquote
open System
// TIL: Each use of a let fn binding creates a new FSharpFunc object.
// Meaning reference equality with let fn binding is always false.
// As record properties, these become concrete objects, ref equality works.
type SubContainer =
{ Sub: Dispatch<obj> -> IDisposable
Dupe: Dispatch<obj> -> IDisposable }
[<TestFixture>]
type DiffBehavior() =
// data
let stop = {new IDisposable with member _.Dispose() = () }
let sub = {Sub = (fun _ -> stop); Dupe = (fun _ -> stop) }
let newId i = ["sub"; string i]
let gen idRangeStart idRangeEnd second =
let count = idRangeEnd + 1 - idRangeStart
List.init count (fun i -> newId (idRangeStart + i), second)
let genSub idRangeStart idRangeEnd whichSub =
let count = idRangeEnd + 1 - idRangeStart
List.init count (fun i -> newId (idRangeStart + i), whichSub)
// helpers
let toKeys keyValueList =
List.map fst keyValueList
let toIds (dupes, toStop, toKeep, toStart) =
{| Dupes = dupes; ToStop = toKeys toStop; ToKeep = toKeys toKeep; ToStart = toKeys toStart |}
let toIds2 (dupes, toStop, toKeep, toStart) =
{| Dupes = toKeys dupes; ToStop = toKeys toStop; ToKeep = toKeys toKeep; ToStart = toKeys toStart |}
let run = Sub.Internal.diff
let eq expected actual =
toIds2 expected =! toIds actual
[<Test>]
member _.``no changes when subs and active subs are the same`` () =
let activeSubs = gen 0 6 stop
let subs = genSub 0 6 sub.Sub
let expected = [], [], activeSubs, []
let actual = run activeSubs subs
eq expected actual
[<Test>]
member _.``active subs are stopped when not found in subs`` () =
let activeSubs = gen 0 6 stop
let subs = genSub 3 6 sub.Sub
let expected = [], activeSubs[0..2], activeSubs[3..6], []
let actual = run activeSubs subs
eq expected actual
[<Test>]
member _.``subs are started when not found in active subs`` () =
let activeSubs = gen 0 2 stop
let subs = genSub 0 6 sub.Sub
let expected = [], [], activeSubs, subs[3..6]
let actual = run activeSubs subs
eq expected actual
[<Test>]
member _.``subs are started and stopped when subs has new ids and omits old ids`` () =
let activeSubs = gen 0 6 stop
let tmp = genSub 0 9 sub.Sub
let subs = tmp[3..9]
let expected = [], activeSubs[0..2], activeSubs[3..6], tmp[7..9]
let actual = run activeSubs subs
eq expected actual
[<Test>]
member _.``dupe subs are detected even when there are no changes`` () =
let activeSubs = gen 0 6 stop
let subs = Sub.batch [genSub 2 2 sub.Dupe; genSub 2 2 sub.Dupe; genSub 0 6 sub.Sub]
let expected = subs[0..1], [], activeSubs, []
let actual = run activeSubs subs
eq expected actual
[<Test>]
member _.``last dupe wins when starting new subs`` () =
let activeSubs = []
let dupeSubId = newId 2
let subs = List.concat [genSub 2 2 sub.Dupe; genSub 2 2 sub.Dupe; genSub 0 6 sub.Sub]
let expected = subs[0..1], [], activeSubs, subs[2..8]
let ((dupes, _, _, toStart) as actual) = run activeSubs subs
let startId, startDupe = toStart[2]
Assert.That(List.forall (fun subId -> dupeSubId = subId) dupes, "Dupes have wrong ID")
Assert.That(dupeSubId, Is.EqualTo<string> startId, "Started dupe has wrong ID")
Assert.That(sub.Sub, Is.SameAs startDupe, "Started dupe is the wrong one")
Assert.That(sub.Dupe, Is.Not.SameAs startDupe, "Started dupe is the wrong one")
eq expected actual
================================================
FILE: websharper/WebSharper.Elmish.fsproj
================================================
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<Description>Elmish core for WebSharper apps</Description>
<TargetFrameworks>netstandard2.0</TargetFrameworks>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<DefineConstants>$(DefineConstants);WEBSHARPER</DefineConstants>
</PropertyGroup>
<ItemGroup>
<Compile Include="prelude.fs" />
<Compile Include="../src/cmd.fs" />
<Compile Include="../src/sub.fs" />
<Compile Include="../src/ring.fs" />
<Compile Include="../src/program.fs" />
<None Include="wsconfig.json" />
</ItemGroup>
<ItemGroup>
<ImportPackage Update="FSharp.Core" Version="6.0.*" />
<PackageReference Include="WebSharper" Version="8.0.0.540" />
<PackageReference Include="WebSharper.FSharp" Version="8.0.0.540" />
</ItemGroup>
</Project>
================================================
FILE: websharper/prelude.fs
================================================
namespace Elmish
open WebSharper
open WebSharper.JavaScript
module internal Unchecked =
[<Inline>]
let defaultof<'T> = As<'T> null
module internal Array =
[<Inline>]
let zeroCreate size = As<'T[]> (Array.zeroCreate<obj> size)
module internal Log =
let onError (text: string, ex: exn) = Console.Error (text,ex)
let toConsole(text: string, o: #obj) = Console.Log(text,o)
module AsyncHelpers =
let inline start x = Async.Start x
================================================
FILE: websharper/wsconfig.json
================================================
{
"$schema": "https://websharper.com/wsconfig.schema.json",
"project": "proxy",
"proxyTargetName": "Elmish"
}
gitextract_g05siaj6/
├── .gitattributes
├── .github/
│ ├── CONTRIBUTING.md
│ ├── ISSUE_TEMPLATE.md
│ └── workflows/
│ ├── ci.yml
│ └── publish.yml
├── .gitignore
├── .nacara/
│ └── _partials/
│ └── footer.js
├── .npmrc
├── .vscode/
│ ├── settings.json
│ └── tasks.json
├── Elmish.slnx
├── LICENSE.md
├── README.md
├── RELEASE_NOTES.md
├── appveyor.yml
├── babel.config.json
├── build.fsx
├── docs/
│ ├── _partials/
│ │ └── footer.jsx
│ ├── docs/
│ │ ├── basics.fsx
│ │ ├── menu.json
│ │ ├── parent-child.fsx
│ │ ├── subscription.fsx
│ │ └── subscriptionv3.fsx
│ ├── index.md
│ ├── release_notes.md
│ ├── scss/
│ │ └── fable-font.scss
│ ├── static/
│ │ └── img/
│ │ ├── commands.wsd
│ │ ├── flow.wsd
│ │ └── parent-child.wsd
│ └── style.scss
├── global.json
├── nacara.config.json
├── netstandard/
│ └── Elmish.fsproj
├── package.json
├── src/
│ ├── Fable.Elmish.fsproj
│ ├── cmd.fs
│ ├── cmd.obsolete.fs
│ ├── prelude.fs
│ ├── program.fs
│ ├── ring.fs
│ └── sub.fs
├── tests/
│ ├── Attributes.fs
│ ├── CmdTests.fs
│ ├── Elmish.Tests.fsproj
│ ├── ProgramTest.fs
│ ├── RingTest.fs
│ └── SubTests.fs
└── websharper/
├── WebSharper.Elmish.fsproj
├── prelude.fs
└── wsconfig.json
Condensed preview — 50 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (144K chars).
[
{
"path": ".gitattributes",
"chars": 11,
"preview": "* text=auto"
},
{
"path": ".github/CONTRIBUTING.md",
"chars": 1529,
"preview": "### Contributor guidelines\n\nFirst of all - thanks for taking the time to contribute!\n\nWith that in mind, elmish is a you"
},
{
"path": ".github/ISSUE_TEMPLATE.md",
"chars": 408,
"preview": "### Description\n\nPlease provide a succinct description of your issue.\n\n### Repro code\n\nPlease provide the F# code to rep"
},
{
"path": ".github/workflows/ci.yml",
"chars": 324,
"preview": "name: .NET\n\non:\n push:\n branches: [ v4.x ]\n pull_request:\n branches: [ v4.x ]\n\njobs:\n build:\n\n runs-on: ubun"
},
{
"path": ".github/workflows/publish.yml",
"chars": 767,
"preview": "name: Publish\non:\n push:\n branches:\n - v4.x\n workflow_dispatch:\njobs:\n build:\n runs-on: ubuntu-latest\n "
},
{
"path": ".gitignore",
"chars": 220,
"preview": "# OSX\n#\n.DS_Store\n\n# node.js\n#\n**/node_modules/\n**/npm/\nnpm-debug.log\n\n# F#\n.fake/\npackages/\nbuild/\nobj\nbin\nout\n\n# git\n*"
},
{
"path": ".nacara/_partials/footer.js",
"chars": 3883,
"preview": "import React from 'react';\n\nconst SitemapSection = ({\n title,\n children\n}) => /*#__PURE__*/React.createElement(\"div\", "
},
{
"path": ".npmrc",
"chars": 19,
"preview": "engine-strict=true\n"
},
{
"path": ".vscode/settings.json",
"chars": 133,
"preview": "{\n \"plantuml.exportOutDir\": \"docs/files/img\",\n \"plantuml.diagramsRoot\": \"docs/content\",\n \"plantuml.exportSubFol"
},
{
"path": ".vscode/tasks.json",
"chars": 801,
"preview": "{\n // See https://go.microsoft.com/fwlink/?LinkId=733558\n // for the documentation about the tasks.json format\n "
},
{
"path": "Elmish.slnx",
"chars": 428,
"preview": "<Solution>\n <Folder Name=\"/Solution Items/\">\n <File Path=\"build.fsx\" />\n <File Path=\"global.json\" />\n <File Pa"
},
{
"path": "LICENSE.md",
"chars": 560,
"preview": "Copyright 2016-2020 elmish contributors\n\nLicensed under the Apache License, Version 2.0 (the \"License\");\nyou may not use"
},
{
"path": "README.md",
"chars": 2159,
"preview": "Elmish: Elm-like abstractions for F# applications.\n=======\n\n[](ht"
},
{
"path": "RELEASE_NOTES.md",
"chars": 4088,
"preview": "## 5.0.2\n* Fix: OfTask.attempt signature\n\n## 5.0.1\n* Fix: Conditions around ValueTask for target platforms\n\n## 5.0.0\n* I"
},
{
"path": "appveyor.yml",
"chars": 150,
"preview": "image: Visual Studio 2022\n\ninstall:\n - ps: Install-Product node 17 x64\n\nbuild_script:\n - cmd: dotnet fsi build.fsx\n\nca"
},
{
"path": "babel.config.json",
"chars": 57,
"preview": "{\n \"presets\": [\n \"@babel/preset-react\"\n ]\n}\n"
},
{
"path": "build.fsx",
"chars": 4769,
"preview": "#!/usr/bin/env -S dotnet fsi\n#r \"nuget: Fake.Core.Target, 5.23.1\"\n#r \"nuget: Fake.IO.FileSystem, 5.23.1\"\n#r \"nuget: Fake"
},
{
"path": "docs/_partials/footer.jsx",
"chars": 3932,
"preview": "import React from 'react';\n\nconst SitemapSection = ({ title, children }) => (\n <div className=\"sitemap-section\">\n "
},
{
"path": "docs/docs/basics.fsx",
"chars": 2245,
"preview": "(**\n---\nlayout: standard\ntitle: Basics\n---\n**)\n\n(*** hide ***)\n\n// This block of code is omitted in the generated HTML d"
},
{
"path": "docs/docs/menu.json",
"chars": 232,
"preview": "[\n {\n \"type\": \"section\",\n \"label\": \"Step by step\",\n \"items\": [\n \"docs/basics\",\n "
},
{
"path": "docs/docs/parent-child.fsx",
"chars": 3403,
"preview": "(**\n---\nlayout: standard\ntitle: Parent-child composition\n---\n**)\n\n(*** hide ***)\n// This block of code is omitted in the"
},
{
"path": "docs/docs/subscription.fsx",
"chars": 27071,
"preview": "(**\n---\nlayout: standard\ntitle: Subscriptions\n---\n**)\n\n(*** hide ***)\n// This block of code is omitted in the generated"
},
{
"path": "docs/docs/subscriptionv3.fsx",
"chars": 3923,
"preview": "(**\n---\nlayout: standard\ntitle: Subscriptions (v3)\n---\n**)\n\n(*** hide ***)\n// This block of code is omitted in the gener"
},
{
"path": "docs/index.md",
"chars": 7843,
"preview": "---\nlayout: standard\ntoc: false\ntitle: Elmish\n---\n\n>`-ish` <br />\n> a suffix used to convey the sense of “having some c"
},
{
"path": "docs/release_notes.md",
"chars": 64,
"preview": "---\nlayout: changelog\nchangelog_path: ./../RELEASE_NOTES.md\n---\n"
},
{
"path": "docs/scss/fable-font.scss",
"chars": 1450,
"preview": "@font-face {\n font-family: 'fable-font';\n src: url('/static/fonts/fable-font/fable-font.eot?qh7nog');\n src: url"
},
{
"path": "docs/static/img/commands.wsd",
"chars": 457,
"preview": "@startuml\nautonumber \"<b>(#)\"\n' © Sebastian Porto 2016, \n' licensed under a Creative Commons Attribution-NonCommercial-S"
},
{
"path": "docs/static/img/flow.wsd",
"chars": 453,
"preview": "@startuml\n' © Sebastian Porto 2016, \n' licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 Intern"
},
{
"path": "docs/static/img/parent-child.wsd",
"chars": 1045,
"preview": "@startuml \"parent-child\"\n' © Sebastian Porto 2016, \n' licensed under a Creative Commons Attribution-NonCommercial-ShareA"
},
{
"path": "docs/style.scss",
"chars": 3715,
"preview": "@import \"./../node_modules/bulma/sass/utilities/initial-variables\";\n\n// Color palette\n// https://lospec.com/palette-list"
},
{
"path": "global.json",
"chars": 77,
"preview": "{\n \"sdk\": {\n \"version\": \"8.0.401\",\n \"rollForward\": \"latestMinor\"\n }\n}"
},
{
"path": "nacara.config.json",
"chars": 999,
"preview": "{\n \"siteMetadata\": {\n \"title\": \"Elmish\",\n \"url\": \"https://elmish.github.io\",\n \"baseUrl\": \"/elmis"
},
{
"path": "netstandard/Elmish.fsproj",
"chars": 673,
"preview": "<Project Sdk=\"Microsoft.NET.Sdk\">\n <PropertyGroup>\n <Description>Elmish core for .NET apps</Description>\n <Target"
},
{
"path": "package.json",
"chars": 876,
"preview": "{\n \"name\": \"hmr\",\n \"private\": true,\n \"type\": \"module\",\n \"engines\": {\n \"node\": \"^12.20.0 || ^14.13.1 |"
},
{
"path": "src/Fable.Elmish.fsproj",
"chars": 814,
"preview": "<Project Sdk=\"Microsoft.NET.Sdk\">\n <PropertyGroup>\n <TargetFramework>netstandard2.0</TargetFramework>\n <GenerateD"
},
{
"path": "src/cmd.fs",
"chars": 13746,
"preview": "(**\nCmd\n---------\nCore abstractions for dispatching messages in Elmish.\n\n*)\n\nnamespace Elmish\n\nopen System\n\n/// Dispatch"
},
{
"path": "src/cmd.obsolete.fs",
"chars": 2201,
"preview": "namespace Elmish\n\nopen System\n\n#nowarn \"44\"\n[<AutoOpen>]\nmodule Obsolete =\n /// Cmd module for creating and manipulat"
},
{
"path": "src/prelude.fs",
"chars": 1047,
"preview": "namespace Elmish\n\n(**\nLog\n---------\nBasic cross-platform logging API.\n\n*)\nmodule internal Log =\n\n#if FABLE_COMPILER\n "
},
{
"path": "src/program.fs",
"chars": 8577,
"preview": "(**\nProgram\n---------\nCore abstractions for creating and running the dispatch loop.\n\n*)\n\nnamespace Elmish\n\n\n/// Program "
},
{
"path": "src/ring.fs",
"chars": 1488,
"preview": "namespace Elmish\nopen System\n\n[<Struct>]\ntype internal RingState<'item> =\n | Writable of wx:'item array * ix:int\n "
},
{
"path": "src/sub.fs",
"chars": 3236,
"preview": "namespace Elmish\n\nopen System\n\n/// SubId - Subscription ID, alias for string list\ntype SubId = string list\n\n/// Subscrib"
},
{
"path": "tests/Attributes.fs",
"chars": 101,
"preview": "namespace Elmish.Tests\n\nopen NUnit.Framework\n\n[<assembly: Parallelizable(ParallelScope.All)>]\n\ndo ()"
},
{
"path": "tests/CmdTests.fs",
"chars": 17303,
"preview": "module Elmish.CmdTests\n\nopen NUnit.Framework\nopen Swensen.Unquote\nopen Elmish\n\ntype Msg =\n | OnError of exn\n | OnS"
},
{
"path": "tests/Elmish.Tests.fsproj",
"chars": 1158,
"preview": "<Project Sdk=\"Microsoft.NET.Sdk\">\n <PropertyGroup>\n <TargetFramework>net8.0</TargetFramework>\n </PropertyGroup>\n "
},
{
"path": "tests/ProgramTest.fs",
"chars": 1543,
"preview": "module Elmish.ProgramTests\n\nopen NUnit.Framework\nopen FsCheck.NUnit\nopen Swensen.Unquote\nopen Elmish\n\ntype Model = int\nt"
},
{
"path": "tests/RingTest.fs",
"chars": 1109,
"preview": "module Elmish.RingTests\n\nopen FsCheck\nopen FsCheck.NUnit\nopen System.Collections.Generic\nopen Swensen.Unquote\n\ntype Op ="
},
{
"path": "tests/SubTests.fs",
"chars": 3771,
"preview": "module Elmish.SubTests\n\nopen Elmish\nopen NUnit.Framework\nopen Swensen.Unquote\nopen System\n\n// TIL: Each use of a let fn"
},
{
"path": "websharper/WebSharper.Elmish.fsproj",
"chars": 829,
"preview": "<Project Sdk=\"Microsoft.NET.Sdk\">\n <PropertyGroup>\n <Description>Elmish core for WebSharper apps</Description>\n "
},
{
"path": "websharper/prelude.fs",
"chars": 458,
"preview": "namespace Elmish\n\nopen WebSharper\nopen WebSharper.JavaScript\n\nmodule internal Unchecked =\n [<Inline>]\n let default"
},
{
"path": "websharper/wsconfig.json",
"chars": 117,
"preview": "{\n \"$schema\": \"https://websharper.com/wsconfig.schema.json\",\n \"project\": \"proxy\",\n \"proxyTargetName\": \"Elmish\"\n}\n"
}
]
About this extraction
This page contains the full source code of the fable-elmish/elmish GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 50 files (133.1 KB), approximately 33.5k tokens. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.
Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.