Showing preview only (597K chars total). Download the full file or copy to clipboard to get everything.
Repository: seanhess/hyperbole
Branch: main
Commit: d1ea5d43346f
Files: 254
Total size: 539.1 KB
Directory structure:
gitextract_46835c3y/
├── .dockerignore
├── .github/
│ └── workflows/
│ ├── haskell.yaml
│ └── packcheck.yaml
├── .gitignore
├── .hlint.yaml
├── .packcheck.ignore
├── CHANGELOG.md
├── DOCTODO.md
├── Dockerfile
├── LICENSE
├── README.md
├── bin/
│ ├── dev
│ ├── docgen
│ └── release
├── cabal.project
├── client/
│ ├── declarations.d.ts
│ ├── dist/
│ │ ├── action.d.ts
│ │ ├── browser.d.ts
│ │ ├── events.d.ts
│ │ ├── http.d.ts
│ │ ├── hyperbole.js
│ │ ├── hyperview.d.ts
│ │ ├── index.d.ts
│ │ ├── lib.d.ts
│ │ ├── message.d.ts
│ │ ├── response.d.ts
│ │ └── sockets.d.ts
│ ├── package.json
│ ├── src/
│ │ ├── action.ts
│ │ ├── browser.ts
│ │ ├── events.ts
│ │ ├── http.ts
│ │ ├── hyperview.ts
│ │ ├── index.ts
│ │ ├── lib.ts
│ │ ├── message.ts
│ │ ├── response.ts
│ │ └── sockets.ts
│ ├── tsconfig.json
│ ├── util/
│ │ └── live-reload.js
│ └── webpack.config.js
├── demo/
│ ├── .dockerignore
│ ├── App/
│ │ ├── Cache.hs
│ │ ├── Config.hs
│ │ ├── Docs/
│ │ │ ├── Markdown.hs
│ │ │ ├── Page.hs
│ │ │ └── Snippet.hs
│ │ ├── Docs.hs
│ │ ├── Page/
│ │ │ ├── Application.hs
│ │ │ ├── CSS.hs
│ │ │ ├── Concurrency.hs
│ │ │ ├── Examples.hs
│ │ │ ├── Forms.hs
│ │ │ ├── HyperboleEffect.hs
│ │ │ ├── Hyperviews.hs
│ │ │ ├── Interactivity.hs
│ │ │ ├── Intro/
│ │ │ │ ├── Basics.hs
│ │ │ │ └── Intro.hs
│ │ │ ├── OAuth2.hs
│ │ │ ├── SideEffects.hs
│ │ │ ├── State.hs
│ │ │ └── ViewFunctions.hs
│ │ ├── Route.hs
│ │ └── Style.hs
│ ├── App.hs
│ ├── Example/
│ │ ├── CSS/
│ │ │ ├── External.hs
│ │ │ ├── Loading.hs
│ │ │ ├── Tooltips.hs
│ │ │ └── Transitions.hs
│ │ ├── Chat.hs
│ │ ├── Colors.hs
│ │ ├── Concurrency/
│ │ │ ├── LazyLoading.hs
│ │ │ ├── Overlap.hs
│ │ │ ├── Polling.hs
│ │ │ ├── Progress.hs
│ │ │ └── Tasks.hs
│ │ ├── Contact.hs
│ │ ├── Contacts.hs
│ │ ├── Counter.hs
│ │ ├── Data/
│ │ │ └── ProgrammingLanguage.hs
│ │ ├── DataLists/
│ │ │ ├── Autocomplete.hs
│ │ │ ├── DataTable.hs
│ │ │ ├── Filter.hs
│ │ │ └── LoadMore.hs
│ │ ├── Docs/
│ │ │ ├── App.hs
│ │ │ ├── BasicPage.hs
│ │ │ ├── CSS.hs
│ │ │ ├── Client.hs
│ │ │ ├── Component.hs
│ │ │ ├── Encoding.hs
│ │ │ ├── Interactive.hs
│ │ │ ├── MultiPage.hs
│ │ │ ├── MultiView.hs
│ │ │ ├── Nested.hs
│ │ │ ├── Nesting.hs
│ │ │ ├── Page/
│ │ │ │ ├── Messages.hs
│ │ │ │ └── Users.hs
│ │ │ ├── Params.hs
│ │ │ ├── QueryMessage.hs
│ │ │ ├── Sessions.hs
│ │ │ ├── SideEffects.hs
│ │ │ ├── State.hs
│ │ │ ├── UniqueViewId.hs
│ │ │ └── ViewFunctions.hs
│ │ ├── Document.hs
│ │ ├── Effects/
│ │ │ ├── Debug.hs
│ │ │ ├── Todos.hs
│ │ │ └── Users.hs
│ │ ├── Errors.hs
│ │ ├── FormSimple.hs
│ │ ├── FormValidation.hs
│ │ ├── Interactivity/
│ │ │ ├── Events.hs
│ │ │ └── Inputs.hs
│ │ ├── Javascript.hs
│ │ ├── Push.hs
│ │ ├── Requests.hs
│ │ ├── Scrollbars.hs
│ │ ├── Simple.hs
│ │ ├── State/
│ │ │ ├── Effects.hs
│ │ │ ├── Query.hs
│ │ │ ├── Sessions.hs
│ │ │ ├── Stateless.hs
│ │ │ └── ViewState.hs
│ │ ├── Style/
│ │ │ └── Cyber.hs
│ │ ├── Style.hs
│ │ ├── Tags.hs
│ │ ├── Test.hs
│ │ ├── Todos/
│ │ │ ├── Todo.hs
│ │ │ └── TodoCSS.hs
│ │ ├── Trigger.hs
│ │ └── View/
│ │ ├── Icon.hs
│ │ ├── Inputs.hs
│ │ ├── Layout.hs
│ │ ├── Loader.hs
│ │ ├── Menu.hs
│ │ └── SortableTable.hs
│ ├── Main.hs
│ ├── README.md
│ ├── demo.cabal
│ ├── fourmolu.yaml
│ ├── hie.yaml
│ ├── package.yaml
│ └── static/
│ ├── custom.js
│ ├── cyber.css
│ ├── docs.js
│ ├── external.css
│ ├── prism.css
│ ├── prism.js
│ ├── test.js
│ └── todomvc.css
├── docs/
│ ├── Main.hs
│ ├── app-document.md
│ ├── app-effects.md
│ ├── app-live.md
│ ├── app-pages.md
│ ├── app-routes.md
│ ├── atomic.md
│ ├── comparison.md
│ ├── concurrency-overlap.md
│ ├── dev.md
│ ├── docgen.cabal
│ ├── effectful.md
│ ├── effects-custom.md
│ ├── effects-other.md
│ ├── forms-simple.md
│ ├── forms-validated.md
│ ├── hyperviews-intro.md
│ ├── hyperviews-multi.md
│ ├── hyperviews-nesting.md
│ ├── hyperviews-unique.md
│ ├── interactivity-events.md
│ ├── interactivity-events2.md
│ ├── interactivity-inputs.md
│ ├── interactivity-javascript.md
│ ├── interactivity-pushevent.md
│ ├── intro-downsides.md
│ ├── intro-links.md
│ ├── intro.md
│ ├── javascript_api.md
│ ├── multi-same.md
│ ├── nix.md
│ ├── outline.md
│ ├── package.yaml
│ ├── pages.md
│ ├── state-browser.md
│ ├── state-effects.md
│ ├── state-sessions.md
│ ├── state-stateless.md
│ ├── state-threading.md
│ ├── state-viewstate.md
│ ├── view-components.md
│ ├── view-functions-end.md
│ ├── view-functions-wrap.md
│ └── view-functions.md
├── flake.nix
├── fourmolu.yaml
├── hie.yaml
├── hyperbole.cabal
├── package.yaml
├── src/
│ └── Web/
│ ├── Hyperbole/
│ │ ├── Application.hs
│ │ ├── Data/
│ │ │ ├── Cookie.hs
│ │ │ ├── Encoded.hs
│ │ │ ├── JSON.hs
│ │ │ ├── Param.hs
│ │ │ ├── QueryData.hs
│ │ │ └── URI.hs
│ │ ├── Document.hs
│ │ ├── Effect/
│ │ │ ├── Client.hs
│ │ │ ├── GenRandom.hs
│ │ │ ├── Hyperbole.hs
│ │ │ ├── OAuth2.hs
│ │ │ ├── Query.hs
│ │ │ ├── Request.hs
│ │ │ ├── Response.hs
│ │ │ └── Session.hs
│ │ ├── HyperView/
│ │ │ ├── Event.hs
│ │ │ ├── Forms.hs
│ │ │ ├── Handled.hs
│ │ │ ├── Hyper.hs
│ │ │ ├── Input.hs
│ │ │ └── Types.hs
│ │ ├── HyperView.hs
│ │ ├── Page.hs
│ │ ├── Route.hs
│ │ ├── Server/
│ │ │ ├── Handler.hs
│ │ │ ├── Message.hs
│ │ │ ├── Options.hs
│ │ │ ├── Socket.hs
│ │ │ └── Wai.hs
│ │ ├── TypeList.hs
│ │ ├── Types/
│ │ │ ├── Client.hs
│ │ │ ├── Event.hs
│ │ │ ├── Request.hs
│ │ │ └── Response.hs
│ │ ├── View/
│ │ │ ├── CSS.hs
│ │ │ ├── Embed.hs
│ │ │ ├── Render.hs
│ │ │ ├── Tag.hs
│ │ │ ├── Types.hs
│ │ │ ├── ViewAction.hs
│ │ │ └── ViewId.hs
│ │ └── View.hs
│ └── Hyperbole.hs
└── test/
├── Spec.hs
└── Test/
├── EncodedSpec.hs
├── FormSpec.hs
├── ParamSpec.hs
├── QuerySpec.hs
├── RouteSpec.hs
├── SessionSpec.hs
├── URISpec.hs
├── ViewActionSpec.hs
├── ViewIdSpec.hs
└── ViewSpec.hs
================================================
FILE CONTENTS
================================================
================================================
FILE: .dockerignore
================================================
.git
.stack-work
client/node_modules
Dockerfile
dist-newstyle
================================================
FILE: .github/workflows/haskell.yaml
================================================
name: Haskell CI
on:
push:
branches: [ "main", "ci" ]
pull_request:
branches: [ "main" ]
permissions:
contents: read
jobs:
build-cache:
runs-on: ubuntu-latest
container:
image: haskell:9.8.2
steps:
- uses: actions/checkout@v4
- name: Cache Cabal
id: cache-cabal
uses: actions/cache@v4
with:
path: |
/github/home/.cache
/github/home/.config
/github/home/.local
key: ${{ runner.os }}-${{ hashFiles('**/cabal.project') }}-${{ hashFiles('**/*.cabal') }}
# restore-keys: |
# ${{ runner.os }}-
- name: Install dependencies
run: |
cabal update
- name: Build dependencies
run: |
cabal build --only-dependencies --enable-tests --enable-benchmarks
- name: Install skeletest-preprocessor
run: |
cabal install skeletest --installdir=$HOME/.local/bin --install-method=copy --overwrite-policy=always
- name: Check Cache
run: |
ls -ahl /github/home/
ls -ahl /github/home/.cache
ls -ahl /github/home/.config
ls -ahl /github/home/.local
build-982:
needs: build-cache
runs-on: ubuntu-latest
container:
image: haskell:9.8.2
steps:
- uses: actions/checkout@v4
- name: Cache Cabal Restore
id: cache-cabal-restore
uses: actions/cache@v4
with:
path: |
/github/home/.cache
/github/home/.config
/github/home/.local
key: ${{ runner.os }}-${{ hashFiles('**/cabal.project') }}-${{ hashFiles('**/*.cabal') }}
# restore-keys: |
# ${{ runner.os }}-build-${{ env.cache-name }}-
# ${{ runner.os }}-build-
# ${{ runner.os }}-
- name: Check Cache
run: |
ls -ahl /github/home/
ls -ahl /github/home/.cache
ls -ahl /github/home/.config
ls -ahl /github/home/.local
- name: Source skeletest-preprocessor
run: |
echo "$HOME/.local/bin" >> $GITHUB_PATH
- name: Build
run: cabal build --enable-tests --enable-benchmarks all
- name: Test
run: cabal test
# build-966:
# runs-on: ubuntu-latest
# container:
# image: haskell:9.6.6
# steps: *cabal-test
# - uses: actions/setup-haskell@v1
# with:
# ghc-version: '9.6'
# cabal-version: '3.2'
# - name: Cache
# uses: actions/cache@v3
# env:
# cache-name: cache-cabal
# with:
# path: ~/.cabal
# key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }}
# restore-keys: |
# ${{ runner.os }}-build-${{ env.cache-name }}-
# ${{ runner.os }}-build-
# ${{ runner.os }}-
================================================
FILE: .github/workflows/packcheck.yaml
================================================
# packcheck-0.7.1
# You can use any of the options supported by packcheck as environment
# variables here. See https://github.com/composewell/packcheck for all
# options and their explanation.
name: packcheck
#-----------------------------------------------------------------------------
# Events on which the build should be triggered
#-----------------------------------------------------------------------------
on:
push:
branches: [ "main", "ci" ]
pull_request:
#-----------------------------------------------------------------------------
# Build matrix
#-----------------------------------------------------------------------------
jobs:
build:
name: >-
${{ matrix.name }}
${{ matrix.command }}
${{ matrix.runner }}
${{ matrix.ghc_version }}
env:
# ------------------------------------------------------------------------
# Common options
# ------------------------------------------------------------------------
# GHC_OPTIONS: "-Werror"
CABAL_REINIT_CONFIG: y
LC_ALL: C.UTF-8
# ------------------------------------------------------------------------
# What to build
# ------------------------------------------------------------------------
# DISABLE_TEST: "y"
# DISABLE_BENCH: "y"
# DISABLE_DOCS: "y"
DISABLE_SDIST_BUILD: "y"
# DISABLE_SDIST_GIT_CHECK: "y"
# DISABLE_DIST_CHECKS: "y"
# ------------------------------------------------------------------------
# Selecting tool versions
# ------------------------------------------------------------------------
# For updating see: https://downloads.haskell.org/~ghcup/
GHCUP_VERSION: 0.1.40.0
GHCVER: ${{ matrix.ghc_version }}
GHCUP_GHC_OPTIONS: ${{ matrix.ghcup_ghc_options }}
# RESOLVER: ${{ matrix.stack_resolver }}
# ------------------------------------------------------------------------
# stack options
# ------------------------------------------------------------------------
# Note requiring a specific version of stack using STACKVER may fail due to
# github API limit while checking and upgrading/downgrading to the specific
# version.
# STACKVER: "1.6.5"
# STACK_UPGRADE: "y"
# STACK_YAML: "stack.yaml"
# ------------------------------------------------------------------------
# cabal options
# ------------------------------------------------------------------------
CABAL_CHECK_RELAX: y
CABAL_HACKAGE_MIRROR: "hackage.haskell.org:http://hackage.fpcomplete.com"
CABAL_PROJECT: ${{ matrix.cabal_project }}
# ------------------------------------------------------------------------
# Where to find the required tools
# ------------------------------------------------------------------------
PATH: /opt/ghc/bin:/sbin:/usr/sbin:/bin:/usr/bin
#TOOLS_DIR: /opt
# ------------------------------------------------------------------------
# Location of packcheck.sh (the shell script invoked to perform CI tests ).
# ------------------------------------------------------------------------
# You can either commit the packcheck.sh script at this path in your repo or
# you can use it by specifying the PACKCHECK_REPO_URL option below in which
# case it will be automatically copied from the packcheck repo to this path
# during CI tests. In any case it is finally invoked from this path.
PACKCHECK: "./packcheck.sh"
# If you have not committed packcheck.sh in your repo at PACKCHECK
# then it is automatically pulled from this URL.
PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
PACKCHECK_GITHUB_COMMIT: "2856fb3010c7d0549537852cfa8500b4f1b58537"
# ------------------------------------------------------------------------
# Final build variables
# ------------------------------------------------------------------------
PACKCHECK_COMMAND: ${{ matrix.command }} ${{ matrix.pack_options }}
# ubuntu seems to have better support than debian on CI systems
runs-on: ${{ matrix.runner }}
strategy:
fail-fast: false
matrix:
include:
- name: ci
ghc_version: 9.12.1
command: cabal
runner: ubuntu-latest
cabal_project: cabal.project
- name: ci
ghc_version: 9.10.1
command: cabal
runner: macos-latest
cabal_project: cabal.project
- name: ci-sdist
ghc_version: 9.10.1
command: cabal
runner: ubuntu-latest
pack_options: >-
DISABLE_SDIST_BUILD=n
- name: ci
command: cabal
runner: ubuntu-latest
ghc_version: 9.8.4
cabal_project: cabal.project
- name: ci
ghc_version: 9.6.6
command: cabal
runner: macos-latest
cabal_project: cabal.project
# - name: ci
# command: hlint
# runner: ubuntu-latest
# pack_options: >-
# HLINT_VERSION=3.6.1
# HLINT_OPTIONS="lint"
# HLINT_TARGETS="src test examples"
steps:
- uses: actions/checkout@v2
- uses: actions/cache@v3
name: Cache common directories
with:
path: |
~/.local
~/.cabal
~/.stack
~/.ghcup
key: ${{ matrix.command }}-${{ matrix.ghc_version }}-${{ matrix.runner }}
- name: Download packcheck
run: |
if test ! -e "$PACKCHECK"
then
if test -z "$PACKCHECK_GITHUB_COMMIT"
then
die "PACKCHECK_GITHUB_COMMIT is not specified."
fi
PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
curl --fail -sL -o "$PACKCHECK" $PACKCHECK_URL || exit 1
chmod +x $PACKCHECK
elif test ! -x "$PACKCHECK"
then
chmod +x $PACKCHECK
fi
- name: Run packcheck
run: |
bash -c "$PACKCHECK $PACKCHECK_COMMAND"
================================================
FILE: .gitignore
================================================
dist-newstyle
.DS_Store
tags
node_modules
# Auto-generated pre-commit config
.pre-commit-config.yaml
# Nix output dir
result
.direnv
client/dist/hyperbole.js.LICENSE.txt
Session.vim
.cabal.nix
/package.json
/package-lock.json
================================================
FILE: .hlint.yaml
================================================
- arguments:
- -XOverloadedRecordDot
- ignore: {name: "Use <$>"}
- ignore: {name: "Use newtype instead of data"}
# Hlint is not aware of OverloadedRecordDot
# See https://github.com/ndmitchell/hlint/issues/1383
- ignore: { name: Redundant id }
================================================
FILE: .packcheck.ignore
================================================
client/*.d.ts
client/src/
client/dist/*.d.ts
client/package-lock.json
client/webpack.config.js
client/package.json
client/tsconfig.json
docs/
demo/
.dockerignore
.github/workflows/haskell.yaml
.github/workflows/packcheck.yaml
.gitignore
.hlint.yaml
.packcheck.ignore
DOCTODO.md
Dockerfile
bin/dev
bin/docgen
bin/release
cabal.project
flake.lock
flake.nix
fourmolu.yaml
hie.yaml
package.yaml
================================================
FILE: CHANGELOG.md
================================================
# Revision history for hyperbole
## 0.6.0 -- 2026-01-15
Improvements:
* `ViewState` - built in threaded state, defaults to `()`, for folks who really miss Elm
* `Concurrency` Controls - `Drop` vs `Replace` for overlapping updates
* `pushUpdate` - server push an update to an arbitrary view
* Long-running actions can be interrupted / cancelled
* https://hyperbole.live now has inline documentation, code snippets, and live examples
Breaking Changes:
* A few functions now require state, such as `trigger` and `target`
## 0.5.0 -- 2025-09-26
Improvements
* `trigger` actions in other views
* Javascript FFI
* `window.Hyperbole` - API available from custom JS. `runAction` allows JS to trigger actions
* `pushEvent` - send events to JS from the server
* Documents
* Choose to configure with `View DocumentHead ()` instead of `ByteString` `->` `ByteString`
* `quickStartDocument`
* Live Reload
* Websocket - ping keepalive
* New form fields: `radio`, `select`
* `Web.Hyperbole.Effect.OAuth2` - Authentication
* `Web.Hyperbole.Effect.GenRandom` - Simple random effect used by OAuth2
* Error handling, custom errors
* Examples
* Many additions and improvements
* External Stylesheet TodoMVC
* OAuth2 example
Breaking Changes / Improvements
* `Web.Atomic.CSS` overhauled, and is now opt-in. Use new `@` and `~` operators to apply attributes and styles
* `Web.Hyperbole.Data.Param` - unified param encoding for Forms, ViewId, ViewAction, Sessions, Queries
* `Web.Hyperbole.Data.Encoding` - encoding for ViewId, ViewAction
* `Web.Hyperbole.Data.URI` - Standardize on `Network.URI`, extra utilities to manage paths
* `trigger`: required refactor of `Page` type alias to support type-checking: `Eff es (Page '[])` is now `Page es '[]`
## 0.4.3 -- 2025-01-31
* Bug fixes and improvements
## 0.4.2 -- 2025-01-21
* Cleaner HyperView class [(@cgeorgii)](https://github.com/cgeorgii)
* data family Action
* update
* Type-safe resolution of HyperViews
* Record-based Forms
* textarea [(@tusharad)](https://github.com/tusharad)
* High-level sessions and query params
* Events: onLoad, onClick onInput, onSubmit, onDblClick, onKeyDown, onKeyUp
* Major refactoring
* Nix build and CI [(@Skyfold)](https://github.com/Skyfold)
* New Examples Live: https://docs.hyperbole.live
* New Examples Added:
* TodoMVC
* Forms - Simple
* DataTable
* Search - Filters
* Search - Autocomplete
## 0.3.6 -- 2024-05-21
* First version. Released on an unsuspecting world.
================================================
FILE: DOCTODO.md
================================================
Documentation Outline
======================
================================================
FILE: Dockerfile
================================================
FROM haskell:9.8.2 AS base
WORKDIR /opt/build
RUN cabal update
RUN cabal install bytestring containers casing effectful text time string-interpolate file-embed http-api-data http-types wai warp wai-websockets network cookie string-conversions hpack websockets
FROM haskell:9.8.2 AS dependencies
WORKDIR /opt/build
COPY --from=base /root/.cache /root/.cache
COPY --from=base /root/.local /root/.local
COPY --from=base /root/.config /root/.config
# RUN apt-get update && apt-get install -y libpcre3 libpcre3-dev libcurl4-openssl-dev cron vim rsyslog
ADD ./package.yaml .
# ADD ./cabal.project .
# ADD ./docs/docgen.cabal .
# ADD ./demo/demo.cabal .
RUN hpack
RUN cabal update
RUN cabal build --only-dependencies
FROM haskell:9.8.2 AS build
WORKDIR /opt/build
COPY --from=dependencies /root/.cache /root/.cache
COPY --from=dependencies /root/.local /root/.local
COPY --from=dependencies /root/.config /root/.config
ADD ./package.yaml .
ADD ./cabal.project .
ADD ./client ./client
ADD ./test ./test
ADD ./src ./src
ADD ./demo ./demo
ADD ./docs ./docs
ADD *.md .
ADD LICENSE .
RUN hpack
RUN hpack demo
RUN hpack docs
RUN cabal build demo
RUN mkdir bin
RUN cd demo && export EXEC=$(cabal list-bin demo | tail -n1); cp "$EXEC" /opt/build/bin/demo
FROM ubuntu:24.04 AS app
WORKDIR /opt/app
RUN apt-get update
RUN apt-get install -y --no-install-recommends ca-certificates
RUN update-ca-certificates && rm -rf /var/lib/apt/lists/*
COPY --from=build /opt/build/bin/demo ./bin/demo
ADD ./client ./client
ADD ./demo/static ./demo/static
# ENV DYNAMO_LOCAL=False
ENTRYPOINT ["/opt/app/bin/demo"]
================================================
FILE: LICENSE
================================================
Copyright (c) 2023, Sean Hess
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Sean Hess nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
================================================
FILE: README.md
================================================
[](https://hackage.haskell.org/package/hyperbole)
Create interactive HTML applications with type-safe serverside Haskell. Inspired by HTMX, Elm, and Phoenix LiveView.
[▶️ Simple Example](https://hyperbole.live/simple)
```haskell
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Main where
import Data.Text (Text)
import Web.Atomic.CSS
import Web.Hyperbole
main :: IO ()
main = do
run 3000 $ do
liveApp quickStartDocument (runPage page)
page :: (Hyperbole :> es) => Page es '[Message]
page = do
pure $ do
hyper Message1 $ messageView "Hello"
hyper Message2 $ messageView "World!"
data Message = Message1 | Message2
deriving (Generic, ViewId)
instance HyperView Message es where
data Action Message
= Louder Text
deriving (Generic, ViewAction)
update (Louder msg) = do
let new = msg <> "!"
pure $ messageView new
messageView :: Text -> View Message ()
messageView msg = do
button (Louder msg) ~ border 1 $ text msg
```
Documentation
-------------
Visit [hyperbole.live](https://hyperbole.live) for documentation and live examples. Also see the [Hackage Documentation](https://hackage.haskell.org/package/hyperbole/docs/Web-Hyperbole.html)
<a href="https://hyperbole.live">
<img alt="Hyperbole Documentation" src="https://github.com/seanhess/hyperbole/raw/main/demo/static/demo-screenshot.jpg"/>
</a>
<!-- out of date!
* [HaskRead](https://github.com/tusharad/Reddit-Clone-Haskell) - A Reddit Clone
-->
Getting Started with Cabal
--------------------------
Create a new application:
$ mkdir myapp
$ cd myapp
$ cabal init
Add hyperbole and text as dependencies to the `.cabal` file:
```
build-depends:
base
, hyperbole
, text
default-language: GHC2021
```
Paste the above example into Main.hs, then run it:
$ cabal run
Visit http://localhost:3000 to view the application
Learn More
----------
<!-- <a href="https://hackage.haskell.org/package/hyperbole/docs/Web-Hyperbole.html" target="_blank" style="border-radius: 20px; Background-color:#f8f8f8; gap: 20px; display: flex; flex-direction: row; align-items: center"> -->
<!-- <img src="https://github.com/seanhess/hyperbole/raw/main/docs/hackage.svg"> -->
<!-- </a> -->
* [Local Development](./docs/dev.md)
* [Comparison with Similar Frameworks](./docs/comparison.md)
* [Using NIX](./docs/nix.md)
In the Wild
---------------------
<a href="https://nso.edu">
<img alt="National Solar Observatory" src="https://nso1.b-cdn.net/wp-content/uploads/2020/03/NSO-logo-orange-text.png" width="400"/>
</a>
The NSO uses Hyperbole to manage Level 2 Data pipelines for the [DKIST telescope](https://nso.edu/telescopes/dki-solar-telescope/). It uses complex user interfaces, workers, databases, and more. [The entire codebase is open source](https://github.com/DKISTDC/level2/).
Contributors
------------
* [Sean Hess](seanhess)
* [Kamil Figiela](https://github.com/kfigiela)
* [Christian Georgii](https://github.com/cgeorgii)
* [Pfalzgraf Martin](https://github.com/Skyfold)
* [Tushar Adhatrao](https://github.com/tusharad)
* [Benjamin Thomas](https://github.com/benjamin-thomas)
* [Adithya Obilisetty](https://github.com/adithyaov)
================================================
FILE: bin/dev
================================================
#!/bin/bash
package() {
hpack
hpack docs
hpack demo
}
watch() {
ghcid -c "cabal repl demo lib:hyperbole" -T App.run -W --reload=./client/dist/hyperbole.js
}
client() {
cd client
# npx webpack -w --mode=development
npx webpack -w
}
# run tests once (so we don't forget!)
cabal test
(trap 'kill 0' SIGINT; client & package && watch)
================================================
FILE: bin/docgen
================================================
#!/bin/bash
set -e
hpack demo
hpack docs
cabal run docs
cd /tmp/hyperbole
cabal haddock
================================================
FILE: bin/release
================================================
#!/bin/bash
# Make sure everything is working
hpack
cabal test
# Compile the JS client
cd client
npm install
npx webpack --mode=production
cd ..
# Compile the package
cabal sdist
# NEXT: Update branch release tags and push
================================================
FILE: cabal.project
================================================
tests: True
multi-repl: True
packages:
.
./demo/
./docs/
================================================
FILE: client/declarations.d.ts
================================================
declare module 'omdomdom/lib/omdomdom.es.js' {
export function create(node: any, ...args: any[]): any;
export function patch(template: any, vNode: any, rootNode?: any): void;
export function render(vNode: any, root: any): void;
}
================================================
FILE: client/dist/action.d.ts
================================================
import { Meta, ViewId, RequestId, EncodedAction, ViewState } from "./message";
export type ActionMessage = {
viewId: ViewId;
action: EncodedAction;
requestId: RequestId;
state?: ViewState;
meta: Meta[];
form: URLSearchParams | undefined;
};
export declare function actionMessage(id: ViewId, action: EncodedAction, state: ViewState | undefined, reqId: RequestId, form?: FormData): ActionMessage;
export declare function toSearch(form?: FormData): URLSearchParams | undefined;
export declare function renderActionMessage(msg: ActionMessage): string;
export declare function renderForm(form: URLSearchParams | undefined): string;
export type Request = {
requestId: RequestId;
isCancelled: boolean;
};
export declare function newRequest(): Request;
export declare function encodedParam(action: string, param: string): string;
================================================
FILE: client/dist/browser.d.ts
================================================
export declare function setQuery(query: string): void;
================================================
FILE: client/dist/events.d.ts
================================================
import { HyperView } from './hyperview';
export type UrlFragment = string;
export declare function listenKeydown(cb: (target: HyperView, action: string) => void): void;
export declare function listenKeyup(cb: (target: HyperView, action: string) => void): void;
export declare function listenKeyEvent(event: "keyup" | "keydown", cb: (target: HyperView, action: string) => void): void;
export declare function listenBubblingEvent(event: string, cb: (_target: HyperView, action: string) => void): void;
export declare function listenClick(cb: (target: HyperView, action: string) => void): void;
export declare function listenDblClick(cb: (target: HyperView, action: string) => void): void;
export declare function listenTopLevel(cb: (target: HyperView, action: string) => void): void;
export declare function listenLoad(node: HTMLElement): void;
export declare function listenMouseEnter(node: HTMLElement): void;
export declare function listenMouseLeave(node: HTMLElement): void;
export declare function listenChange(cb: (target: HyperView, action: string) => void): void;
export declare function listenInput(startedTyping: (target: HyperView) => void, cb: (target: HyperView, action: string) => void): void;
export declare function listenFormSubmit(cb: (target: HyperView, action: string, form: FormData) => void): void;
================================================
FILE: client/dist/http.d.ts
================================================
================================================
FILE: client/dist/hyperbole.js
================================================
/*! For license information please see hyperbole.js.LICENSE.txt */
(()=>{var e={296:e=>{function t(e,t=100,n={}){if("function"!=typeof e)throw new TypeError(`Expected the first parameter to be a function, got \`${typeof e}\`.`);if(t<0)throw new RangeError("`wait` must not be negative.");const{immediate:o}="boolean"==typeof n?{immediate:n}:n;let r,i,a,s,c;function u(){const t=r,n=i;return r=void 0,i=void 0,c=e.apply(t,n),c}function l(){const e=Date.now()-s;e<t&&e>=0?a=setTimeout(l,t-e):(a=void 0,o||(c=u()))}const d=function(...e){if(r&&this!==r&&Object.getPrototypeOf(this)===Object.getPrototypeOf(r))throw new Error("Debounced method called with different contexts of the same prototype.");r=this,i=e,s=Date.now();const n=o&&!a;return a||(a=setTimeout(l,t)),n&&(c=u()),c};return Object.defineProperty(d,"isPending",{get:()=>void 0!==a}),d.clear=()=>{a&&(clearTimeout(a),a=void 0)},d.flush=()=>{a&&d.trigger()},d.trigger=()=>{c=u(),d.clear()},d}e.exports.debounce=t,e.exports=t},147:e=>{"use strict";e.exports=JSON.parse('{"name":"web-ui","version":"0.6.0","description":"Development -----------","main":"index.js","directories":{"client":"client"},"scripts":{"build":"npx webpack"},"author":"","license":"ISC","devDependencies":{"ts-loader":"^9.4.1","typescript":"^4.8.3","uglify":"^0.1.5","webpack":"^5.88.2","webpack-cli":"^4.10.0"},"dependencies":{"omdomdom":"^0.3.2","debounce":"^2.2.0"}}')}},t={};function n(o){var r=t[o];if(void 0!==r)return r.exports;var i=t[o]={exports:{}};return e[o](i,i.exports,n),i.exports}(()=>{"use strict";var e=function(e,t){return Object.prototype.hasOwnProperty.call(e,t)},t=function(e,t){var n=e.length,o=-1;if(n)for(;++o<n&&!1!==t(e[o],o););},o=function(e,t,n){return e.node.insertBefore(t.node,n)};function r(e,t){return function(e){if(Array.isArray(e))return e}(e)||function(e,t){var n=null==e?null:"undefined"!=typeof Symbol&&e[Symbol.iterator]||e["@@iterator"];if(null!=n){var o,r,i,a,s=[],c=!0,u=!1;try{if(i=(n=n.call(e)).next,0===t){if(Object(n)!==n)return;c=!1}else for(;!(c=(o=i.call(n)).done)&&(s.push(o.value),s.length!==t);c=!0);}catch(e){u=!0,r=e}finally{try{if(!c&&null!=n.return&&(a=n.return(),Object(a)!==a))return}finally{if(u)throw r}}return s}}(e,t)||function(e,t){if(e){if("string"==typeof e)return i(e,t);var n=Object.prototype.toString.call(e).slice(8,-1);return"Object"===n&&e.constructor&&(n=e.constructor.name),"Map"===n||"Set"===n?Array.from(e):"Arguments"===n||/^(?:Ui|I)nt(?:8|16|32)(?:Clamped)?Array$/.test(n)?i(e,t):void 0}}(e,t)||function(){throw new TypeError("Invalid attempt to destructure non-iterable instance.\nIn order to be iterable, non-array objects must have a [Symbol.iterator]() method.")}()}function i(e,t){(null==t||t>e.length)&&(t=e.length);for(var n=0,o=new Array(t);n<t;n++)o[n]=e[n];return o}var a="string",s="number",c="boolean",u={},l=function(e,t,n){return{attrName:e,propName:t,type:n}};t([["style","cssText"],["class","className"]],(function(e){var t=r(e,2),n=t[0],o=t[1];u[n]=l(n,o||n,a)})),t(["autofocus","draggable","hidden","checked","multiple","muted","selected"],(function(e){u[e]=l(e,e,c)})),t([["tabindex","tabIndex"]],(function(e){var t=r(e,2),n=t[0],o=t[1];u[n]=l(n,o,s)}));var d="xlink:",f="http://www.w3.org/1999/xlink",v="xml:",m="http://www.w3.org/XML/1998/namespace",p=function(e,t,n,o){switch(t){case a:n===u.style.propName?e.style[n]=null===o?"":o:e[n]=null===o?"":o;break;case s:if(null===o){var r=n.toLowerCase();e.removeAttribute(r)}else if("0"===o)e[n]=0;else if("-1"===o)e[n]=-1;else{var i=parseInt(o,10);isNaN(i)||(e[n]=i)}break;case c:["","true"].indexOf(o)<0?e[n]=!1:e[n]=!0}},h=function n(r,i,s){if(r&&i){s=s||i.node.parentNode;var c=r.content&&r.content!==i.content;if(r.type!==i.type||c)return s.replaceChild(r.node,i.node),function(e,t){for(var n in e)t[n]=e[n]}(r,i);(function(n,o){var r=[],i={};for(var s in o.attributes){var c=o.attributes[s],l=n.attributes[s];c!==l&&void 0===l&&r.push(s)}for(var h in n.attributes){var y=o.attributes[h],g=n.attributes[h];y!==g&&void 0!==g&&(i[h]=g)}!function(n,o){t(o,(function(t){if(e(u,t)){var o=u[t];p(n.node,o.type,o.propName,null)}else t in n.node&&p(n.node,a,t,null),n.node.removeAttribute(t);delete n.attributes[t]}))}(o,r),function(t,n){for(var o in n){var r=n[o];if(t.attributes[o]=r,e(u,o)){var i=u[o];p(t.node,i.type,i.propName,r)}else o.startsWith(d)?t.node.setAttributeNS(f,o,r):o.startsWith(v)?t.node.setAttributeNS(m,o,r):(o in t.node&&p(t.node,a,o,r),t.node.setAttribute(o,r||""))}}(o,i)})(r,i),function(n,r,i){var a=n.children.length,s=r.children.length;if(a||s){var c=function(n){var o={};for(var r in t(n,(function(t){var n=t.attributes["data-key"];(function(t,n){return!(!n||e(t,n)&&(console.warn("[OmDomDom]: Children with duplicate keys detected. Children with duplicate keys will be skipped, resulting in dropped node references. Keys must be unique and non-indexed."),1))})(o,n)&&(o[n]=t)})),o)return o}(r.children),u=Array(a);t(n.children,void 0!==c?function(e,t){var n=r.node.childNodes,a=e.attributes["data-key"];if(Object.prototype.hasOwnProperty.call(c,a)){var s=c[a];Array.prototype.indexOf.call(n,s.node)!==t&&o(r,s,n[t]),u[t]=s,delete c[a],i(e,u[t])}else o(r,e,n[t]),u[t]=e}:function(e,t){var n=r.children[t];void 0!==n?(i(e,n),u[t]=n):(r.node.appendChild(e.node),u[t]=e)}),r.children=u;var l=r.node.childNodes.length,d=l-a;if(d>0)for(;d>0;)r.node.removeChild(r.node.childNodes[l-1]),l--,d--}}(r,i,n)}},y=function n(o){var r,i=arguments.length>1&&void 0!==arguments[1]&&arguments[1];"string"==typeof o&&(r=o.trim().replace(/\s+</g,"<").replace(/>\s+/g,">"),o=(new DOMParser).parseFromString(r,"text/html").body);var a="BODY"===o.tagName,s=o.childNodes,c=s?s.length:0;if(a){if(c>1)throw new Error("[OmDomDom]: Your element should not have more than one root node.");if(0===c)throw new Error("[OmDomDom]: Your element should have at least one root node.");return n(s[0])}var l=3===o.nodeType?"text":8===o.nodeType?"comment":o.tagName.toLowerCase(),d=i||"svg"===l,f=1===o.nodeType?function(t){var n=function(t){return Array.prototype.reduce.call(t.attributes,(function(t,n){return e(u,n.name)||(t[n.name]=n.value),t}),{})}(t);return function(e,t){for(var n in u){var o=u[n].propName,r=e.getAttribute(n);n===u.style.attrName?t[n]=e.style[o]:"string"==typeof r&&(t[n]=r)}}(t,n),n}(o):{},v=c>0?null:o.textContent,m=Array(c);return t(s,(function(e,t){m[t]=n(e,d)})),{type:l,attributes:f,children:m,content:v,node:o,isSVGContext:d}};function g(e,t){var n=[];for(var o of t){let t=e(o);if(!t)break;n.push(t)}return n}function w(e){return{cookies:e.filter((e=>"Cookie"==e.key)).map((e=>e.value)),error:b("Error",e),query:b("Query",e),pageTitle:b("PageTitle",e),events:I("Event",e).map(k),actions:I("Trigger",e).map(q)}}function E(e){return w(g(C,e.trim().split("\n")))}function b(e,t){return t.find((t=>t.key==e))?.value}function I(e,t){return t.filter((t=>t.key==e)).map((e=>e.value))}function C(e){let t=e.match(/^(\w+)\: (.*)$/);if(t)return{key:t[1],value:t[2]}}function k(e){let[t,n]=T(e);return{name:t,detail:JSON.parse(n)}}function q(e){let[t,n]=T(e);return[t,n]}function T(e){let t=e.indexOf("|");if(-1===t){let t=new Error("Bad Encoding, Expected Segment");throw t.message=e,t}return[e.slice(0,t),e.slice(t+1)]}function L(e){if(!e)return;const t=new URLSearchParams;return e.forEach(((e,n)=>{t.append(n,e)})),t}let S=0;function A(e,t){return e+" "+function(e){return""==e?"|":e.replace(/_/g,"\\_").replace(/\s+/g,"_")}(t)}const M=`${"https:"===window.location.protocol?"wss:":"ws:"}//${window.location.host}${window.location.pathname}`;class x extends Error{constructor(e,t){super(e+"\n"+t),this.name="ProtocolError"}}var R=n(296);const D=e=>void 0!==e?.runAction;function O(e){let t=new Event("hyp-content",{bubbles:!0});e.dispatchEvent(t)}function N(e,t){e.querySelectorAll("[id]").forEach((n=>{n.runAction=function(e){return t(n,e)},n.concurrency=n.dataset.concurrency||"Drop",n.cancelActiveRequest=function(){n.activeRequest&&!n.activeRequest?.isCancelled&&(n.activeRequest.isCancelled=!0)},O(e)}))}function H(e,t){document.addEventListener(e,(function(n){if(!(n.target instanceof HTMLElement))return void console.warn("listenKeyEvent received event with non HTMLElment as EventTarget: %o",n);let o=n.target,r="on"+e+n.key,i=o.dataset[r];if(!i)return;n.preventDefault();const a=Q(o);a?t(a,i):console.error("Missing target: ",o)}))}function V(e,t){document.addEventListener(e,(function(n){if(!(n.target instanceof HTMLElement))return void console.warn("listenBubblingEvent received an event with non HTMLElment as EventTarget: %o",n);let o=n.target.closest("[data-on"+e+"]");if(!o)return;n.preventDefault();let r=Q(o);if(!r)return void console.error("Missing target: ",o);const i=o.dataset["on"+e];void 0!==i?t(r,i):console.error("Missing action: ",o,e)}))}function j(e){e.querySelectorAll("[data-onload]").forEach((e=>{let t=parseInt(e.dataset.delay||"")||0,n=e.dataset.onload;setTimeout((()=>{let t=Q(e);if(e.dataset.onload!=n)return;const o=new CustomEvent("hyp-load",{bubbles:!0,detail:{target:t,onLoad:n}});e.dispatchEvent(o)}),t)}))}function P(e){e.querySelectorAll("[data-onmouseenter]").forEach((e=>{let t=e.dataset.onmouseenter,n=U(e);e.onmouseenter=()=>{const o=new CustomEvent("hyp-mouseenter",{bubbles:!0,detail:{target:n,onMouseEnter:t}});e.dispatchEvent(o)}}))}function B(e){e.querySelectorAll("[data-onmouseleave]").forEach((e=>{let t=e.dataset.onmouseleave,n=U(e);e.onmouseleave=()=>{const o=new CustomEvent("hyp-mouseleave",{bubbles:!0,detail:{target:n,onMouseLeave:t}});e.dispatchEvent(o)}}))}function Q(e){const t=U(e);if(D(t))return t;console.error("Non HyperView target: ",t)}function U(e){let t=function(e){let t=e.closest("[data-target]");return t?.dataset.target||e.closest("[id]")?.id}(e),n=t&&document.getElementById(t);if(n)return n;console.error("Cannot find target: ",t,e)}let W,$=n(147);console.log("Hyperbole "+$.version+"b");let F=new Set;async function _(e,t,n){if(e.activeRequest&&!e.activeRequest?.isCancelled&&"Drop"==e.concurrency)return void console.warn("Drop action overlapping with active request ("+e.activeRequest+")",t);e._timeout=window.setTimeout((()=>{e.classList.add("hyp-loading")}),100);let o=e.dataset.state,r={requestId:++S,isCancelled:!1},i=function(e,t,n,o,r){return{viewId:e,action:t,state:n,requestId:o,meta:[{key:"Cookie",value:decodeURI(document.cookie)},{key:"Query",value:window.location.search}],form:L(r)}}(e.id,t,o,r.requestId,n);e.activeRequest=r,z.sendAction(i)}function G(e){let t=e.targetViewId||e.viewId,n=document.getElementById(t);if(!D(n))return void console.error("Missing Update HyperView Target: ",t,e);if(n.activeRequest?.requestId&&e.requestId<n.activeRequest.requestId)return console.warn("Ignore Stale Action ("+e.requestId+") vs ("+n.activeRequest.requestId+"): "+e.action),n;if(n.activeRequest?.isCancelled)return console.warn("Cancelled request",n.activeRequest?.requestId),delete n.activeRequest,n;let o=function(e){const t=(new DOMParser).parseFromString(e,"text/html"),n=t.querySelector("style");return{content:t.querySelector("div"),css:n}}(e.body);if(!o.content)return console.error("Empty Response!",e.body),n;!function(e){if(!e)return;const t=e.sheet?.cssRules;if(t)for(let e=0;e<t.length;e++){const n=t.item(e);n&&0==F.has(n.cssText)&&W.sheet&&(W.sheet.insertRule(n.cssText),F.add(n.cssText))}}(o.css);const r=y(n);let i=y(o.content),a=i.attributes;if(!e.meta.error&&a.id!=n.id)return void console.error("Mismatched ViewId in update - ",a.id," target:",n.id);let s=a["data-state"];i.attributes=r.attributes,h(i,r);let c=document.getElementById(n.id);return c?(O(c),void 0===s||"()"==s?delete c.dataset.state:c.dataset.state=s,K(e.meta,c),J(e.meta.cookies??[]),j(c),P(c),B(c),function(e){let t=e.querySelector("[autofocus]");t?.focus&&t.focus(),e.querySelectorAll("input[value]").forEach((e=>{let t=e.getAttribute("value");null!==t&&(e.value=t)})),e.querySelectorAll("input[type=checkbox]").forEach((e=>{let t="True"==e.dataset.checked;e.checked=t}))}(c),N(c,_),n):(console.warn("Target Missing: ",n.id),n)}function J(e){e.forEach((e=>{console.log("SetCookie: ",e),document.cookie=e}))}function K(e,t){null!=e.query&&function(e){if(e!=function(){const e=window.location.search;return e.startsWith("?")?e.substring(1):e}()){""!=e&&(e="?"+e);let t=location.pathname+e;window.history.replaceState({},"",t)}}(e.query),null!=e.pageTitle&&(document.title=e.pageTitle),e.events?.forEach((e=>{Y(e,t)})),e.actions?.forEach((([e,t])=>{X(e,t)}))}function Y(e,t){setTimeout((()=>{let n=new CustomEvent(e.name,{bubbles:!0,detail:e.detail});(t||document).dispatchEvent(n)}),10)}function X(e,t){setTimeout((()=>{let n=window.Hyperbole?.hyperView(e);n&&_(n,t)}),10)}document.addEventListener("DOMContentLoaded",(function(){K(E(document.getElementById("hyp.metadata")?.innerText??""),null);const e=document.body.querySelector("style");var t;null!==e?W=e:(console.warn("rootStyles missing from page, creating..."),W=document.createElement("style"),W.type="text/css",document.body.appendChild(W)),t=async function(e,t){_(e,t)},document.addEventListener("hyp-load",(function(e){let n=e.detail.onLoad,o=e.detail.target;t(o,n)})),document.addEventListener("hyp-mouseenter",(function(e){let n=e.detail.onMouseEnter,o=e.detail.target;t(o,n)})),document.addEventListener("hyp-mouseleave",(function(e){let n=e.detail.onMouseLeave,o=e.detail.target;t(o,n)})),j(document.body),P(document.body),B(document.body),N(document.body,_),V("click",(async function(e,t){_(e,t)})),V("dblclick",(async function(e,t){_(e,t)})),H("keydown",(async function(e,t){_(e,t)})),H("keyup",(async function(e,t){_(e,t)})),document.addEventListener("submit",(function(e){if(!(e.target instanceof HTMLFormElement))return void console.warn("listenFormSubmit received an event with non HTMLElment as EventTarget: %o",e);let t=e.target;if(!t.dataset.onsubmit)return void console.error("Missing onSubmit: ",t);e.preventDefault();let n=Q(t);const o=new FormData(t);n?async function(e,t,n){_(e,t,n)}(n,t.dataset.onsubmit,o):console.error("Missing target: ",t)})),document.addEventListener("change",(function(e){if(!(e.target instanceof HTMLElement))return void console.warn("listenChange received an event with non HTMLElment as EventTarget: %o",e);let t=e.target.closest("[data-onchange]");if(!t)return;if(e.preventDefault(),null===t.value)return void console.error("Missing input value:",t);let n=Q(t);n?t.dataset.onchange?async function(e,t){_(e,t)}(n,A(t.dataset.onchange,t.value)):console.error("Missing onchange: ",t):console.error("Missing target: listenChange")})),document.addEventListener("input",(function(e){if(!(e.target instanceof HTMLElement))return void console.warn("listenInput received an event with non HTMLElment as EventTarget: %o",e);const t=e.target.closest("[data-oninput]");if(!t)return;let n=parseInt(t.dataset.delay||"")||250;n<250&&console.warn("Input delay < 250 can result in poor performance."),e.preventDefault();const o=Q(t);o?(function(e){"Replace"==e.concurrency&&e.cancelActiveRequest()}(o),t.debouncedCallback||(t.debouncedCallback=R((()=>{if(!t.dataset.oninput)return void console.error("Missing onInput: ",t);const e=A(t.dataset.oninput,t.value);!async function(e,t){_(e,t)}(o,e)}),n)),t.debouncedCallback()):console.error("Missing target: ",t)}))}));const z=new class{constructor(e=M){this.hasEverConnected=!1,this.isConnected=!1,this.reconnectDelay=0,this.queue=[],this.events=new EventTarget;const t=new WebSocket(e);this.socket=t}connect(e=M,t=!1){const n=t?new WebSocket(e):this.socket;function o(e){console.error("Connect Error",e)}function r(e){console.error("Socket Error",e)}this.socket=n,n.addEventListener("error",o),n.addEventListener("open",(e=>{console.log("Websocket Connected"),this.hasEverConnected&&document.dispatchEvent(new Event("hyp-socket-reconnect")),this.isConnected=!0,this.hasEverConnected=!0,this.reconnectDelay=1e3,n.removeEventListener("error",o),n.addEventListener("error",r),document.dispatchEvent(new Event("hyp-socket-connect")),this.runQueue()})),n.addEventListener("close",(t=>{console.log("CLOSE SOCKET"),this.isConnected&&document.dispatchEvent(new Event("hyp-socket-disconnect")),this.isConnected=!1,n.removeEventListener("error",r),this.hasEverConnected&&(console.log("Reconnecting in "+this.reconnectDelay/1e3+"s"),setTimeout((()=>this.connect(e,!0)),this.reconnectDelay)),n.removeEventListener("error",r)})),n.addEventListener("message",(e=>this.onMessage(e)))}async sendAction(e){if(this.isConnected){let t=function(e){let t=["|ACTION|","ViewId: "+e.viewId,"Action: "+e.action];return e.state&&t.push("State: "+e.state),t.push("RequestId: "+e.requestId),[t.join("\n"),(o=e.meta,o.map((e=>e.key+": "+e.value)).join("\n"))].join("\n")+((n=e.form)?"\n\n"+n:"");var n,o}(e);this.socket.send(t)}else this.queue.push(e)}runQueue(){let e=this.queue.pop();e&&(console.log("runQueue: ",e),this.sendAction(e),this.runQueue())}onMessage(e){let{command:t,metas:n,rest:o}=function(e){let t=e.split("\n"),n=t[0],o=g(C,t.slice(1));return{command:n,metas:o,rest:function(e,t){let n=0;for(;n<t.length&&""==t[n];)n++;return t.slice(n)}(0,t.slice(o.length+1))}}(e.data),r=parseInt(i("RequestId"),0);function i(t){let o=b(t,n);if(!o)throw new x("Missing Required Metadata: "+t,e.data);return o}function a(e){let t=i("ViewId"),o=i("Action");return{requestId:r,targetViewId:void 0,viewId:t,action:o,meta:w(n),body:e.join("\n")}}switch(t){case"|UPDATE|":return this.dispatchEvent(new CustomEvent("update",{detail:function(e){let t=a(e);return t.targetViewId=b("TargetViewId",n),t}(o)}));case"|RESPONSE|":return this.dispatchEvent(new CustomEvent("response",{detail:a(o)}));case"|REDIRECT|":return this.dispatchEvent(new CustomEvent("redirect",{detail:function(e){let t=e[0];return{requestId:r,meta:w(n),url:t}}(o)}));case"|TRIGGER|":return this.dispatchEvent(new CustomEvent("trigger",{detail:function(e){let{requestId:t,meta:n,viewId:o,action:r}=a(e),[s,c]=q(i("Trigger"));return{requestId:t,meta:n,viewId:o,action:r,targetViewId:s,targetAction:c}}(o)}));case"|EVENT|":return this.dispatchEvent(new CustomEvent("event",{detail:function(e){let{requestId:t,meta:n,viewId:o,action:r}=a(e);return{requestId:t,meta:n,viewId:o,action:r,event:k(i("Event"))}}(o)}));default:throw new x("Unknown Server Command: "+t,e.data)}}addEventListener(e,t){this.events.addEventListener(e,t)}dispatchEvent(e){this.events.dispatchEvent(e)}disconnect(){this.isConnected=!1,this.hasEverConnected=!1,this.socket.close()}};z.connect(),z.addEventListener("update",(e=>{G(e.detail)})),z.addEventListener("response",(e=>function(e){let t=G(e);t&&(delete t.activeRequest,clearTimeout(t._timeout),t.classList.remove("hyp-loading"))}(e.detail))),z.addEventListener("redirect",(e=>{return t=e.detail,console.log("REDIRECT",t),J(t.meta.cookies??[]),void(window.location.href=t.url);var t})),z.addEventListener("trigger",(e=>{var t;X((t=e.detail).targetViewId,t.targetAction)})),z.addEventListener("event",(e=>function(e){let t=document.getElementById(e.viewId);Y(e.event,t)}(e.detail))),window.Hyperbole={runAction:_,parseMetadata:E,action:function(e,...t){return t.reduce(((e,t)=>e+" "+JSON.stringify(t)),e)},hyperView:function(e){let t=document.getElementById(e);if(D(t))return t;console.error("Element id="+e+" was not a HyperView")},socket:z}})()})();
//# sourceMappingURL=hyperbole.js.map
================================================
FILE: client/dist/hyperview.d.ts
================================================
import { type Request } from "./action";
export interface HyperView extends HTMLElement {
runAction(action: string): Promise<void>;
activeRequest?: Request;
cancelActiveRequest(): void;
concurrency: ConcurrencyMode;
_timeout?: number;
}
export declare const isHyperView: (ele: any) => ele is HyperView;
export type ConcurrencyMode = string;
export declare function dispatchContent(node: HTMLElement): void;
export declare function enrichHyperViews(node: HTMLElement, runAction: (target: HyperView, action: string, form?: FormData) => Promise<void>): void;
================================================
FILE: client/dist/index.d.ts
================================================
import { SocketConnection } from './sockets';
import { ViewId, Metadata } from './message';
import { HyperView } from "./hyperview";
declare global {
interface Window {
Hyperbole?: HyperboleAPI;
}
interface DocumentEventMap {
"hyp-load": CustomEvent;
"hyp-mouseenter": CustomEvent;
"hyp-mouseleave": CustomEvent;
}
}
export interface HyperboleAPI {
runAction(target: HTMLElement, action: string, form?: FormData): Promise<void>;
action(con: string, ...params: any[]): string;
hyperView(viewId: ViewId): HyperView | undefined;
parseMetadata(input: string): Metadata;
socket: SocketConnection;
}
================================================
FILE: client/dist/lib.d.ts
================================================
export declare function takeWhileMap<T, A>(pred: (val: T) => A | undefined, lines: T[]): A[];
export declare function dropWhile<T, A>(pred: (val: T) => A | undefined, lines: T[]): T[];
================================================
FILE: client/dist/message.d.ts
================================================
export type Meta = {
key: string;
value: string;
};
export type ViewId = string;
export type RequestId = number;
export type EncodedAction = string;
export type ViewState = string;
export type RemoteEvent = {
name: string;
detail: unknown;
};
export declare function renderMetas(meta: Meta[]): string;
export type Metadata = {
cookies?: string[];
error?: string;
query?: string;
events?: RemoteEvent[];
actions?: [ViewId, EncodedAction][];
pageTitle?: string;
};
export declare function toMetadata(meta: Meta[]): Metadata;
export declare function parseMetadata(input: string): Metadata;
export declare function metaValue(key: string, metas: Meta[]): string | undefined;
export declare function metaValuesAll(key: string, metas: Meta[]): string[];
export type SplitMessage = {
command: string;
metas: Meta[];
rest: string[];
};
export declare function splitMessage(message: string): SplitMessage;
export declare function parseMeta(line: string): Meta | undefined;
export declare function parseRemoteEvent(input: string): RemoteEvent;
export declare function parseAction(input: string): [ViewId, string];
================================================
FILE: client/dist/response.d.ts
================================================
import { ViewId, Metadata } from './message';
export type Response = {
meta: Metadata;
body: ResponseBody;
};
export type ResponseBody = string;
export declare function parseResponse(res: ResponseBody): LiveUpdate;
export type LiveUpdate = {
content: HTMLElement | null;
css: HTMLStyleElement | null;
};
export declare class FetchError extends Error {
viewId: ViewId;
body: string;
constructor(viewId: ViewId, msg: string, body: string);
}
================================================
FILE: client/dist/sockets.d.ts
================================================
import { ActionMessage } from './action';
import { ResponseBody } from "./response";
import { ViewId, RequestId, EncodedAction, Metadata, RemoteEvent } from "./message";
interface SocketConnectionEventMap {
"update": CustomEvent<Update>;
"response": CustomEvent<Update>;
"redirect": CustomEvent<Redirect>;
"trigger": CustomEvent<Trigger>;
"event": CustomEvent<JSEvent>;
}
export declare class SocketConnection {
socket: WebSocket;
hasEverConnected: Boolean;
isConnected: Boolean;
reconnectDelay: number;
queue: ActionMessage[];
events: EventTarget;
constructor(addr?: string);
connect(addr?: string, createSocket?: boolean): void;
sendAction(action: ActionMessage): Promise<void>;
private runQueue;
private onMessage;
addEventListener<K extends keyof SocketConnectionEventMap>(e: K, cb: (ev: SocketConnectionEventMap[K]) => void): void;
dispatchEvent<K extends keyof SocketConnectionEventMap>(e: SocketConnectionEventMap[K]): void;
disconnect(): void;
}
export type Update = {
requestId: RequestId;
meta: Metadata;
viewId: ViewId;
targetViewId?: ViewId;
action: EncodedAction;
body: ResponseBody;
};
export type Redirect = {
requestId: RequestId;
meta: Metadata;
url: string;
};
export type Trigger = {
requestId: RequestId;
meta: Metadata;
viewId: ViewId;
action: EncodedAction;
targetViewId: ViewId;
targetAction: string;
};
export type JSEvent = {
requestId: RequestId;
meta: Metadata;
viewId: ViewId;
action: EncodedAction;
event: RemoteEvent;
};
export type MessageType = string;
export declare class ProtocolError extends Error {
constructor(description: string, body: string);
}
export {};
================================================
FILE: client/package.json
================================================
{
"name": "web-ui",
"version": "0.6.0",
"description": "Development -----------",
"main": "index.js",
"directories": {
"client": "client"
},
"scripts": {
"build": "npx webpack"
},
"author": "",
"license": "ISC",
"devDependencies": {
"ts-loader": "^9.4.1",
"typescript": "^4.8.3",
"uglify": "^0.1.5",
"webpack": "^5.88.2",
"webpack-cli": "^4.10.0"
},
"dependencies": {
"omdomdom": "^0.3.2",
"debounce": "^2.2.0"
}
}
================================================
FILE: client/src/action.ts
================================================
import { takeWhileMap } from "./lib"
import { Meta, ViewId, RequestId, EncodedAction, ViewState } from "./message"
import * as message from "./message"
export type ActionMessage = {
viewId: ViewId
action: EncodedAction
requestId: RequestId
state?: ViewState
meta: Meta[]
form: URLSearchParams | undefined
}
export function actionMessage(id: ViewId, action: EncodedAction, state: ViewState | undefined, reqId: RequestId, form?: FormData): ActionMessage {
let meta: Meta[] = [
{ key: "Cookie", value: decodeURI(document.cookie) },
{ key: "Query", value: window.location.search }
]
return { viewId: id, action, state, requestId: reqId, meta, form: toSearch(form) }
}
export function toSearch(form?: FormData): URLSearchParams | undefined {
if (!form) return undefined
const params = new URLSearchParams()
form.forEach((value, key) => {
params.append(key, value as string)
})
return params
}
export function renderActionMessage(msg: ActionMessage): string {
let header = [
"|ACTION|",
"ViewId: " + msg.viewId,
"Action: " + msg.action,
]
if (msg.state) {
header.push("State: " + msg.state)
}
header.push("RequestId: " + msg.requestId)
return [
header.join('\n'),
message.renderMetas(msg.meta),
].join('\n') + renderForm(msg.form)
}
export function renderForm(form: URLSearchParams | undefined): string {
if (!form) return ""
return "\n\n" + form
}
let globalRequestId: RequestId = 0
export type Request = {
requestId: RequestId
isCancelled: boolean
}
export function newRequest(): Request {
let requestId = ++globalRequestId
return { requestId, isCancelled: false }
}
// Sanitized Encoding ------------------------------------
export function encodedParam(action: string, param: string): string {
return action + ' ' + sanitizeParam(param)
}
function sanitizeParam(param: string): string {
if (param == "") {
return "|"
}
return param.replace(/_/g, "\\_").replace(/\s+/g, "_")
}
================================================
FILE: client/src/browser.ts
================================================
export function setQuery(query: string) {
if (query != currentQuery()) {
if (query != "") query = "?" + query
let url = location.pathname + query
// console.log("history.replaceState(", url, ")")
window.history.replaceState({}, "", url)
}
}
function currentQuery(): string {
const query = window.location.search;
return query.startsWith('?') ? query.substring(1) : query;
}
================================================
FILE: client/src/events.ts
================================================
import * as debounce from 'debounce'
import { encodedParam } from './action'
import { HyperView, isHyperView } from './hyperview'
export type UrlFragment = string
export function listenKeydown(cb: (target: HyperView, action: string) => void): void {
listenKeyEvent("keydown", cb)
}
export function listenKeyup(cb: (target: HyperView, action: string) => void): void {
listenKeyEvent("keyup", cb)
}
export function listenKeyEvent(event: "keyup" | "keydown", cb: (target: HyperView, action: string) => void): void {
document.addEventListener(event, function(e: KeyboardEvent) {
if (!(e.target instanceof HTMLElement)) {
console.warn("listenKeyEvent received event with non HTMLElment as EventTarget: %o", e)
return
}
let source = e.target
let datasetKey = "on" + event + e.key
let action = source.dataset[datasetKey]
if (!action) return
e.preventDefault()
const target = nearestHyperViewTarget(source)
if (!target) {
console.error("Missing target: ", source)
return
}
cb(target, action)
})
}
export function listenBubblingEvent(event: string, cb: (_target: HyperView, action: string) => void): void {
document.addEventListener(event, function(e) {
if (!(e.target instanceof HTMLElement)) {
console.warn("listenBubblingEvent received an event with non HTMLElment as EventTarget: %o", e)
return
}
let el = e.target
// clicks can fire on internal elements. Find the parent with a click handler
let source = el.closest<HTMLElement>("[data-on" + event + "]")
if (!source) return
e.preventDefault()
let target = nearestHyperViewTarget(source)
if (!target) {
console.error("Missing target: ", source)
return
}
const action = source.dataset["on" + event]
if (action === undefined) {
console.error("Missing action: ", source, event)
return
}
cb(target, action)
})
}
export function listenClick(cb: (target: HyperView, action: string) => void): void {
listenBubblingEvent("click", cb)
}
export function listenDblClick(cb: (target: HyperView, action: string) => void): void {
listenBubblingEvent("dblclick", cb)
}
export function listenTopLevel(cb: (target: HyperView, action: string) => void): void {
document.addEventListener("hyp-load", function(e: CustomEvent) {
let action = e.detail.onLoad
let target = e.detail.target
cb(target, action)
})
document.addEventListener("hyp-mouseenter", function(e: CustomEvent) {
let action = e.detail.onMouseEnter
let target = e.detail.target
cb(target, action)
})
document.addEventListener("hyp-mouseleave", function(e: CustomEvent) {
let action = e.detail.onMouseLeave
let target = e.detail.target
cb(target, action)
})
}
export function listenLoad(node: HTMLElement): void {
// it doesn't really matter WHO runs this except that it should have target
node.querySelectorAll<HTMLElement>("[data-onload]").forEach((load) => {
let delay = parseInt(load.dataset.delay || "") || 0
let onLoad = load.dataset.onload
// console.log("load start", load.dataset.onLoad)
// load no longer exists!
// we should clear the timeout or back out if the dom is replaced in the interem
setTimeout(() => {
let target = nearestHyperViewTarget(load)
// console.log("load go", load.dataset.onLoad)
if (load.dataset.onload != onLoad) {
// the onLoad no longer exists
return
}
const event = new CustomEvent("hyp-load", { bubbles: true, detail: { target, onLoad } })
load.dispatchEvent(event)
}, delay)
})
}
export function listenMouseEnter(node: HTMLElement): void {
node.querySelectorAll<HTMLElement>("[data-onmouseenter]").forEach((node) => {
let onMouseEnter = node.dataset.onmouseenter
let target = nearestAnyTarget(node)
node.onmouseenter = () => {
const event = new CustomEvent("hyp-mouseenter", { bubbles: true, detail: { target, onMouseEnter } })
node.dispatchEvent(event)
}
})
}
export function listenMouseLeave(node: HTMLElement): void {
node.querySelectorAll<HTMLElement>("[data-onmouseleave]").forEach((node) => {
let onMouseLeave = node.dataset.onmouseleave
let target = nearestAnyTarget(node)
node.onmouseleave = () => {
const event = new CustomEvent("hyp-mouseleave", { bubbles: true, detail: { target, onMouseLeave } })
node.dispatchEvent(event)
}
})
}
export function listenChange(cb: (target: HyperView, action: string) => void): void {
document.addEventListener("change", function(e) {
if (!(e.target instanceof HTMLElement)) {
console.warn("listenChange received an event with non HTMLElment as EventTarget: %o", e)
return
}
let el = e.target
let source = el.closest<HTMLInputElement>("[data-onchange]")
if (!source) return
e.preventDefault()
if (source.value === null) {
console.error("Missing input value:", source)
return
}
let target = nearestHyperViewTarget(source)
if (!target) {
console.error("Missing target: listenChange")
return
}
if (!source.dataset.onchange) {
console.error("Missing onchange: ", source)
return
}
let action = encodedParam(source.dataset.onchange, source.value)
cb(target, action)
})
}
interface LiveInputElement extends HTMLInputElement {
debouncedCallback?: Function;
}
export function listenInput(startedTyping: (target: HyperView) => void, cb: (target: HyperView, action: string) => void): void {
document.addEventListener("input", function(e) {
if (!(e.target instanceof HTMLElement)) {
console.warn("listenInput received an event with non HTMLElment as EventTarget: %o", e)
return
}
let el = e.target
const source = el.closest<LiveInputElement>("[data-oninput]")
if (!source) return
let delay = parseInt(source.dataset.delay || "") || 250
if (delay < 250) {
console.warn("Input delay < 250 can result in poor performance.")
}
e.preventDefault()
const target = nearestHyperViewTarget(source)
if (!target) {
console.error("Missing target: ", source)
return
}
// I want to CANCEL the active request as soon as we start typing
startedTyping(target)
if (!source.debouncedCallback) {
source.debouncedCallback = debounce(() => {
if (!source.dataset.oninput) {
console.error("Missing onInput: ", source)
return
}
const action = encodedParam(source.dataset.oninput, source.value)
cb(target, action)
}, delay)
}
source.debouncedCallback()
})
}
export function listenFormSubmit(cb: (target: HyperView, action: string, form: FormData) => void): void {
document.addEventListener("submit", function(e) {
if (!(e.target instanceof HTMLFormElement)) {
console.warn("listenFormSubmit received an event with non HTMLElment as EventTarget: %o", e)
return
}
let form = e.target
if (!form.dataset.onsubmit) {
console.error("Missing onSubmit: ", form)
return
}
e.preventDefault()
let target = nearestHyperViewTarget(form)
const formData = new FormData(form)
if (!target) {
console.error("Missing target: ", form)
return
}
cb(target, form.dataset.onsubmit, formData)
})
}
function nearestTargetId(node: HTMLElement): string | undefined {
let targetData = node.closest<HTMLElement>("[data-target]")
return targetData?.dataset.target || node.closest("[id]")?.id
}
function nearestHyperViewTarget(node: HTMLElement): HyperView | undefined {
const target = nearestAnyTarget(node)
if (!isHyperView(target)) {
console.error("Non HyperView target: ", target)
return
}
return target
}
function nearestAnyTarget(node: HTMLElement): HTMLElement | undefined {
let targetId = nearestTargetId(node)
let target = targetId && document.getElementById(targetId)
if (!target) {
console.error("Cannot find target: ", targetId, node)
return
}
return target
}
================================================
FILE: client/src/http.ts
================================================
// import { ActionMessage, ParsedResponse } from './action'
// import { Response, FetchError } from "./response"
// export async function sendActionHttp(msg: ActionMessage): Promise<Response> {
// // console.log("HTTP sendAction", msg.url.toString())
// let url = window.location.href
// let res = await fetch(url, {
// method: "POST",
// headers:
// {
// 'Accept': 'text/html',
// 'Content-Type': 'application/x-www-form-urlencoded',
// 'Hyp-RequestId': msg.requestId,
// 'Hyp-ViewId': msg.viewId,
// 'Hyp-Action': msg.action
// },
// body: msg.form,
// // we never want this to be redirected
// redirect: "manual"
// })
//
// let body = await res.text()
// let { metadata, rest } = parseMetadataHttp(body)
//
// if (!res.ok) {
// throw new FetchError(msg.viewId, body, body)
// }
//
// let response: Response = {
// meta: metadata,
// body: rest.join('\n')
// }
//
// return response
// }
// export function parseMetadataHttp(inp: string): ParsedResponse {
// let lines = inp.split("\n")
// // drop the <script> start line
// let { metadata, rest } = splitMetadata(lines.slice(1))
// // drop the </script> end line and 2x whitespace
// return { metadata, rest: rest.slice(2) }
// }
//
//
================================================
FILE: client/src/hyperview.ts
================================================
import { type Request } from "./action";
export interface HyperView extends HTMLElement {
runAction(action: string): Promise<void>;
activeRequest?: Request;
cancelActiveRequest(): void;
concurrency: ConcurrencyMode;
_timeout?: number;
}
export const isHyperView = (ele: any): ele is HyperView => {
return ele?.runAction !== undefined;
};
export type ConcurrencyMode = string;
export function dispatchContent(node: HTMLElement): void {
let event = new Event("hyp-content", { bubbles: true })
node.dispatchEvent(event)
}
export function enrichHyperViews(node: HTMLElement, runAction: (target: HyperView, action: string, form?: FormData) => Promise<void>): void {
// enrich all the hyperviews
node.querySelectorAll<HyperView>("[id]").forEach((element) => {
element.runAction = function(action: string) {
return runAction(element, action)
}
element.concurrency = element.dataset.concurrency || "Drop"
element.cancelActiveRequest = function() {
if (element.activeRequest && !element.activeRequest?.isCancelled) {
element.activeRequest.isCancelled = true
}
}
dispatchContent(node)
})
}
================================================
FILE: client/src/index.ts
================================================
import { patch, create } from "omdomdom/lib/omdomdom.es.js"
import { SocketConnection, Update, Redirect, Trigger, JSEvent } from './sockets'
import { listenChange, listenClick, listenDblClick, listenFormSubmit, listenLoad, listenTopLevel, listenInput, listenKeydown, listenKeyup, listenMouseEnter, listenMouseLeave } from './events'
import { actionMessage, newRequest } from './action'
import { ViewId, Metadata, parseMetadata, RemoteEvent, EncodedAction } from './message'
import { setQuery } from "./browser"
import { parseResponse, LiveUpdate } from './response'
import { dispatchContent, enrichHyperViews, HyperView, isHyperView } from "./hyperview"
let PACKAGE = require('../package.json');
// console.log("VERSION 2", INIT_PAGE, INIT_STATE)
console.log("Hyperbole " + PACKAGE.version + "b")
let rootStyles: HTMLStyleElement;
let addedRulesIndex = new Set();
// Run an action in a given HyperView
async function runAction(target: HyperView, action: string, form?: FormData) {
if (target.activeRequest && !target.activeRequest?.isCancelled) {
// Active Request!
if (target.concurrency == "Drop") {
console.warn("Drop action overlapping with active request (" + target.activeRequest + ")", action)
return
}
}
target._timeout = window.setTimeout(() => {
// add loading after 100ms, not right away
// if it runs shorter than that we probably don't want to show the user any loading feedback
target.classList.add("hyp-loading")
}, 100)
let state = target.dataset.state
let req = newRequest()
let msg = actionMessage(target.id, action, state, req.requestId, form)
// Set the requestId
target.activeRequest = req
sock.sendAction(msg)
}
function handleTrigger(trigger: Trigger) {
runTrigger(trigger.targetViewId, trigger.targetAction)
}
function handleEvent(ev: JSEvent) {
let target = document.getElementById(ev.viewId)
runRemoteEvent(ev.event, target)
}
// TODO: redirect concurrency
function handleRedirect(red: Redirect) {
console.log("REDIRECT", red)
// the other metdata doesn't apply, they are all specific to the page
applyCookies(red.meta.cookies ?? [])
window.location.href = red.url
}
// in-process update
function handleResponse(res: Update) {
// console.log("Handle Response", res)
let target = handleUpdate(res)
if (!target) return
// clean up the request
delete target.activeRequest
clearTimeout(target._timeout)
target.classList.remove("hyp-loading")
}
function handleUpdate(res: Update): HyperView | undefined {
// console.log("|UPDATE|", res)
let targetViewId = res.targetViewId || res.viewId
let target = document.getElementById(targetViewId)
if (!isHyperView(target)) {
console.error("Missing Update HyperView Target: ", targetViewId, res)
return
}
if (target.activeRequest?.requestId && res.requestId < target.activeRequest.requestId) {
// this should only happen on Replace, since other requests should be dropped
// but it's safe to assume we never want to apply an old requestId
console.warn("Ignore Stale Action (" + res.requestId + ") vs (" + target.activeRequest.requestId + "): " + res.action)
return target
}
else if (target.activeRequest?.isCancelled) {
console.warn("Cancelled request", target.activeRequest?.requestId)
delete target.activeRequest
return target
}
let update: LiveUpdate = parseResponse(res.body)
if (!update.content) {
console.error("Empty Response!", res.body)
return target
}
// First, update the stylesheet
addCSS(update.css)
// Patch the node
const old: VNode = create(target)
let next: VNode = create(update.content)
let atts = next.attributes
if (!res.meta.error && atts["id"] != target.id) {
console.error("Mismatched ViewId in update - ", atts["id"], " target:", target.id)
return
}
let state = atts["data-state"]
next.attributes = old.attributes
patch(next, old)
// Emit relevant events
let newTarget = document.getElementById(target.id)
if (!newTarget) {
console.warn("Target Missing: ", target.id)
return target
}
dispatchContent(newTarget)
// re-add state attribute
if (state === undefined || state == "()")
delete newTarget.dataset.state
else
newTarget.dataset.state = state
// execute the metadata, anything that doesn't interrupt the dom update
runMetadata(res.meta, newTarget)
applyCookies(res.meta.cookies ?? [])
// now way for these to bubble)
listenLoad(newTarget)
listenMouseEnter(newTarget)
listenMouseLeave(newTarget)
fixInputs(newTarget)
enrichHyperViews(newTarget, runAction)
return target
}
// catch (err) {
// console.error("Caught Error in HyperView (" + target.id + "):\n", err)
//
// // Hyperbole catches handler errors, and the server controls what to display to the user on an error
// // but if you manage to crash your parent server process somehow, the response may be empty
// target.innerHTML = err.body || "<div style='background:red;color:white;padding:10px'>Hyperbole Internal Error</div>"
// }
function applyCookies(cookies: string[]) {
cookies.forEach((cookie: string) => {
console.log("SetCookie: ", cookie)
document.cookie = cookie
})
}
function runMetadata(meta: Metadata, target: HTMLElement | null) {
if (meta.query != null) {
setQuery(meta.query)
}
if (meta.pageTitle != null) {
document.title = meta.pageTitle
}
meta.events?.forEach((remoteEvent) => {
runRemoteEvent(remoteEvent, target)
})
meta.actions?.forEach(([viewId, action]) => {
runTrigger(viewId, action)
})
}
function runRemoteEvent(remoteEvent: RemoteEvent, target: HTMLElement | null) {
setTimeout(() => {
let event = new CustomEvent(remoteEvent.name, { bubbles: true, detail: remoteEvent.detail })
let eventTarget = target || document
eventTarget.dispatchEvent(event)
}, 10)
}
function runTrigger(viewId: ViewId, action: EncodedAction) {
setTimeout(() => {
let view = window.Hyperbole?.hyperView(viewId)
if (view) {
runAction(view, action)
}
}, 10)
}
function fixInputs(target: HTMLElement) {
let focused = target.querySelector<HTMLInputElement>("[autofocus]")
if (focused?.focus) {
focused.focus()
}
target.querySelectorAll<HTMLInputElement>("input[value]").forEach((input) => {
let val = input.getAttribute("value")
if (val !== null) {
input.value = val
}
})
target.querySelectorAll<HTMLInputElement>("input[type=checkbox]").forEach((checkbox) => {
let checked = checkbox.dataset.checked == "True"
checkbox.checked = checked
})
}
function addCSS(src: HTMLStyleElement | null) {
if (!src) return;
const rules = src.sheet?.cssRules
if (!rules) return;
for (let i = 0; i < rules.length; i++) {
const rule = rules.item(i)
if (rule && addedRulesIndex.has(rule.cssText) == false && rootStyles.sheet) {
rootStyles.sheet.insertRule(rule.cssText);
addedRulesIndex.add(rule.cssText);
}
}
}
function init() {
// metadata attached to initial page loads need to be executed
let meta = parseMetadata(document.getElementById("hyp.metadata")?.innerText ?? "")
// runMetadataImmediate(meta)
runMetadata(meta, null)
const style = document.body.querySelector('style')
if (style !== null) {
rootStyles = style
} else {
console.warn("rootStyles missing from page, creating...")
rootStyles = document.createElement("style")
rootStyles.type = "text/css"
document.body.appendChild(rootStyles)
}
listenTopLevel(async function(target: HyperView, action: string) {
runAction(target, action)
})
listenLoad(document.body)
listenMouseEnter(document.body)
listenMouseLeave(document.body)
enrichHyperViews(document.body, runAction)
listenClick(async function(target: HyperView, action: string) {
// console.log("CLICK", target.id, action)
runAction(target, action)
})
listenDblClick(async function(target: HyperView, action: string) {
// console.log("DBLCLICK", target.id, action)
runAction(target, action)
})
listenKeydown(async function(target: HyperView, action: string) {
// console.log("KEYDOWN", target.id, action)
runAction(target, action)
})
listenKeyup(async function(target: HyperView, action: string) {
// console.log("KEYUP", target.id, action)
runAction(target, action)
})
listenFormSubmit(async function(target: HyperView, action: string, form: FormData) {
// console.log("FORM", target.id, action, form)
runAction(target, action, form)
})
listenChange(async function(target: HyperView, action: string) {
runAction(target, action)
})
function onStartedTyping(target: HyperView) {
if (target.concurrency == "Replace") {
target.cancelActiveRequest()
}
}
listenInput(onStartedTyping, async function(target: HyperView, action: string) {
runAction(target, action)
})
}
document.addEventListener("DOMContentLoaded", init)
const sock = new SocketConnection()
// Should we connect to the socket or not?
sock.connect()
sock.addEventListener("update", (ev: CustomEvent<Update>) => { handleUpdate(ev.detail) })
sock.addEventListener("response", (ev: CustomEvent<Update>) => handleResponse(ev.detail))
sock.addEventListener("redirect", (ev: CustomEvent<Redirect>) => handleRedirect(ev.detail))
sock.addEventListener("trigger", (ev: CustomEvent<Trigger>) => handleTrigger(ev.detail))
sock.addEventListener("event", (ev: CustomEvent<JSEvent>) => handleEvent(ev.detail))
type VNode = {
// One of three value types are used:
// - The tag name of the element
// - "text" if text node
// - "comment" if comment node
type: string
// An object whose key/value pairs are the attribute
// name and value, respectively
attributes: { [key: string]: string | undefined }
// Is set to `true` if a node is an `svg`, which tells
// Omdomdom to treat it, and its children, as such
isSVGContext: Boolean
// The content of a "text" or "comment" node
content: string
// An array of virtual node children
children: Array<VNode>
// The real DOM node
node: Node
}
declare global {
interface Window {
Hyperbole?: HyperboleAPI;
}
interface DocumentEventMap {
"hyp-load": CustomEvent;
"hyp-mouseenter": CustomEvent;
"hyp-mouseleave": CustomEvent;
}
}
export interface HyperboleAPI {
runAction(target: HTMLElement, action: string, form?: FormData): Promise<void>
action(con: string, ...params: any[]): string
hyperView(viewId: ViewId): HyperView | undefined
parseMetadata(input: string): Metadata
socket: SocketConnection
}
window.Hyperbole =
{
runAction: runAction,
parseMetadata: parseMetadata,
action: function(con, ...params: any[]) {
return params.reduce((str, param) => str + " " + JSON.stringify(param), con);
},
hyperView: function(viewId) {
let element = document.getElementById(viewId)
if (!isHyperView(element)) {
console.error("Element id=" + viewId + " was not a HyperView")
return
}
return element
},
socket: sock
}
================================================
FILE: client/src/lib.ts
================================================
export function takeWhileMap<T, A>(pred: (val: T) => A | undefined, lines: T[]): A[] {
var output = []
for (var line of lines) {
let a = pred(line)
if (a)
output.push(a)
else
break;
}
return output
}
export function dropWhile<T, A>(pred: (val: T) => A | undefined, lines: T[]): T[] {
let index = 0;
while (index < lines.length && pred(lines[index])) {
index++;
}
return lines.slice(index);
}
================================================
FILE: client/src/message.ts
================================================
import { takeWhileMap, dropWhile } from "./lib"
export type Meta = { key: string, value: string }
export type ViewId = string
export type RequestId = number
export type EncodedAction = string
export type ViewState = string
export type RemoteEvent = { name: string, detail: unknown }
export function renderMetas(meta: Meta[]): string {
return meta.map(m => m.key + ": " + m.value).join('\n')
}
export type Metadata = {
cookies?: string[]
// redirect?: string
error?: string
query?: string
events?: RemoteEvent[]
actions?: [ViewId, EncodedAction][],
pageTitle?: string
}
export function toMetadata(meta: Meta[]): Metadata {
return {
cookies: meta.filter(m => m.key == "Cookie").map(m => m.value),
// redirect: metaValue("Redirect", meta),
error: metaValue("Error", meta),
query: metaValue("Query", meta),
pageTitle: metaValue("PageTitle", meta),
events: metaValuesAll("Event", meta).map(parseRemoteEvent),
actions: metaValuesAll("Trigger", meta).map(parseAction),
}
}
// viewId: meta.find(m => m.key == "VIEW-ID")?.value,
export function parseMetadata(input: string): Metadata {
let metas = takeWhileMap(parseMeta, input.trim().split("\n"))
return toMetadata(metas)
}
export function metaValue(key: string, metas: Meta[]): string | undefined {
return metas.find(m => m.key == key)?.value
}
export function metaValuesAll(key: string, metas: Meta[]): string[] {
return metas.filter(m => m.key == key).map(m => m.value)
}
export type SplitMessage = {
command: string,
metas: Meta[],
rest: string[]
}
export function splitMessage(message: string): SplitMessage {
let lines = message.split("\n")
let command: string = lines[0]
let metas: Meta[] = takeWhileMap(parseMeta, lines.slice(1))
// console.log("Split Metadata", lines.length)
// console.log(" [0]", lines[0])
// console.log(" [1]", lines[1])
let rest = dropWhile(l => l == "", lines.slice(metas.length + 1))
return { command, metas, rest }
}
export function parseMeta(line: string): Meta | undefined {
let match = line.match(/^(\w+)\: (.*)$/)
if (match) {
return {
key: match[1],
value: match[2]
}
}
}
export function parseRemoteEvent(input: string): RemoteEvent {
let [name, data] = breakNextSegment(input)
return {
name,
detail: JSON.parse(data)
}
}
export function parseAction(input: string): [ViewId, string] {
let [viewId, action] = breakNextSegment(input)
return [viewId, action]
}
function breakNextSegment(input: string): [string, string] {
let ix = input.indexOf('|')
if (ix === -1) {
let err = new Error("Bad Encoding, Expected Segment")
err.message = input
throw err
}
return [input.slice(0, ix), input.slice(ix + 1)]
}
================================================
FILE: client/src/response.ts
================================================
import { ViewId, Metadata } from './message'
export type Response = {
meta: Metadata
body: ResponseBody
}
export type ResponseBody = string
export function parseResponse(res: ResponseBody): LiveUpdate {
const parser = new DOMParser()
const doc = parser.parseFromString(res, 'text/html')
const css = doc.querySelector<HTMLStyleElement>("style")
const content = doc.querySelector<HTMLElement>("div")
return {
content: content,
css: css
}
}
export type LiveUpdate = {
content: HTMLElement | null
css: HTMLStyleElement | null
}
export class FetchError extends Error {
viewId: ViewId
body: string
constructor(viewId: ViewId, msg: string, body: string) {
super(msg)
this.viewId = viewId
this.name = "Fetch Error"
this.body = body
}
}
================================================
FILE: client/src/sockets.ts
================================================
import { ActionMessage, renderActionMessage } from './action'
import { ResponseBody } from "./response"
import * as message from "./message"
import { ViewId, RequestId, EncodedAction, metaValue, Metadata, RemoteEvent } from "./message"
const protocol = window.location.protocol === 'https:' ? 'wss:' : 'ws:';
const defaultAddress = `${protocol}//${window.location.host}${window.location.pathname}`
interface SocketConnectionEventMap {
"update": CustomEvent<Update>;
"response": CustomEvent<Update>;
"redirect": CustomEvent<Redirect>;
"trigger": CustomEvent<Trigger>;
"event": CustomEvent<JSEvent>;
}
export class SocketConnection {
socket: WebSocket
hasEverConnected: Boolean = false
isConnected: Boolean = false
reconnectDelay: number = 0
queue: ActionMessage[] = []
events: EventTarget
constructor(addr = defaultAddress) {
this.events = new EventTarget()
const sock = new WebSocket(addr)
this.socket = sock
}
connect(addr = defaultAddress, createSocket = false) {
const sock = createSocket ? new WebSocket(addr) : this.socket
this.socket = sock
function onConnectError(ev: Event) {
console.error("Connect Error", ev)
}
function onSocketError(ev: Event) {
console.error("Socket Error", ev)
}
// initial connection errors
sock.addEventListener('error', onConnectError)
sock.addEventListener('open', (_event) => {
console.log("Websocket Connected")
if (this.hasEverConnected) {
document.dispatchEvent(new Event("hyp-socket-reconnect"))
}
this.isConnected = true
this.hasEverConnected = true
this.reconnectDelay = 1000
sock.removeEventListener('error', onConnectError)
sock.addEventListener('error', onSocketError)
document.dispatchEvent(new Event("hyp-socket-connect"))
this.runQueue()
})
sock.addEventListener('close', _ => {
console.log("CLOSE SOCKET")
if (this.isConnected) {
document.dispatchEvent(new Event("hyp-socket-disconnect"))
}
this.isConnected = false
sock.removeEventListener('error', onSocketError)
// attempt to reconnect in 1s
if (this.hasEverConnected) {
console.log("Reconnecting in " + (this.reconnectDelay / 1000) + "s")
setTimeout(() => this.connect(addr, true), this.reconnectDelay)
}
sock.removeEventListener('error', onSocketError)
})
sock.addEventListener('message', ev => this.onMessage(ev))
}
async sendAction(action: ActionMessage) {
if (this.isConnected) {
let msg = renderActionMessage(action)
this.socket.send(msg)
}
else {
this.queue.push(action)
}
}
private runQueue() {
// send all messages queued while disconnected
let next: ActionMessage | undefined = this.queue.pop()
if (next) {
console.log("runQueue: ", next)
this.sendAction(next)
this.runQueue()
}
}
// full responses will never be sent over!
private onMessage(event: MessageEvent) {
let { command, metas, rest } = message.splitMessage(event.data)
// console.log("MESSAGE", command, metas, rest)
let requestId = parseInt(requireMeta("RequestId"), 0)
function requireMeta(key: string): string {
let val = metaValue(key, metas)
if (!val) throw new ProtocolError("Missing Required Metadata: " + key, event.data)
return val
}
function parseResponse(rest: string[]): Update {
let viewId = requireMeta("ViewId")
let action = requireMeta("Action")
return {
requestId,
targetViewId: undefined,
viewId,
action,
meta: message.toMetadata(metas),
body: rest.join("\n"),
}
}
function parseUpdate(rest: string[]): Update {
let up = parseResponse(rest)
// add the TargetViewId
up.targetViewId = metaValue("TargetViewId", metas)
return up
}
function parseRedirect(rest: string[]): Redirect {
let url = rest[0]
return {
requestId,
meta: message.toMetadata(metas),
url
}
}
function parseTrigger(rest: string[]): Trigger {
let { requestId, meta, viewId, action } = parseResponse(rest)
let [targetViewId, targetAction] = message.parseAction(requireMeta("Trigger"))
return { requestId, meta, viewId, action, targetViewId, targetAction }
}
function parseEvent(rest: string[]): JSEvent {
let { requestId, meta, viewId, action } = parseResponse(rest)
let event = message.parseRemoteEvent(requireMeta("Event"))
return { requestId, meta, viewId, action, event }
}
switch (command) {
case "|UPDATE|":
return this.dispatchEvent(new CustomEvent("update", { detail: parseUpdate(rest) }))
case "|RESPONSE|":
return this.dispatchEvent(new CustomEvent("response", { detail: parseResponse(rest) }))
case "|REDIRECT|":
return this.dispatchEvent(new CustomEvent("redirect", { detail: parseRedirect(rest) }))
case "|TRIGGER|":
return this.dispatchEvent(new CustomEvent("trigger", { detail: parseTrigger(rest) }))
case "|EVENT|":
return this.dispatchEvent(new CustomEvent("event", { detail: parseEvent(rest) }))
default:
throw new ProtocolError("Unknown Server Command: " + command, event.data)
}
}
// so what if they send remote events in the page? trigger, redirect, page title, etc...
// we aren't connected yet on a page thing
// private async waitMessage(reqId: RequestId, id: ViewId): Promise<ParsedResponse> {
// return new Promise((resolve, reject) => {
// const onMessage = (event: MessageEvent) => {
// let data: string = event.data
// let lines = data.split("\n").slice(1) // drop the command line
//
// let parsed = splitMetadata(lines)
// let metadata: Metadata = parsed.metadata
//
// if (!metadata.requestId) {
// console.error("Missing RequestId!", metadata, event.data)
// return
// }
//
// if (metadata.requestId != reqId) {
// // skip, it's not us!
// return
// }
//
//
// // We have found our message. Remove the listener
// this.socket.removeEventListener('message', onMessage)
//
// // set the cookies. These happen automatically in http
// metadata.cookies.forEach((cookie: string) => {
// document.cookie = cookie
// })
//
// if (metadata.error) {
// reject(new FetchError(id, metadata.error, parsed.rest.join('\n')))
// return
// }
//
// resolve(parsed)
// }
//
// this.socket.addEventListener('message', onMessage)
// this.socket.addEventListener('error', reject)
// })
// }
addEventListener<K extends keyof SocketConnectionEventMap>(e: K, cb: (ev: SocketConnectionEventMap[K]) => void) {
this.events.addEventListener(e,
// @ts-ignore: HACK
cb
)
}
dispatchEvent<K extends keyof SocketConnectionEventMap>(e: SocketConnectionEventMap[K]) {
this.events.dispatchEvent(e)
}
disconnect() {
this.isConnected = false
this.hasEverConnected = false
this.socket.close()
}
}
export type Update = {
requestId: RequestId
meta: Metadata
viewId: ViewId
targetViewId?: ViewId
action: EncodedAction
body: ResponseBody
}
export type Redirect = {
requestId: RequestId
meta: Metadata
url: string
}
export type Trigger = {
requestId: RequestId
meta: Metadata
viewId: ViewId
action: EncodedAction
targetViewId: ViewId
targetAction: string
}
export type JSEvent = {
requestId: RequestId
meta: Metadata
viewId: ViewId
action: EncodedAction
event: RemoteEvent
}
export type MessageType = string
// PARSING MESSAGE ---------------------------------------
export class ProtocolError extends Error {
constructor(description: string, body: string) {
super(description + "\n" + body)
this.name = "ProtocolError"
}
}
================================================
FILE: client/tsconfig.json
================================================
{
"compilerOptions": {
"outDir": "./dist/",
"sourceMap": true,
"noImplicitAny": true,
"module": "ES2020",
"target": "ES2020",
"lib": ["ES2020","DOM"],
"allowJs": true,
"moduleResolution": "node",
"declaration": true,
"strict": true
// "skipLibCheck": true
/*"declarationMap": true*/
},
"include": [
"./src/**/*",
"./declarations.d.ts"
]
}
================================================
FILE: client/util/live-reload.js
================================================
// This isn't magic. If you want custom behavior, copy and modify this however you like.
//
// As with any custom js, add to a single page via the `script` combinator
// page = do
// pure $ do
// el "This is my page"
// script "custom.js"
//
// or to the entire app by adding a script tag to your document function. See Example.App.toDocument
//
// Consider conditionally adding it based on ENV
console.log("Live Reload enabled")
function showNotification(message) {
const notification = document.createElement('div');
notification.classList.add("live-reload")
notification.innerHTML = message;
jackIn(notification.style)
notification.addEventListener('click', function() {
notification.remove()
})
document.body.appendChild(notification);
}
document.addEventListener("hyp-socket-disconnect", () => {
showNotification("DISCONNECTED - will reload on reconnect")
})
document.addEventListener("hyp-socket-reconnect", () => {
setTimeout(() => {
location.reload()
}, 0)
})
// duplicate cyber style stuff here so the default live reload is fun
function jackIn(style) {
style.position = 'fixed';
style.bottom = '15px';
style.left = '15px';
style.right = '15px';
style.backgroundColor = 'rgba(160, 63, 56, 1.0)';
style.color = '#fff';
style.borderTop = 'solid #EC6458 4px';
style.padding = '15px';
style.zIndex = '1000';
style.clipPath = 'polygon(0 0, 100% 0, 100% calc(100% - 16px), calc(100% - 16px) 100%, 0 100%)';
}
================================================
FILE: client/webpack.config.js
================================================
const path = require('path');
// var PACKAGE = require('./package.json');
// var version = PACKAGE.version;
module.exports = {
entry: "./src/index.ts",
target: "web",
devtool: "source-map",
mode: "production",
module: {
rules: [
{
test: /\.tsx?$/,
use: 'ts-loader',
exclude: /node_modules/,
},
],
},
resolve: {
mainFields: ['browser', 'module', 'main'],
extensions: ['.tsx', '.ts', '.js'],
},
output: {
// filename: `hyperbole-${version}.js`,
filename: "hyperbole.js",
path: path.resolve(__dirname, 'dist'),
},
// devServer: {
// contentBase: path.join(__dirname, 'dist'),
// compress: true,
// port: 9000,
// },
}
================================================
FILE: demo/.dockerignore
================================================
dist-newstyle
.git
================================================
FILE: demo/App/Cache.hs
================================================
module App.Cache where
import Network.HTTP.Types (Header)
import Network.Wai.Middleware.Static
clientCache :: IO Options
clientCache = do
container <- initCaching PublicStaticCaching
-- container <- initCaching (CustomCaching customCache)
pure $ defaultOptions{cacheContainer = container}
-- for testing if caching is working
customCache :: FileMeta -> [Header]
customCache (FileMeta lm etag _file) = do
[("Cache-Control", "no-transform,public,max-age=30"), ("Last-Modified", lm), ("Etag", etag)]
================================================
FILE: demo/App/Config.hs
================================================
{-# LANGUAGE QuasiQuotes #-}
module App.Config where
import Data.Maybe (fromMaybe, isNothing)
import Effectful
import Effectful.Environment
import Effectful.Exception
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Client.TLS qualified as HTTPS
import Network.URI (parseURI)
import Web.Hyperbole.Data.URI
import Web.Hyperbole.Effect.OAuth2 (Config (..), Token (..))
import Web.Hyperbole.Effect.OAuth2 qualified as OAuth2
data App
data AppConfig = AppConfig
{ endpoint :: Endpoint App
, manager :: HTTP.Manager
, oauth :: OAuth2.Config
, devMode :: Bool
}
getAppConfigEnv :: (IOE :> es, Environment :> es) => Eff es AppConfig
getAppConfigEnv = do
endpoint <- lookupEnvEndpoint "APP_ENDPOINT" -- default to localhost
manager <- HTTPS.newTlsManager
pure $
AppConfig
{ endpoint = fromMaybe (Endpoint [uri|http://localhost:3000|]) endpoint
, manager
, oauth = dummyOAuthConfig
, devMode = isNothing endpoint -- in dev mode if APP_ENDPOINT is not set (localhost)
}
type Key = String
data ConfigError
= BadEnv Key
deriving (Show, Exception)
lookupEnvEndpoint :: (Environment :> es) => Key -> Eff es (Maybe (Endpoint a))
lookupEnvEndpoint k = do
mstr <- lookupEnv k
pure $ parseEndpoint mstr
where
parseEndpoint mstr = do
input <- mstr
url <- parseURI input
pure $ Endpoint url
-- In a real app this would be read from ENV. See OAuth2.initConfigEnv
dummyOAuthConfig :: OAuth2.Config
dummyOAuthConfig =
Config
{ clientId = Token "dummy client id"
, clientSecret = Token "dummy client secret"
, authorize = Endpoint [uri|https://oauth-mock.mock.beeceptor.com/oauth/authorize|]
, token = Endpoint [uri|https://oauth-mock.mock.beeceptor.com/oauth/token/github|]
}
================================================
FILE: demo/App/Docs/Markdown.hs
================================================
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module App.Docs.Markdown
( markdocs
, markdump
, nodeToView
, embedFile
) where
import App.Docs.Snippet
import App.Route
import CMark
import Data.Char (isSpace)
import Data.Set
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Example.Colors (magenta)
import Example.Style qualified as Style
import Example.Style.Cyber qualified as Cyber
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Web.Atomic.CSS
import Web.Hyperbole.Data.URI
import Web.Hyperbole.HyperView.Input (route)
import Web.Hyperbole.Route
import Web.Hyperbole.View
markdocs :: Text -> View c ()
markdocs md = do
nodeToView $ commonmarkToNode [] $ cs md
markdump :: Text -> View c ()
markdump md = do
code $ cs $ show $ commonmarkToNode [] $ cs md
nodeToView :: Node -> View c ()
nodeToView (Node _mpos typ childs) = do
let inner = mapM_ nodeToView childs
case typ of
-- DOCUMENT -> mapM nodeToView childs
-- THEMATIC_BREAK -> _
-- PARAGRAPH -> _
-- BLOCK_QUOTE -> _
-- HTML_BLOCK Text -> _
-- CUSTOM_BLOCK OnEnter OnExit -> _
-- CODE_BLOCK Info Text -> _
-- HEADING Level -> _
-- LIST ListAttributes -> _
-- ITEM -> _
-- TEXT Text -> _
-- SOFTBREAK -> _
-- LINEBREAK -> _
-- HTML_INLINE Text -> _
-- CUSTOM_INLINE OnEnter OnExit -> _
-- CODE Text -> _
-- EMPH -> _
-- STRONG -> _
-- LINK url title -> _
-- IMAGE url title -> _
PARAGRAPH -> el inner
TEXT t -> text t
CODE t -> do
inlineCode t
HEADING lvl ->
el ~ bold . headerLevel lvl $ inner
LINK url _title ->
case matchRoute @AppRoute (path url) of
Nothing -> do
case parseURIReference (cs url) of
Nothing -> text $ "INVALID URI: " <> url
Just u ->
link u ~ Style.link @ att "target" "_blank" $ inner
Just r ->
route r ~ Style.link $ inner
LIST (ListAttributes ORDERED_LIST _ _ _) ->
tag "ol" ~ list Decimal . pad (L 32) $ inner
LIST (ListAttributes BULLET_LIST _ _ _) ->
tag "ul" ~ list Disc . pad (L 32) $ inner
ITEM -> tag "li" inner
DOCUMENT -> inner
CODE_BLOCK _info t ->
snippet $ raw t
BLOCK_QUOTE -> el ~ Cyber.quote $ inner
HTML_BLOCK t -> raw t
SOFTBREAK -> inner
EMPH -> tag' True "span" ~ italic $ inner
STRONG -> tag' True "span" ~ bold $ inner
x ->
-- inner
raw $ cs $ show x
where
headerLevel lvl =
case lvl of
1 -> fontSize 24
2 -> fontSize 20
_ -> fontSize 16
hackageDocsURI :: URI
hackageDocsURI = [uri|https://hackage-content.haskell.org/package/hyperbole/docs/Web-Hyperbole.html|]
inlineCode :: Text -> View c ()
inlineCode cd
| cd `elem` typeKeywords = linkSymbolDocs cd typeFrag ~ color hackageSymbolColor
| cd `elem` valueKeywords = linkSymbolDocs cd valFrag ~ color hackageSymbolColor
| otherwise = tag' True "code" ~ color magenta $ text cd
where
typeFrag t = "#t:" <> cs t
valFrag v = "#v:" <> cs v
hackageSymbolColor :: HexColor
hackageSymbolColor = "#9e358f"
linkSymbolDocs :: Text -> (Text -> String) -> View c ()
linkSymbolDocs sym frag = do
link (hackageDocsURI{uriFragment = frag sym}) @ att "target" "_blank" $ do
tag' True "code" $ text sym
typeKeywords :: Set Text
typeKeywords =
[ "Page"
, "View"
, "HyperView"
, "ViewId"
, "ViewAction"
, "ViewState"
, "Action"
, "Hyperbole"
, "Effect"
, "Query"
, "Session"
, "Require"
, "Client"
, "Request"
, "Document"
, "Path"
, "Route"
, "Eff"
, "Page"
, "Response"
, "FromForm"
, "Validated"
, "Concurrency"
, "Replace"
, "Drop"
]
valueKeywords :: Set Text
valueKeywords =
[ "context"
, "update"
, "form"
, "validate"
, "hyper"
, "request"
, "viewId"
, "viewState"
, "trigger"
, "target"
, "hyperState"
, "runPage"
, "document"
, "routeRequest"
, "matchRoute"
, "liveApp"
, "pushUpdate"
, "onLoad"
, "session"
, "query"
, "setQuery"
, "setParam"
, "param"
, "modifyQuery"
, "saveSession"
, "deleteSession"
, "quickStartDocument"
, "search"
, "loading"
, "whenLoading"
, "dropdown"
, "option"
, "button"
, "onClick"
, "onKeyDown"
, "onKeyUp"
, "onMouseEnter"
, "onMouseLeave"
, "onInput"
]
embedFile :: FilePath -> Q Exp
embedFile p = do
addDependentFile p
lns :: [Text] <- runIO $ T.lines <$> T.readFile p
exps :: [Exp] <- traverse expandLine lns
e :: Exp <- listE (fmap pure exps)
[|T.unlines $(pure e)|]
expandLine :: Text -> Q Exp
expandLine l = do
let whitespace = T.takeWhile isSpace l
case parseLineEmbed l of
Just (mn, tld) -> do
e <- embedSource' mn (isTopLevel tld) (isCurrentDefinition tld)
[|T.stripEnd $ T.unlines $ fmap (whitespace <>) $(pure e)|]
Nothing -> do
t <- expandText l
lift t
expandText :: (MonadFail m) => Text -> m Text
expandText t = do
let segs = T.splitOn "[[" t
es :: [Text] <- mapM checkLink segs
pure $ mconcat es
where
checkLink :: (MonadFail m) => Text -> m Text
checkLink l = do
case T.breakOn "]]" l of
(txt, "") -> pure txt
(lnk, rest) -> do
mdlnk <- routeLink lnk
pure $ mdlnk <> T.dropWhile (== ']') rest
routeLink :: (MonadFail m) => Text -> m Text
routeLink l =
case matchRoute @AppRoute (path l) of
Nothing -> error $ "Could not find page link: " <> cs l <> " " <> show (path l)
Just r -> pure $ "[" <> routeTitle r <> "](" <> uriToText (routeUri r) <> ")"
================================================
FILE: demo/App/Docs/Page.hs
================================================
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE QuasiQuotes #-}
module App.Docs.Page
( PageAnchor (..)
, sourceLink
, example
, example'
, section
, section'
, camelTitle
, Cyber.embed
, Cyber.quote
) where
import App.Docs.Snippet (ModuleSource (..))
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Text qualified as T
import Example.Colors (AppColor (..))
import Example.Style qualified as Style
import Example.Style.Cyber qualified as Cyber
import Text.Casing (fromHumps, toWords)
import Web.Atomic.CSS
import Web.Hyperbole
import Web.Hyperbole.Data.URI
class PageAnchor n where
pageAnchor :: n -> Text
default pageAnchor :: n -> Text
pageAnchor = T.toLower . T.replace " " "-" . sectionTitle
sectionTitle :: n -> Text
default sectionTitle :: (Show n) => n -> Text
sectionTitle = camelTitle
navEntry :: n -> Text
default navEntry :: n -> Text
navEntry = sectionTitle
subnav :: [n]
default subnav :: (Enum n, Bounded n) => [n]
subnav = [minBound .. maxBound]
instance PageAnchor () where
subnav = []
camelTitle :: (Show a) => a -> Text
camelTitle = cs . toWords . fromHumps . show
-- Sections ----------------------------------------------------------------------
sourceLink :: Path -> View c ()
sourceLink p =
link sourceUrl ~ fontSize 14 @ att "target" "_blank" $ do
text "</> Source"
where
sourceUrlBase = [uri|https://github.com/seanhess/hyperbole/blob/main/demo/|]
sourceUrl = sourceUrlBase ./. p
example :: ModuleSource -> View c () -> View c ()
example (ModuleSource e) = example' (path $ cs e)
example' :: Path -> View c () -> View c ()
example' p cnt = do
el ~ stack . Cyber.font $ do
col ~ Cyber.embed $ cnt
sourceLink p ~ popup (TR (-10) 0) . pad (XY 8 2) . bg PrimaryLight . color White . hover (bg Primary) -- . pad (TRBL 0 20 0 10) . border (L 3) . borderColor PrimaryLight . Cyber.clip 10
-- section :: AppRoute -> View c () -> View c ()
-- section r = section' (routeTitle r)
section' :: Text -> View c () -> View c ()
section' t cnt = do
tag "section" ~ gap 10 . flexCol $ do
row $ do
el ~ bold . fontSize 28 . Cyber.font . Style.uppercase $ text t
cnt
section :: (PageAnchor n) => n -> View c () -> View c ()
section n =
section' (sectionTitle n)
@ att "id" (pageAnchor n)
-- type Fragment = String
--
-- hackage :: Fragment -> Text -> View c ()
-- hackage uriFragment txt = do
-- let docs = [uri|https://hackage-content.haskell.org/package/hyperbole/docs/Web-Hyperbole.html|]
-- link docs{uriFragment} @ att "target" "_blank" ~ Style.link $ do
-- el ~ iconInline $ do
-- Icon.bookOpen
-- text txt
================================================
FILE: demo/App/Docs/Snippet.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
module App.Docs.Snippet where
import Control.Monad (unless)
import Data.Char (isSpace)
import Data.List qualified as L
import Data.String (IsString)
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import System.Directory (doesFileExist, getCurrentDirectory)
import System.FilePath (normalise, (</>))
import Web.Atomic.CSS
import Web.Hyperbole.View
snippet :: View c () -> View c ()
snippet cnt = do
tag' True "pre" ~ bg (HexColor "#F2F2F3") $ do
tag' True "code" @ class_ "language-haskell" $ do
cnt
codeblock :: Text -> View c ()
codeblock t =
tag' True "pre" ~ monoline $ do
tag' True "code" $ do
raw t
where
monoline =
utility
"monoline"
[ "line-height" :. "1"
]
rawMulti :: [Text] -> View c ()
rawMulti = raw . T.stripEnd . T.unlines
embedLines :: FilePath -> Int -> Int -> Q Exp
embedLines path start end = do
addDependentFile path
contents <- runIO (T.readFile path)
let selected =
T.unlines
. take (end - start + 1)
. drop (start - 1)
. T.lines
$ contents
lift (T.unpack selected)
newtype TopLevelDefinition = TopLevelDefinition Text
deriving newtype (Show, Eq, IsString)
newtype SourceCode = SourceCode {lines :: [Text]}
newtype ModuleName = ModuleName Text
deriving newtype (Show, Eq, IsString)
modulePath :: ModuleName -> FilePath
modulePath (ModuleName mn) = cs $ "demo/" <> T.replace "." "/" mn <> ".hs"
{- | A top-level definition as text
> snippet $(topLevel "demo/Example/Page/Concurrency.hs" "instance (Debug :> es) => HyperView Polling")
-}
embedTopLevel :: ModuleName -> TopLevelDefinition -> Q Exp
embedTopLevel mn tld = do
embedSource mn (isTopLevel tld) (isCurrentDefinition tld)
embedSource :: ModuleName -> (Text -> Bool) -> (Text -> Bool) -> Q Exp
embedSource mn isStart isCurrent = do
e <- embedSource' mn isStart isCurrent
[|T.unlines $(pure e)|]
embedSource' :: ModuleName -> (Text -> Bool) -> (Text -> Bool) -> Q Exp
embedSource' mn isStart isCurrent = do
path <- runIO $ localFile $ modulePath mn
addDependentFile path
s <- runIO $ readSourceCode path
let lns = selectLines isStart isCurrent s
case lns of
[] -> fail $ "Missing embed in: " ++ show mn
_ -> lift lns
readSnippet :: FilePath -> TopLevelDefinition -> IO [Text]
readSnippet path tld = do
s <- readSourceCode path
pure $ findTopLevel tld s
readSourceCode :: FilePath -> IO SourceCode
readSourceCode path = SourceCode . T.lines <$> T.readFile path
-- returns lines of a top-level definition
findTopLevel :: TopLevelDefinition -> SourceCode -> [Text]
findTopLevel tld =
selectLines (isTopLevel tld) (isCurrentDefinition tld)
-- isBlankLine line = T.null $ T.strip line
isCurrentDefinition :: TopLevelDefinition -> Text -> Bool
isCurrentDefinition tld line =
isTopLevel tld line || not (isFullyOutdented line)
isTopLevel :: TopLevelDefinition -> Text -> Bool
isTopLevel (TopLevelDefinition def) line =
if "^" `T.isPrefixOf` def
then T.isPrefixOf (T.drop 1 def) line
else T.isPrefixOf def $ T.dropWhile (== ' ') line
selectLines :: (Text -> Bool) -> (Text -> Bool) -> SourceCode -> [Text]
selectLines isStart isCurrent s =
let rest = dropWhile (not . isStart) s.lines
in dropWhileEnd isEmpty $ takeWhile isCurrent rest
where
isEmpty = T.null
dropWhileEnd :: (a -> Bool) -> [a] -> [a]
dropWhileEnd p as =
reverse $ dropWhile p $ reverse as
isFullyOutdented :: Text -> Bool
isFullyOutdented line =
case cs (T.take 1 line) of
"" -> False
[c] -> not $ isSpace c
_ -> False
-- #EMBED Example.Docs.Interactive instance HyperView Titler
parseLineEmbed :: Text -> Maybe (ModuleName, TopLevelDefinition)
parseLineEmbed l = do
rest <- T.stripPrefix "#EMBED " (T.stripStart l)
(mn : tld) <- pure $ T.words rest
pure (ModuleName mn, TopLevelDefinition $ T.unwords tld)
-- start with a relative OR absolute path, end up with a path to the file
-- works with any working directory
localFile :: FilePath -> IO FilePath
localFile p = do
current <- getCurrentDirectory
let lpath = addRelativeDemo current $ stripDir "demo" $ stripDir current p
b <- doesFileExist lpath
unless b $ do
fail $ "Could not find file: " <> show lpath <> " in working dir: " <> current
pure lpath
where
addRelativeDemo wd rp
| "demo" `L.isSuffixOf` wd = rp
| otherwise = "demo" </> rp
stripDir :: FilePath -> FilePath -> FilePath
stripDir dir p =
maybe
p
(dropWhile (== '/'))
(L.stripPrefix dir p)
newtype ModuleSource = ModuleSource FilePath
deriving newtype (Show, Eq, IsString)
moduleSource :: Q Exp
moduleSource = do
loc <- location
let path = normalise $ loc_filename loc
fp <- runIO $ localFile path
lift fp
moduleSourceNamed :: ModuleName -> Q Exp
moduleSourceNamed mn = do
fp <- runIO $ localFile $ modulePath mn
lift fp
================================================
FILE: demo/App/Docs.hs
================================================
module App.Docs
( module App.Docs.Markdown
, module App.Docs.Page
, module App.Docs.Snippet
) where
import App.Docs.Markdown
import App.Docs.Page
import App.Docs.Snippet
================================================
FILE: demo/App/Page/Application.hs
================================================
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
module App.Page.Application where
import App.Docs
import App.Route (AppRoute (Application))
import Effectful
import Example.CSS.External qualified as External
import Example.CSS.Transitions as Transitions
import Example.Interactivity.Events as Events
import Example.View.Layout
import Web.Hyperbole
data Sections
= LiveApp
| Document
| Pages
| TypeSafeRoutes
| RunningEffects
deriving (Eq, Generic, Show, Enum, Bounded, PageAnchor)
page :: (Hyperbole :> es) => Page es '[Animate, External.Items, Boxes]
page = do
pure $ layoutSubnav @Sections Application $ do
section LiveApp $ do
markdocs $(embedFile "docs/app-live.md")
section Document $ do
markdocs $(embedFile "docs/app-document.md")
section Pages $ do
--
markdocs $(embedFile "docs/app-pages.md")
section TypeSafeRoutes $ do
markdocs $(embedFile "docs/app-routes.md")
section RunningEffects $ do
markdocs $(embedFile "docs/app-effects.md")
================================================
FILE: demo/App/Page/CSS.hs
================================================
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
module App.Page.CSS where
import App.Docs
import App.Route (AppRoute (CSS))
import Effectful
import Example.CSS.External qualified as External
import Example.CSS.Loading as Loading
import Example.CSS.Tooltips as Tooltips
import Example.CSS.Transitions as Transitions
import Example.Docs.CSS qualified as CSS
import Example.Interactivity.Events as Events
import Example.View.Layout
import Example.View.Loader as Loader
import Web.Atomic.CSS
import Web.Hyperbole
import Web.Hyperbole.HyperView.Types (Root (..))
import Web.Hyperbole.Page (subPage)
data CSSExample
= Factoring
| Transitions
| Tooltips
| Loading
| External
deriving (Eq, Generic, Show, Enum, Bounded)
instance PageAnchor CSSExample where
sectionTitle = \case
Factoring -> "Atomic CSS"
Transitions -> "CSS Transitions"
Tooltips -> "Tooltips"
Loading -> "Loading"
External -> "External Stylesheets"
page :: (Hyperbole :> es) => Page es '[Animate, External.Items, Boxes, Loader]
page = do
ext <- subPage External.page
pure $ layoutSubnav @CSSExample CSS $ do
style Loader.css
section Factoring $ do
markdocs $(embedFile "docs/atomic.md")
CSS.example ~ embed
section Transitions $ do
markdocs "If an update changes the `transition` property of a view, it will automatically animate with CSS Transitions, avoiding having the server compute animation frames."
snippet $ do
raw $(embedTopLevel "Example.CSS.Transitions" "viewSmall")
raw "\n"
raw $(embedTopLevel "Example.CSS.Transitions" "viewBig")
example Transitions.source $ hyper Animate viewSmall
section Tooltips $ do
markdocs "For immediate feedback, create interactivity via Atomic CSS whenever possible."
example Tooltips.source tooltips
section Loading $ do
markdocs "Use `whenLoading` to provide feedback while an `Action` is being processed"
snippet $ do
raw $(embedTopLevel "Example.CSS.Loading" "viewLoaders")
example $(moduleSourceNamed "Example.CSS.Loading") $ do
hyper Loader $ viewLoaders "..."
section External $ do
markdocs "You can opt-out of Atomic CSS and use external classes with `class_`"
snippet $ do
raw $(embedTopLevel "Example.CSS.External" "page")
snippet $ do
raw $(embedTopLevel "Example.CSS.External" "itemsView")
example External.source $ do
runViewContext Root () ext
================================================
FILE: demo/App/Page/Concurrency.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module App.Page.Concurrency where
import App.Docs
import App.Route qualified as Route
import Control.Monad (forM_)
import Effectful
import Example.Concurrency.LazyLoading as Lazy
import Example.Concurrency.Overlap as Overlap
import Example.Concurrency.Polling as Polling
import Example.Concurrency.Progress as Progress
import Example.Concurrency.Tasks
import Example.Effects.Debug
import Example.Push qualified as Push
import Example.Style.Cyber (btn, font)
import Example.View.Layout (layoutSubnav)
import Example.View.Loader as Loader
import Web.Atomic.CSS
import Web.Hyperbole
data Section
= Concurrency
| OverlappingRequests
| LazyLoading
| Polling
| PushUpdates
deriving (Show, Eq, Enum, Bounded, PageAnchor)
page :: (Hyperbole :> es, Debug :> es) => Page es '[Poller, LazyData, Progress, Push.Tasks, OverlapDrop, OverlapReplace, LazyAll]
page = do
pure $ layoutSubnav @Section Route.Concurrency $ do
style Loader.css
section Concurrency $ do
markdocs "While individual `HyperView`s can only have one update in progress at a time, multiple `HyperView`s can overlap updates without issue"
example Progress.source ~ font $ do
hyper (Progress 1) $ viewProgressLoad 6
hyper (Progress 2) $ viewProgressLoad 4
hyper (Progress 3) $ viewProgressLoad 2
-- hyper (Progress 4 200) viewProgressLoad
-- hyper (Progress 5 250) viewProgressLoad
section OverlappingRequests $ do
markdocs $(embedFile "docs/concurrency-overlap.md")
example $(moduleSourceNamed "Example.Concurrency.Overlap") $ do
hyper OverlapDrop $ viewTimeDrop Nothing
hyper OverlapReplace $ viewTimeReplace Nothing
section LazyLoading $ do
markdocs "Instead of preloading everything in our `Page`, a `HyperView` can load itself using `onLoad`"
snippet $ raw $(embedTopLevel "Example.Concurrency.LazyLoading" "viewTaskLoad")
example Lazy.source $ do
hyper LazyAll viewLazyAll
section Polling $ do
markdocs "By including an `onLoad` in every view update, we can poll the server after a given delay"
snippet $ raw $(embedTopLevel "Example.Concurrency.Polling" "viewPoll")
example Polling.source $ do
hyper Poller viewInit
section PushUpdates $ do
markdocs "Actions can call `pushUpdate` to send an intermediate update to the view. This can be simpler than polling."
snippet $ raw $(embedTopLevel "Example.Push" "update")
example Push.source $ do
hyper Push.Tasks $ Push.taskView 0
data LazyAll = LazyAll
deriving (Generic, ViewId)
instance HyperView LazyAll es where
data Action LazyAll
= ReloadAll
deriving (Generic, ViewAction)
type Require LazyAll = '[LazyData]
update _ = do
pure viewLazyAll
viewLazyAll :: View LazyAll ()
viewLazyAll = do
col ~ gap 10 $ do
row ~ flexWrap Wrap . font . gap 10 $ do
forM_ pretendTasks $ \taskId -> do
el ~ border 1 . width 120 . pad 5 $ do
hyper (LazyData taskId) viewTaskLoad
row $ button ReloadAll ~ btn $ "Reload"
================================================
FILE: demo/App/Page/Examples.hs
================================================
module App.Page.Examples where
import App.Docs
import App.Route as Route
import Example.Style as Style (link)
import Example.View.Layout
import Web.Atomic.CSS
import Web.Hyperbole
page :: (Hyperbole :> es) => Page es '[]
page = do
pure $ layout (Examples OtherExamples) $ do
section' "Data Lists" $ do
col ~ gap 10 $ do
card (Data SortableTable) "Sort by column, demonstrates view functions"
card (Data Autocomplete) "Incremental search using only hyperbole"
card (Data Filter) "Faceted search, live filtering of lists "
card (Data LoadMore) "Progressively load more items"
section' "UI Demos" $ do
col ~ gap 10 $ do
card (Examples Tags) $ markdocs "Add and remove \"tags\" with an `<input>`"
card (Examples Chat) "Demonstrates server pushes and concurrency. Open in multiple tabs"
card (Examples Scrollbars) "Layouts with internal scrollbars"
section' "Other Features" $ do
card (Examples OAuth2) "Demonstration of OAuth2"
section' "Reference Implementations" $ do
card (Examples Todos) "using Atomic CSS"
card (Examples TodosCSS) "using external classes"
where
card r cnt = do
row ~ gap 5 $ do
route r ~ Style.link $ do
text $ routeTitle r
el $ text "-"
el cnt
-- cardBtn :: (Styleable h) => CSS h -> CSS h
-- cardBtn =
-- bgAnimated
-- . bgGradient White
-- . hover bgzero
-- . clip 10
-- . shadow ()
--
-- grid :: (Styleable h) => CSS h -> CSS h
-- grid =
-- utility
-- "grid-ex"
-- [ "display" :. "grid"
-- , "grid-template-columns" :. "repeat(auto-fit, minmax(200px, 1fr))"
-- ]
--
-- tile :: (Styleable h) => CSS h -> CSS h
-- tile =
-- utility
-- "tile"
-- [ "aspect-ratio" :. "16 / 9"
-- ]
-- section Effectful $ do
-- markdocs $(embedFile "docs/effectful.md")
-- example SideEffects.source $ do
-- hyper Titler titleView
--
-- section Other $ do
-- markdocs $(embedFile "docs/effects-other.md")
-- example SideEffects.source $ do
-- hyper SlowReader $ messageView "..."
--
-- section Custom $ do
-- markdocs $(embedFile "docs/effects-custom.md")
================================================
FILE: demo/App/Page/Forms.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
module App.Page.Forms where
import App.Docs
import App.Route
import Example.FormSimple (AddContact (..))
import Example.FormSimple qualified as FormSimple
import Example.FormValidation (Signup (..))
import Example.FormValidation qualified as FormValidation
import Example.View.Layout
import Web.Hyperbole
data Sections
= BasicForms
| Validation
deriving (Generic, Show, Bounded, Enum, PageAnchor)
page :: (Hyperbole :> es) => Page es '[Signup, AddContact]
page = do
pure $ layoutSubnav @Sections (Forms FormSimple) $ do
section BasicForms $ do
markdocs $(embedFile "docs/forms-simple.md")
example FormSimple.source $ do
hyper AddContact FormSimple.formView'
section Validation $ do
markdocs $(embedFile "docs/forms-validated.md")
example FormValidation.source $ do
--
hyper Signup $ FormValidation.formView genFields
================================================
FILE: demo/App/Page/HyperboleEffect.hs
================================================
module App.Page.HyperboleEffect where
import App.Route as Route hiding (Response, UserId)
import App.Docs
import Effectful
import Example.Errors (Errors (..), Users (..), viewCustom, viewExceptions, viewKnownUsers, viewSearchUsers)
import Example.Errors qualified as Errors
import Example.Requests (CheckRequest (..), ControlClient (..), ControlResponse (..))
import Example.Requests qualified as Requests
import Example.View.Layout (layoutSubnav)
import Web.Hyperbole hiding (Response)
data Sections
= Requests
| Response
| ExceptionHandling
| EdgeCases
| HandleInViews
| CustomErrorViews
deriving (Show, Enum, Bounded, PageAnchor)
page :: (Hyperbole :> es) => Page es '[CheckRequest, ControlResponse, ControlClient, Errors, Users]
page = do
r <- request
pure $ layoutSubnav @Sections Route.HyperboleEffect $ do
section Requests $ do
markdocs "The `Hyperbole` `Effect` allows us to skip the normal update cycle to directly access the `Request` or manipulate the `Client`"
example Requests.source $ do
hyper CheckRequest $ Requests.viewRequest r
example Requests.source $ do
hyper ControlClient Requests.viewClient
section Response $ do
el "It also allows us to directly affect the response and the javascript client"
example Requests.source $ hyper ControlResponse Requests.responseView
section ExceptionHandling $ do
el "Any uncaught exceptions thrown from a handler will be displayed in a bright red box inline in the corresponding HyperView"
example Errors.source $ do
hyper Exceptions viewExceptions
section EdgeCases $ do
el "You can use the same mechanism to exit execution early and display an application error to handle edge cases"
example Errors.source $ do
hyper KnownUsers viewKnownUsers
section HandleInViews $ do
el "Handle any expected errors in your view function, by making it accept a Maybe or Either"
example Errors.source $ do
hyper SearchUsers viewSearchUsers
section CustomErrorViews $ do
el "You can also exit execution early and display a custom view from application code or from caught execptions"
example Errors.source $ do
hyper Customs viewCustom
================================================
FILE: demo/App/Page/Hyperviews.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
module App.Page.Hyperviews where
import App.Docs
import App.Route qualified as Route (AppRoute (..))
import Example.Counter (Counter (..))
import Example.Docs.MultiView qualified as Multi
import Example.Docs.Nesting qualified as Nesting
import Example.Docs.UniqueViewId qualified as UniqueViewId
import Example.Push as Push
import Example.Simple (Message (..))
import Example.Trigger as Trigger
import Example.View.Layout (layoutSubnav)
import Web.Hyperbole
import Web.Hyperbole.HyperView.Types (Root (..))
import Web.Hyperbole.Page (subPage)
data HyperSectuions
= IndependentUpdates
| UniqueViewid
| Nesting
| TargetingOtherHyperviews
deriving (Show, Enum, Bounded, PageAnchor)
page :: (Hyperbole :> es) => Page es '[Counter, Message, UniqueViewId.Item, Nesting.ItemList, Targeted, Controls, Tasks]
page = do
mlt <- subPage Multi.page
uvd <- subPage UniqueViewId.page
nst <- subPage Nesting.page
pure $ layoutSubnav @HyperSectuions Route.Hyperviews $ do
section IndependentUpdates $ do
markdocs $(embedFile "docs/hyperviews-multi.md")
example $(moduleSourceNamed "Example.Docs.MultiView") $ do
runViewContext Root () mlt
section UniqueViewid $ do
markdocs $(embedFile "docs/hyperviews-unique.md")
example $(moduleSourceNamed "Example.Docs.UniqueViewId") $ do
runViewContext Root () uvd
section Nesting $ do
markdocs $(embedFile "docs/hyperviews-nesting.md")
example $(moduleSourceNamed "Example.Docs.Nesting") $ do
runViewContext Root () nst
section TargetingOtherHyperviews $ do
markdocs "Sometimes nesting isn't enough, and we need to directly communicate to other `HyperView`s. Below, we have an independent `HyperView` which displays a message, and two ways to control it:"
example Trigger.source $ do
hyper Targeted $ targetedView "..."
markdocs "Use `trigger` to tell another `HyperView` to run an action"
snippet $ do
raw $(embedTopLevel "Example.Trigger" "instance HyperView Controls")
example Trigger.source $ do
hyper Controls controlView
markdocs "You can use `target` in a `View` to use `Action`s from another `HyperView`"
snippet $ do
raw $(embedTopLevel "Example.Trigger" "targetView")
example Trigger.source $ do
hyper Controls targetView
markdocs "Alternatively, you can use `pushUpdate` to directly update another view:"
example Push.source $ do
hyper Tasks $ taskView 0
================================================
FILE: demo/App/Page/Interactivity.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
module App.Page.Interactivity where
import App.Docs
import App.Route hiding (Javascript)
import Example.Interactivity.Events
import Example.Interactivity.Inputs
import Example.Javascript as Javascript
import Example.View.Layout
import Web.Hyperbole
data Sections
= Inputs
| Events
| Javascript
deriving (Show, Bounded, Enum, PageAnchor)
page :: (Hyperbole :> es) => Page es '[Boxes, JBoxes, Message, TryEvents, Dropper]
page = do
pure $ layoutSubnav @Sections Interactivity $ do
-- NOTE: only include javascript on the pages you need it
script "custom.js"
section Inputs $ do
markdocs $(embedFile "docs/interactivity-inputs.md")
example $(moduleSourceNamed "Example.Interactivity.Inputs") $ hyper Dropper (selectPlanet Nothing)
section Events $ do
markdocs $(embedFile "docs/interactivity-events.md")
example $(moduleSourceNamed "Example.Interactivity.Events") $ hyper TryEvents (viewEvents "")
markdocs $(embedFile "docs/interactivity-events2.md")
example $(moduleSourceNamed "Example.Interactivity.Events") $ hyper Boxes (viewBoxes Nothing)
section Javascript $ do
markdocs $(embedFile "docs/interactivity-javascript.md")
example Javascript.source $ do
hyper JBoxes $ viewJBoxes Nothing
markdocs $(embedFile "docs/interactivity-pushevent.md")
example Javascript.source $ do
hyper Message viewMessage
================================================
FILE: demo/App/Page/Intro/Basics.hs
================================================
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module App.Page.Intro.Basics where
import App.Docs
import App.Route
import Data.String.Interpolate (i)
import Example.Counter (Counter)
import Example.Docs.Interactive qualified as Interactive
import Example.Docs.ViewFunctions qualified as ViewFunctions
import Example.Simple as Simple
import Example.View.Layout (layoutSubnav)
import Web.Atomic.CSS
import Web.Hyperbole
import Web.Hyperbole.HyperView.Types (Root (..))
import Web.Hyperbole.Page (subPage)
data Basics
= GetRunning
| HtmlViews
| Interactive
deriving (Show, Enum, Bounded)
instance PageAnchor Basics where
sectionTitle Interactive = "Interactive HyperViews"
sectionTitle a = camelTitle a
navEntry Interactive = "HyperViews"
navEntry a = sectionTitle a
page :: (Hyperbole :> es) => Page es '[Message, Counter, ViewFunctions.Message]
page = do
int <- subPage Interactive.page
-- mlt <- subPage Multi.page
pure $ layoutSubnav @Basics Basics $ do
section GetRunning getRunning
section HtmlViews htmlViews
-- section Styles $ do
-- markdocs $(embedFile "docs/atomic.md")
-- CSS.example ~ embed
-- markdocs "See [Styles](/css) for more info"
section Interactive $ do
markdocs $(embedFile "docs/hyperviews-intro.md")
example $(moduleSourceNamed "Example.Simple") $ do
runViewContext Root () int
where
getRunning = do
markdocs "Hyperbole applications are divided into top-level `Page`s, which run side effects, then return an HTML `View`"
snippet $ raw $ $(embedTopLevel "Example.Docs.BasicPage" "hello")
markdocs "Run an Application via [Warp](https://hackage.haskell.org/package/warp) and [WAI](https://hackage.haskell.org/package/wai). This runs on port 3000 and responds to everything with \"Hello World\""
snippet $ do
raw $ $(embedTopLevel "Example.Docs.BasicPage" "main")
col ~ embed $ do
"Hello World"
htmlViews = do
markdocs "`View`s are HTML fragments with a `context`"
snippet $ raw $ $(embedTopLevel "Example.Docs.BasicPage" "helloWorld")
-- WARNING: this doesn't render properly when embedded in markdown
snippet $
text
[i|>>> renderText helloWorld
"<div>Hello World</div>"|]
markdocs "We can factor `View`s into reusable functions:"
snippet $ do
rawMulti
[ $(embedTopLevel "Example.Docs.BasicPage" "messageView")
, $(embedTopLevel "Example.Docs.BasicPage" "page")
]
col ~ embed $ do
"Hello World"
markdocs "Using [atomic-css](/css) we can use functions to factor styles as well"
================================================
FILE: demo/App/Page/Intro/Intro.hs
================================================
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module App.Page.Intro.Intro where
import App.Docs
import App.Route
import Data.String.Interpolate (i)
import Example.Colors
import Example.Counter (Counter)
import Example.Simple (Message)
import Example.Simple qualified as Simple
import Example.Style.Cyber qualified as Cyber
import Example.View.Layout (layout)
import Web.Atomic.CSS
import Web.Hyperbole
import Web.Hyperbole.HyperView.Types
import Web.Hyperbole.Page (subPage)
page :: (Hyperbole :> es) => Page es '[Message, Counter]
page = do
simple <- subPage Simple.page
pure $ layout Intro $ do
col ~ gap 20 $ do
row ~ color cyan . bg Dark . pad 20 $ do
space
col ~ gap 10 . overflow Hidden $ do
row $ do
space
codeblock ~ scaleText $ do
[i|╔═════════════════════════════════════════════════════════════════════════════╗
║ ║
║ ██╗ ██╗██╗ ██╗██████╗ ███████╗██████╗ ██████╗ ██████╗ ██╗ ███████╗ ║
║ ██║ ██║╚██╗ ██╔╝██╔══██╗██╔════╝██╔══██╗██╔══██╗██╔═══██╗██║ ██╔════╝ ║
║ ███████║ ╚████╔╝ ██████╔╝█████╗ ██████╔╝██████╔╝██║ ██║██║ █████╗ ║
║ ██╔══██║ ╚██╔╝ ██╔═══╝ ██╔══╝ ██╔══██╗██╔══██╗██║ ██║██║ ██╔══╝ ║
║ ██║ ██║ ██║ ██║ ███████╗██║ ██║██████╔╝╚██████╔╝███████╗███████╗ ║
║ ╚═╝ ╚═╝ ╚═╝ ╚═╝ ╚══════╝╚═╝ ╚═╝╚═════╝ ╚═════╝ ╚══════╝╚══════╝ ║
╚═════════════════════════════════════════════════════════════════════════════╝
|]
space
el ~ fontSize 18 . Cyber.font . bold . textAlign AlignCenter $ do
el "Create interactive HTML applications with type-safe serverside Haskell."
el "Inspired by HTMX, Elm, and Phoenix LiveView"
space
col ~ gap 10 $ do
example $(moduleSourceNamed "Example.Simple") $ do
runViewContext Root () simple
snippet $ do
raw $(embedTopLevel "Example.Simple" "{-# LANGUAGE")
raw "\nmodule Main where\n\n"
raw $(embedSource "Example.Simple" (isTopLevel "import") (const True))
section' "But Why?" $ do
markdocs $(embedFile "docs/intro.md")
section' "When not to use Hyperbole?" $ do
markdocs $(embedFile "docs/intro-downsides.md")
section' "Documentation" $ do
markdocs $(embedFile "docs/intro-links.md")
where
scaleText :: (Styleable h) => CSS h -> CSS h
scaleText =
utility
"scale-text"
[ "font-size" :. "clamp(0.4rem, 1.5vw, 1rem)"
, "max-width" :. "100%"
]
================================================
FILE: demo/App/Page/OAuth2.hs
================================================
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module App.Page.OAuth2 where
import App.Config (AppConfig (..))
import App.Docs
import App.Route qualified as Route
import Data.Aeson (eitherDecode)
import Data.String.Conversions (cs)
import Data.Text (Text, pack)
import Effectful
import Effectful.Reader.Dynamic
import Example.Style.Cyber as Cyber (btn, font)
import Example.View.Layout
import Network.HTTP.Client qualified as HTTP
import Web.Atomic.CSS
import Web.Hyperbole
import Web.Hyperbole.Data.URI (Endpoint (..), (./.))
import Web.Hyperbole.Effect.OAuth2 (Access, OAuth2, Token (..))
import Web.Hyperbole.Effect.OAuth2 qualified as OAuth2
import Web.Hyperbole.Types.Response (ResponseError (ErrAuth))
--------------------------------------------------------------------------------
-- App Specific Login
--------------------------------------------------------------------------------
-- This code belongs in an application-wide module
-- This example uses a mock OAuth2 server: https://app.beeceptor.com/mock-server/oauth-mock
data UserSession = UserSession
{ auth :: OAuth2.Authenticated
, email :: Text
}
deriving (Generic, ToEncoded, FromEncoded)
instance Session UserSession where
-- we want it to work on any page, not just this one
cookiePath = Just []
openLogin :: (Hyperbole :> es, OAuth2 :> es, Reader AppConfig :> es) => Eff es a
openLogin = do
Endpoint appRoot <- (.endpoint) <$> ask @AppConfig
let redirectUrl = appRoot ./. routePath (Route.Examples Route.OAuth2Authenticate)
u <- OAuth2.authUrl redirectUrl "email"
redirect u
logout :: (Hyperbole :> es) => Eff es ()
logout = deleteSession @UserSession
-- | Target of the redirect after the user logs in via OAuth2
handleRedirect :: (Hyperbole :> es, OAuth2 :> es, Reader AppConfig :> es, IOE :> es) => Eff es Response
handleRedirect = do
authCode <- OAuth2.validateCode
auth <- OAuth2.exchangeAuth authCode
info <- fetchUserInfo auth.accessToken
saveSession @UserSession $ UserSession auth info.email
redirect $ routeUri (Route.Examples Route.OAuth2)
data GithubUserInfo = GithubUserInfo
{ email :: Text
}
deriving (Generic, FromJSON, Show)
-- | Example authenticated request using an oauth access token. in a real app, this should be in an external effect, not IOE
fetchUserInfo :: (IOE :> es, Reader AppConfig :> es, Hyperbole :> es) => Token Access -> Eff es GithubUserInfo
fetchUserInfo (Token accessTok) = do
app <- ask @AppConfig
req <- HTTP.parseRequest "https://oauth-mock.mock.beeceptor.com/userinfo/github"
res <- liftIO (HTTP.httpLbs (HTTP.applyBearerAuth (cs accessTok) req) app.manager)
case eitherDecode @GithubUserInfo (HTTP.responseBody res) of
Left e -> respondError $ ErrAuth $ "Could not parse user info: " <> pack (show e)
Right info -> do
liftIO $ putStrLn "GOT"
liftIO $ print info
pure info
--------------------------------------------------------------------------------
-- Page / Views
--------------------------------------------------------------------------------
page
:: (Hyperbole :> es, OAuth2 :> es, Reader AppConfig :> es)
=> Page es '[Contents]
page = do
muser <- lookupSession @UserSession
pure $ layout (Route.Examples Route.OAuth2) $ do
col ~ gap 10 $ do
el "Hyperbole provides some helpers to make OAuth2 easier. This is done in 2 steps:"
el "1. Initiate the login via the OAuth provider given a redirect url"
el "2. After the redirect, the library validates the response and fetches an access token from the oauth provider."
el "The developer can then make authenticated requests, and store a user session"
example $(moduleSource) $ do
hyper Contents $ viewContents muser
data Contents = Contents
deriving (Generic, ViewId)
instance (OAuth2 :> es, Reader AppConfig :> es) => HyperView Contents es where
data Action Contents
= Logout
| Login
deriving (Generic, ViewAction)
update Login = do
openLogin
update Logout = do
logout
pure $ viewContents Nothing
viewContents :: Maybe UserSession -> View Contents ()
viewContents mt = do
col ~ gap 10 $ do
maybe viewUnauthorized viewAuthorized mt
viewUnauthorized :: View Contents ()
viewUnauthorized = do
message "Logged Out!"
col ~ gap 5 $ do
button Login "Login" ~ btn
viewAuthorized :: UserSession -> View Contents ()
viewAuthorized user = do
let auth = user.auth
message "Successfully Logged In!"
el ~ pad 5 . grid' . gap 10 $ do
dataItem "Email" user.email
dataItem "Token Type" $ pack $ show auth.tokenType
dataItem "Access Token" auth.accessToken.value
dataItem "Expires In" $ pack $ show auth.expiresIn
dataItem "Refresh Token" $ pack $ show auth.refreshToken
dataItem "Scope" $ pack $ show auth.scope
button Logout "Logout" ~ btn
where
dataItem :: Text -> Text -> View c ()
dataItem lbl cnt = do
el ~ bold $ do
text lbl
el ~ overflow Hidden $ text cnt
grid' :: (Styleable h) => CSS h -> CSS h
grid' =
utility
"grid"
[ "display" :. "grid"
, "grid-template-columns" :. "max-content auto"
, "align-items" :. "center"
]
message :: View c () -> View c ()
message x = el x ~ pad 10 . Cyber.font . border 1
================================================
FILE: demo/App/Page/SideEffects.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
module App.Page.SideEffects where
import App.Docs
import App.Route as Route (AppRoute (SideEffects))
import Example.Counter (Counter (..))
import Example.Docs.SideEffects as SideEffects
import Example.View.Layout (layoutSubnav)
import Web.Hyperbole
data EffectsSection
= Effectful
| Other
| Custom
deriving (Show, Enum, Bounded)
instance PageAnchor EffectsSection where
sectionTitle Other = "Reader and More"
sectionTitle Custom = "Databases and Custom Effects"
sectionTitle a = camelTitle a
page :: (Hyperbole :> es) => Page es '[Counter, SlowReader, Titler]
page = do
pure $ layoutSubnav @EffectsSection Route.SideEffects $ do
section Effectful $ do
markdocs $(embedFile "docs/effectful.md")
example SideEffects.source $ do
hyper Titler titleView
section Other $ do
markdocs $(embedFile "docs/effects-other.md")
example SideEffects.source $ do
hyper SlowReader $ messageView "..."
section Custom $ do
markdocs $(embedFile "docs/effects-custom.md")
================================================
FILE: demo/App/Page/State.hs
================================================
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module App.Page.State where
import App.Docs
import App.Route (AppRoute (State))
import Effectful.Concurrent
import Effectful.Concurrent.STM (TVar)
import Effectful.Reader.Dynamic
import Example.Counter as Threaded
import Example.State.Effects as Effects
import Example.State.Query (QueryPrefs (..))
import Example.State.Query qualified as Query
import Example.State.Sessions qualified as Session
import Example.State.Stateless
import Example.State.ViewState qualified as ViewState
import Example.View.Layout (layoutSubnav)
import Web.Hyperbole
data StateSection
= Stateless
| ActionThreading
| ViewState
| BrowserQuery
| BrowserSessions
| WithEffects
deriving (Show, Enum, Bounded)
instance PageAnchor StateSection
page :: (Hyperbole :> es, Reader (TVar Int) :> es, Concurrent :> es) => Page es '[Threaded.Counter, Swapper, QueryPrefs, Session.Contents, Effects.Counter, ViewState.Counter]
page = do
ssn <- session @Session.Preferences
qry <- query @Query.Preferences
cnt <- getCount
pure $ layoutSubnav @StateSection State $ do
section Stateless $ do
markdocs $(embedFile "docs/state-stateless.md")
example $(moduleSourceNamed "Example.State.Stateless") $ do
hyper Swapper viewSwap
section ActionThreading $ do
markdocs $(embedFile "docs/state-threading.md")
example $(moduleSourceNamed "Example.Counter") $ do
hyper Threaded.Counter $ Threaded.viewCount 0
section ViewState $ do
markdocs $(embedFile "docs/state-viewstate.md")
example $(moduleSourceNamed "Example.State.ViewState") $ do
hyperState ViewState.CounterState 0 ViewState.viewCount
section BrowserQuery $ do
markdocs $(embedFile "docs/state-browser.md")
example $(moduleSourceNamed "Example.State.Query") $ do
hyper QueryPrefs $ Query.viewPreferences qry
section BrowserSessions $ do
markdocs $(embedFile "docs/state-sessions.md")
example $(moduleSourceNamed "Example.State.Sessions") $ do
hyper Session.Contents $ Session.viewContent ssn
section WithEffects $ do
markdocs $(embedFile "docs/state-effects.md")
example $(moduleSourceNamed "Example.State.Effects") $ do
hyper Effects.Counter $ Effects.viewCount cnt
================================================
FILE: demo/App/Page/ViewFunctions.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
module App.Page.ViewFunctions where
import App.Docs
import App.Route qualified as Route
import Example.Docs.ViewFunctions as VF
import Example.Push qualified as Push
import Example.View.Layout (layoutSubnav)
import Web.Atomic.CSS
import Web.Hyperbole
data Basics
= ViewFunctions
| NotComponents
deriving (Show, Enum, Bounded)
instance PageAnchor Basics
page :: (Hyperbole :> es) => Page es '[Message, Toggler, Progress, Push.Tasks]
page = do
pure $ layoutSubnav @Basics Route.ViewFunctions $ do
section ViewFunctions $ do
markdocs $(embedFile "docs/view-functions.md")
example VF.source $ do
hyper VFMessage $ messageView "Hello"
section NotComponents $ do
markdocs $(embedFile "docs/view-components.md")
example VF.source $ do
hyper Toggler $ toggler False
col ~ pad (T 20) . gap 10 $ do
markdocs $(embedFile "docs/view-functions-wrap.md")
example VF.source $ do
-- hyper Push.Tasks $ Push.taskView 0
hyper Progress $ workingHard 0.1
col ~ pad (T 20) . gap 10 $ do
markdocs $(embedFile "docs/view-functions-end.md")
================================================
FILE: demo/App/Route.hs
================================================
{-# LANGUAGE OverloadedLists #-}
module App.Route where
import Data.String.Conversions (cs)
import Data.Text (Text, unpack)
import Text.Casing (fromHumps, toWords)
import Text.Read (readMaybe)
import Web.Hyperbole
import Web.Hyperbole.Data.URI
import Web.Hyperbole.Route
type UserId = Int
data AppRoute
= Main
| Intro
| Basics
| CSS
| Simple
| Hello Hello
| Contacts ContactRoute
| Interactivity
| SideEffects
| Hyperviews
| State
| Counter
| Forms FormRoute
| HyperboleEffect
| Response
| Concurrency
| Data DataRoute
| Examples ExamplesRoute
| Errors
| Javascript
| Test TestRoute
| ViewFunctions
| Application
deriving (Eq, Generic, Show)
instance Route AppRoute where
baseRoute = Just Main
-- -- View Route
-- data IntroRoute
-- = IntroMain
-- | Pages
-- | Views
-- | HyperViews
-- | ViewFunctions
-- | CSS CSSRoute
-- deriving (Eq, Generic, Show)
-- instance Route IntroRoute where
-- baseRoute = Just IntroMain
data FormRoute
= FormSimple
| FormValidation
deriving (Eq, Generic, Show)
instance Route FormRoute where
baseRoute = Just FormSimple
data DataRoute
= DataLists
| SortableTable
| Autocomplete
| Filter
| LoadMore
deriving (Eq, Generic, Show)
instance Route DataRoute where
baseRoute = Just DataLists
-- data StateRoute
-- = StateRoot
-- | Actions
-- | StateView
-- | Effects
-- | Query
-- | Sessions
-- deriving (Eq, Generic, Show)
-- instance Route StateRoute where
-- baseRoute = Just StateRoot
data ContactRoute
= ContactsAll
| Contact UserId
deriving (Eq, Generic, Show)
instance Route ContactRoute where
baseRoute = Just ContactsAll
matchRoute [contactId] = do
cid <- readMaybe $ unpack contactId
pure $ Contact cid
matchRoute [] = pure ContactsAll
matchRoute other = genMatchRoute other.segments
routePath (Contact uid) = routePath uid
routePath ContactsAll = []
data ExamplesRoute
= OtherExamples
| Todos
| TodosCSS -- A version using the CSS from TodoMVC project
| Tags
| OAuth2Authenticate
| OAuth2
| Chat
| Scrollbars
deriving (Eq, Generic, Show)
instance Route ExamplesRoute where
baseRoute = Just OtherExamples
data TestRoute
= TestMain
| TestState
deriving (Eq, Generic, Show)
instance Route TestRoute where
baseRoute = Just TestMain
data Hello
= Greet Text
| Redirected
| RedirectNow
deriving (Eq, Generic, Route, Show)
routeTitle :: AppRoute -> Text
routeTitle (Hello _) = "Hello World"
routeTitle CSS = "Styles"
-- routeTitle (Intro IntroMain) = "Intro"
-- routeTitle (Intro (CSS _)) = "Atomic CSS"
-- routeTitle (Intro r) = defaultTitle r
routeTitle (Contacts ContactsAll) = "Contacts"
routeTitle State = "Managing State"
routeTitle Hyperviews = "More HyperViews"
-- routeTitle (State StateRoot) = "State"
-- routeTitle (State StateView) = "Built-in State"
-- routeTitle (State Actions) = "Managing State"
-- routeTitle (State Query) = "Query"
-- routeTitle (State Sessions) = "Sessions"
routeTitle (Forms FormSimple) = "Forms"
routeTitle (Forms FormValidation) = "Form Validation"
routeTitle (Data d) = defaultTitle d
routeTitle Errors = "Error Handling"
routeTitle (Examples Todos) = "TodoMVC"
routeTitle (Examples TodosCSS) = "TodoMVC (CSS version)"
routeTitle (Examples OAuth2) = "OAuth2"
routeTitle (Examples OtherExamples) = "Examples"
routeTitle (Examples e) = defaultTitle e
routeTitle r = defaultTitle r
defaultTitle :: (Show r) => r -> Text
defaultTitle = cs . toWords . fromHumps . show
================================================
FILE: demo/App/Style.hs
================================================
module App.Style where
import Example.Colors
import Web.Atomic.CSS
-- btn :: (Styleable h) => CSS h -> CSS h
-- btn = btn' Primary
--
-- btn' :: (Styleable h) => AppColor -> CSS h -> CSS h
-- btn' clr =
-- bg clr
-- . hover (bg (hovClr clr))
-- . color (txtClr clr)
-- . pad 10
-- . shadow ()
-- . rounded 3
-- where
-- hovClr Primary = PrimaryLight
-- hovClr c = c
-- txtClr _ = White
btnLight :: (Styleable h) => CSS h -> CSS h
btnLight =
base
. border 2
. borderColor Secondary
. color Secondary
. hover (borderColor SecondaryLight . color SecondaryLight)
where
base = pad (XY 15 8)
h1 :: (Styleable h) => CSS h -> CSS h
h1 = bold . fontSize 32
invalid :: (Styleable h) => CSS h -> CSS h
invalid = color Danger
success :: (Styleable h) => CSS h -> CSS h
success = color Success
link :: (Styleable h) => CSS h -> CSS h
link = color Primary . underline
input :: (Styleable h) => CSS h -> CSS h
input = border 1 . pad 8
strikethrough :: (Styleable h) => CSS h -> CSS h
strikethrough =
utility "strike" ["text-decoration" :. "line-through"]
uppercase :: (Styleable h) => CSS h -> CSS h
uppercase = utility "upper" ["text-transform" :. "uppercase"]
================================================
FILE: demo/App.hs
================================================
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
module App where
import App.Cache (clientCache)
import App.Config
import App.Docs.Page
import App.Page.Application qualified as Application
import App.Page.CSS qualified as CSS
import App.Page.Concurrency qualified as Concurrency
import App.Page.Examples qualified as Examples
import App.Page.Forms qualified as Forms
import App.Page.HyperboleEffect qualified as Hyp
import App.Page.Hyperviews qualified as Hyperviews
import App.Page.Interactivity qualified as Interactivity
import App.Page.Intro.Basics qualified as Basics
import App.Page.Intro.Intro qualified as Intro
import App.Page.OAuth2 qualified as OAuth2
import App.Page.SideEffects qualified as SideEffects
import App.Page.State qualified as State
import App.Page.ViewFunctions qualified as ViewFunctions
import App.Route as Route
import Control.Concurrent
( MVar
, ThreadId
, forkFinally
, killThread
, newEmptyMVar
, putMVar
, takeMVar
)
import Control.Monad (forever, when, (>=>))
import Data.ByteString.Lazy qualified as BL
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Maybe (fromMaybe)
import Data.String.Conversions (cs)
import Data.String.Interpolate (i)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Lazy qualified as L
import Data.Text.Lazy.Encoding qualified as L
import Data.Version (showVersion)
import Effectful
import Effectful.Concurrent.STM
import Effectful.Dispatch.Dynamic
import Effectful.Environment (runEnvironment)
import Effectful.Reader.Dynamic
import Effectful.State.Static.Local
import Example.Chat qualified as Chat
import Example.Colors
import Example.Contact qualified as Contact
import Example.Contacts qualified as Contacts
import Example.Counter qualified as Counter
import Example.DataLists.Autocomplete qualified as Autocomplete
import Example.DataLists.DataTable qualified as DataTable
import Example.DataLists.Filter qualified as Filter
import Example.DataLists.LoadMore qualified as LoadMore
import Example.Effects.Debug as Debug
import Example.Effects.Todos (Todos, runTodosSession)
import Example.Effects.Users as Users
import Example.Scrollbars qualified as Scrollbars
import Example.State.Effects qualified as Effects
import Example.State.Query qualified as Query
import Example.State.Sessions qualified as Sessions
import Example.State.ViewState qualified as ViewState
import Example.Style qualified as Style
import Example.Style.Cyber qualified as Cyber
import Example.Tags qualified as Tags
import Example.Test qualified as Test
import Example.Todos.Todo qualified as Todo
import Example.Todos.TodoCSS qualified as TodoCSS
import Example.View.Layout as Layout (layout)
import Foreign.Store (Store (..), lookupStore, readStore, storeAction, withStore)
import GHC.Generics (Generic)
import GHC.Word (Word32)
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Client.TLS qualified as HTTPS
import Network.HTTP.Types (Header, Method, QueryItem, hCacheControl, methodPost, status200, status404)
import Network.Wai qualified as Wai
import Network.Wai.Handler.Warp qualified as Warp
import Network.Wai.Middleware.Static as Static (CacheContainer, CachingStrategy (..), Options (..), addBase)
import Network.Wai.Middleware.Static qualified as Static
import Network.WebSockets (Connection, PendingConnection, acceptRequest, defaultConnectionOptions)
import Paths_demo (version)
import Paths_demo qualified as Pt
import Safe (readMay)
import System.Environment qualified as SE
import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)
import Web.Atomic.CSS
import Web.Hyperbole
import Web.Hyperbole.Application
import Web.Hyperbole.Effect.GenRandom
import Web.Hyperbole.Effect.OAuth2 (OAuth2, runOAuth2)
import Web.Hyperbole.Effect.OAuth2 qualified as OAuth2
import Web.Hyperbole.Server.Options (defaultError)
import Web.Hyperbole.Types.Response
run :: IO ()
run = do
hSetBuffering stdout LineBuffering
port <- do
mStr <- SE.lookupEnv "PORT"
pure $ fromMaybe 3000 (readMay =<< mStr)
putStrLn $ "Starting Examples on http://localhost:" <> show port
users <- Users.initUsers
(count, room, config) <- runEff $ runEnvironment $ do
c <- runConcurrent Effects.initCounter
room <- runConcurrent Chat.initChatRoom
a <- getAppConfigEnv
pure (c, room, a)
cache <- clientCache
Warp.run port $
Static.staticPolicyWithOptions cache (addBase "client/dist") $
Static.staticPolicy (addBase "demo/static") $ do
devReload config $ exampleApp config users count room
where
devReload :: AppConfig -> Application -> Application
devReload config
| config.devMode = Wai.modifyResponse $ Wai.mapResponseHeaders $ \hs -> ("Connection", "Close") : hs
| otherwise = id
exampleApp :: AppConfig -> UserStore -> TVar Int -> Chat.Room -> Application
exampleApp config users count chats = do
liveAppWith
(ServerOptions (document documentHead) serverError)
(runApp . routeRequest $ router)
where
runApp :: (Hyperbole :> es, IOE :> es) => Eff (OAuth2 : GenRandom : Concurrent : Debug : Users : Todos : Reader AppConfig : es) a -> Eff es a
runApp = runReader config . runTodosSession . runUsersIO users . runDebugIO . runConcurrent . runRandom . runOAuth2 config.oauth config.manager
router :: forall es. (Hyperbole :> es, OAuth2 :> es, Todos :> es, Users :> es, Debug :> es, Concurrent :> es, IOE :> es, GenRandom :> es, Reader AppConfig :> es) => AppRoute -> Eff es Response
router Counter = runPage Counter.page
router (Hello h) = runPage $ hello h
router (Contacts (Contact uid)) = Contact.response uid
router (Contacts ContactsAll) = runPage Contacts.page
router Concurrency = runPage Concurrency.page
router (Data r) =
case r of
DataLists -> redirect $ routeUri (Data SortableTable)
SortableTable -> runPage DataTable.page
Autocomplete -> runPage Autocomplete.page
Filter -> runPage Filter.page
LoadMore -> runPage LoadMore.page
router Errors = redirect (routeUri HyperboleEffect)
router (Forms _) = runPage Forms.page
router HyperboleEffect = runPage Hyp.page
router Hyperviews = runPage Hyperviews.page
router Route.Response = redirect (routeUri HyperboleEffect)
router State = runReader count $ runPage State.page
router SideEffects = runReader @Text "Secret Message!" $ runPage SideEffects.page
router Intro = runPage Intro.page
router Basics = runPage Basics.page
router Application = runPage Application.page
router ViewFunctions = runPage ViewFunctions.page
-- router (Intro HyperViews) = runPage IntroHyperViews.page
-- router (Intro Pages) = runPage IntroPages.page
-- router (Intro ViewFunctions) = runPage IntroViewFunctions.page
router CSS = runPage CSS.page
router Interactivity = runPage Interactivity.page
router (Examples Chat) = runReader chats $ runPage Chat.page
router (Examples OtherExamples) = runPage Examples.page
router (Examples Todos) = runPage Todo.page
router (Examples Tags) = runPage Tags.page
router (Examples TodosCSS) = runPage TodoCSS.page
router Javascript = redirect (routeUri Interactivity)
router (Examples OAuth2) = runPage OAuth2.page
router (Examples OAuth2Authenticate) = OAuth2.handleRedirect
router (Examples Scrollbars) = runPage Scrollbars.page
router Simple = redirect (routeUri Intro)
-- router Counter = redirect (routeUri $ State StateRoot)
router (Test TestMain) = runPage Test.page
router (Test TestState) = runPage ViewState.page
router Main = do
redirect (routeUri Intro)
-- Nested Router
hello :: (Hyperbole :> es, Debug :> es) => Hello -> Page es '[]
hello RedirectNow = do
redirect (routeUri $ Hello Redirected)
hello (Greet who) = do
pure $ layout (Hello $ Greet who) $ do
row ~ gap 6 . pad 10 $ do
el "Hello:"
el $ text who
hello Redirected = do
pure $ layout HyperboleEffect $ do
col ~ pad 10 . gap 10 $ do
el "You were redirected"
route HyperboleEffect ~ Style.link $ "Go Back"
-- Use the embedded version for real applications (see quickStartDocument).
-- The link to /hyperbole.js here is just to make local development easier
documentHead :: View DocumentHead ()
documentHead = do
title "Hyperbole Examples"
mobileFriendly
stylesheet "/cyber.css"
script "/hyperbole.js"
stylesheet "/prism.css"
script "/prism.js" @ att "defer" ""
script "/docs.js" @ att "defer" ""
style "html { scroll-behavior: smooth; }\n body { background-color: #e0e7f1; font-family: font-family: -apple-system, BlinkMacSystemFont, \"Segoe UI\", \"Noto Sans\", Helvetica, Arial, sans-serif, \"Apple Color Emoji\", \"Segoe UI Emoji\") }, button { font-family: 'Share Tech Mono'}"
style cssEmbed
when config.devMode $ do
script' scriptLiveReload
serverError :: ResponseError -> ServerError
-- serverError NotFound = ServerError "NotFound" $ Cyber.cyberError "Custom Not Found!"
serverError (ErrCustom s) = s
serverError err =
let msg = defaultErrorMessage err
in ServerError
{ message = msg
, body = Cyber.cyberError $ Cyber.glitch msg
}
{- | Made for local development
-
- ghcid --setup=Main.update --command="cabal repl exe:examples lib:hyperbole test" --run=Main.update --warnings
-
- Start or restart the server.
newStore is from foreign-store.
A Store holds onto some data across ghci reloads
-}
update :: IO ()
update = do
mtidStore <- lookupStore tidStoreNum
case mtidStore of
-- no server running
Nothing -> do
done <- storeAction doneStore newEmptyMVar
tid <- start done
_ <- storeAction (Store tidStoreNum) (newIORef tid)
return ()
-- server is already running
Just tidStore -> do
restartAppInNewThread tidStore
where
-- callCommand "xmonadctl refreshFirefox"
doneStore :: Store (MVar ())
doneStore = Store 0
-- shut the server down with killThread and wait for the done signal
restartAppInNewThread :: Store (IORef ThreadId) -> IO ()
restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do
killThread tid
withStore doneStore takeMVar
readStore doneStore >>= start
-- \| Start the server in a separate thread.
start
:: MVar ()
-- \^ Written to when the thread is killed.
-> IO ThreadId
start done = do
forkFinally
App.run
-- Note that this implies concurrency
-- between shutdownApp and the next app that is starting.
-- Normally this should be fine
(\_ -> putMVar done ())
tidStoreNum :: Word32
tidStoreNum = 1
modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
modifyStoredIORef store f = withStore store $ \ref -> do
v <- readIORef ref
f v >>= writeIORef ref
cacheMiddleware :: Application -> Application
cacheMiddleware = Wai.modifyResponse addCache
where
addCache = Wai.mapResponseHeaders ((hCacheControl, "private, max-age=60") :)
================================================
FILE: demo/Example/CSS/External.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
module Example.CSS.External where
import Data.Text (Text)
import App.Docs
import Web.Hyperbole
source :: ModuleSource
source = $(moduleSource)
main :: IO ()
main = do
run 3000 $ do
liveApp quickStartDocument (runPage page)
page :: (Hyperbole :> es) => Page es '[Items]
page = do
pure $ do
-- you can choose to include a stylesheet only on pages
-- that use it or load it globally in your document function
stylesheet "external.css"
hyper Items $ itemsView "one"
data Items = Items
deriving (Generic, ViewId)
instance HyperView Items es where
data Action Items = Select Text
deriving (Generic, ViewAction)
update (Select t) = do
pure $ itemsView t
itemsView :: Text -> View Items ()
itemsView sel = do
el @ class_ "parent" $ do
item "one"
item "two"
item "three"
item "four"
item "five"
where
selected i =
if sel == i
then class_ "selected"
else id
item i =
-- the class_ attribute MERGES classes if you set it more than once
button (Select i) @ class_ "item" . selected i $ text i
================================================
FILE: demo/Example/CSS/Loading.hs
================================================
{-# LANGUAGE UndecidableInstances #-}
module Example.CSS.Loading where
import Data.Text (Text)
import Example.Effects.Debug
import Example.Style.Cyber (btn)
import Web.Atomic.CSS
import Web.Hyperbole
data Loader = Loader
deriving (Generic, ViewId)
instance (Debug :> es) => HyperView Loader es where
data Action Loader
= LoadSlow
deriving (Generic, ViewAction)
update LoadSlow = do
delay 1000
pure $ viewLoaders "OK!"
viewLoaders :: Text -> View Loader ()
viewLoaders status = do
col ~ gap 10 $ do
row ~ gap 10 . whenLoading flexRow . display None $ do
loadingBars
el "Loading..."
el ~ whenLoading (display None) $ text status
button LoadSlow ~ btn . whenLoading (opacity 0.5) $ "Load Slow"
loadingBars :: View c ()
loadingBars = el ~ cls "loader" $ none
================================================
FILE: demo/Example/CSS/Tooltips.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
module Example.CSS.Tooltips where
import App.Docs
import Example.Colors
import Web.Atomic.CSS
import Web.Hyperbole
source :: ModuleSource
source = $(moduleSource)
tooltips :: View c ()
tooltips = do
col ~ pad 10 . gap 10 . width 300 $ do
mapM_ viewItemRow ["One", "Two", "Three", "Four", "Five", "Six"]
where
viewItemRow item = do
col ~ stack . showTooltips . hover (color Primary) . pointer $ do
el ~ border 1 . bg White . pad 5 $ text item
el ~ cls "tooltip" . popup (TR 10 10) . zIndex 1 . visibility Hidden $ do
col ~ border 2 . gap 5 . bg White . pad 5 $ do
el ~ bold $ "DETAILS"
el $ text item
el "details about this item"
showTooltips =
css
"tooltips"
".tooltips:hover > .tooltip"
(declarations (visibility Visible))
================================================
FILE: demo/Example/CSS/Transitions.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
module Example.CSS.Transitions where
import App.Docs
import Example.Style.Cyber (btn)
import Web.Atomic.CSS
import Web.Hyperbole
source :: ModuleSource
source = $(moduleSource)
data Animate = Animate
deriving (Generic, ViewId)
instance HyperView Animate es where
data Action Animate
= Expand
| Collapse
deriving (Generic, ViewAction)
update Expand = do
pure viewBig
update Collapse = do
pure viewSmall
viewSmall :: View Animate ()
viewSmall = do
col ~ gap 10 . transition 300 (Width 200) $ do
el "Small"
button Expand "Expand" ~ btn
viewBig :: View Animate ()
viewBig =
col ~ gap 10 . transition 300 (Width 400) $ do
el "Expanded"
button Collapse "Collapse" ~ btn
================================================
FILE: demo/Example/Chat.hs
================================================
{-# LANGUAGE UndecidableInstances #-}
module Example.Chat where
import App.Route
import Control.Monad (forM_, forever)
import Data.Text (Text)
import Effectful
import Effectful.Concurrent
import Effectful.Concurrent.STM
import Effectful.Reader.Dynamic
import Effectful.State.Dynamic (modify)
import Example.Colors
import Example.Style qualified as Style
import Example.Style.Cyber (embed)
import Example.Style.Cyber as Cyber (btn, font)
import Example.View.Layout (layout)
import Web.Atomic.CSS
import Web.Hyperbole
import Web.Hyperbole.Data.Encoded (Encoded (..), FromEncoded (..), ToEncoded (..))
page :: (Hyperbole :> es, Concurrent :> es, Reader Room :> es) => Page es '[Content, Chats, NewMessage]
page = do
pure $ layout (Examples Chat) $ do
el "Demonstrates server pushes and concurrency. Open in two tabs with different usernames to test."
col ~ embed . Cyber.font $ do
hyper Content $ contentView Nothing
type Username = Text
data Content = Content
deriving (Generic, ViewId)
instance HyperView Content es where
data Action Content = Login | Logout
deriving (Generic, ViewAction)
type Require Content = '[Chats, NewMessage]
update Login = do
LoginForm u <- formData
pure $ contentView (Just u)
update Logout =
pure $ contentView Nothing
data LoginForm = LoginForm
{ username :: Text
}
deriving (Generic, FromForm)
contentView :: Maybe Username -> View Content ()
contentView mu = do
case mu of
Nothing -> do
form Login ~ flexRow . gap 10 $ do
field "username" $ do
input Username @ placeholder "Username" . autofocus ~ Style.input
submit "Login" ~ btn
Just u -> do
col ~ gap 10 $ do
row ~ gap 10 $ do
el "Welcome "
el ~ bold $ text u
space
button Logout ~ btn $ "logout"
hyperState Chats mempty $ chatsLoad u
hyper (NewMessage u) messageView
-- Chat Room -------------------------------------
data Message = Message
{ sender :: Username
, body :: Text
}
deriving (Generic, ToParam, FromParam)
newtype Room = Room (TChan Message)
newtype Subscription = Subscription (TChan Message)
initChatRoom :: (Concurrent :> es) => Eff es Room
initChatRoom = Room <$> newBroadcastTChanIO
subscribeChatRoom :: (Concurrent :> es) => Room -> Eff es Subscription
subscribeChatRoom (Room chan) = fmap Subscription <$> atomically $ dupTChan chan
waitMessage :: (Concurrent :> es) => Subscription -> Eff es Message
waitMessage (Subscription chan) = atomically $ readTChan chan
sendMessage :: (Concurrent :> es) => Room -> Message -> Eff es ()
sendMessage (Room chan) msg = atomically $ writeTChan chan msg
-- Encoding for message history since starting
newtype AllMessages = AllMessages [Message]
deriving newtype (Semigroup, Monoid)
instance ToEncoded AllMessages where
toEncoded (AllMessages ms) = Encoded "" (fmap toParam ms)
instance FromEncoded AllMessages where
parseEncoded (Encoded _ ps) =
AllMessages <$> mapM parseParam ps
--- Chat Updates ---------------------------------------------
data Chats = Chats
deriving (Generic)
instance ViewId Chats where
type ViewState Chats = AllMessages
instance (Concurrent :> es, Reader Room :> es, IOE :> es) => HyperView Chats es where
data Action Chats = Stream Username
deriving (Generic, ViewAction)
update (Stream u) = do
room <- ask
sub <- subscribeChatRoom room
sendMessage room $ Message u "I have arrived!"
forever (streamChats sub)
where
streamChats room = do
-- Block until we receive a message from the duplicated channel
msg <- waitMessage room
-- store all the messages we've seen in our view state
modify $ addMessage msg
-- update the view
pushUpdate $ chatsView u
addMessage :: Message -> AllMessages -> AllMessages
addMessage msg (AllMessages ms) = AllMessages $ msg : ms
allMessages :: View Chats AllMessages
allMessages = do
AllMessages ms <- viewState
pure $ AllMessages $ reverse ms
chatsLoad :: Username -> View Chats ()
chatsLoad user = el @ onLoad (Stream user) 100 $ "..."
chatsView :: Username -> View Chats ()
chatsView _user = do
AllMessages chats <- allMessages
col ~ gap 5 . pad 5 . minHeight 400 . border 1 . bg GrayLight $ do
forM_ chats $ \chat -> do
el $ do
text chat.sender
text ": "
text chat.body
--- New Message Form ------------------------------
data NewMessage = NewMessage Username
deriving (Generic, ViewId)
instance (Concurrent :> es, Reader Room :> es, IOE :> es) => HyperView NewMessage es where
data Action NewMessage = SendMessage
deriving (Generic, ViewAction)
update SendMessage = do
room <- ask
NewMessage user <- viewId
MessageForm msg <- formData
sendMessage room $ Message user msg
-- NOTE: this doesn't show an update at all, but we are subscribed to the channel and will get a push like everyone else
pure messageView
data MessageForm = MessageForm
{ message :: Text
}
deriving (Generic, FromForm)
messageView :: View NewMessage ()
messageView = do
form SendMessage ~ flexRow . gap 10 $ do
field "message" $ do
input TextInput @ placeholder "type your message here" . value "" . autofocus ~ Style.input . grow
submit "Send" ~ btn
================================================
FILE: demo/Example/Colors.hs
================================================
{-# LANGUAGE LambdaCase #-}
module Example.Colors where
import Web.Atomic.CSS
import Web.Hyperbole
data AppColor
= White
| Light
| GrayLight
| GrayDark
| Dark
| DarkHighlight
| Success
| Danger
| Warning
| Primary
| PrimaryLight
| Secondary
| SecondaryLight
deriving (Show, Read, Eq, Generic, ToJSON, FromJSON, ToParam, FromParam)
instance Default AppColor where
def = White
instance ToColor AppColor where
colorValue White = "#FFF"
colorValue Light = "#F2F2F3"
colorValue GrayLight = "#E3E5E9"
colorValue GrayDark = "#2С3С44"
-- colorValue Dark = "#2E3842" -- "#232C41"
colorValue Dark = "#121726" -- "#232C41"
colorValue DarkHighlight = "#343945" -- "#232C41"
colorValue Primary = "#4171b7"
colorValue PrimaryLight = "#6D9BD3"
-- colorValue PrimaryLight = "#e2ebf6"
colorValue Secondary = "#5D5A5C"
colorValue SecondaryLight = "#9D999C"
-- colorValue Success = "67C837"
colorValue Success = "#149e5a"
colorValue Danger = midRed
colorValue Warning = "#e1c915"
lightRed :: HexColor
lightRed = HexColor "#EC6458"
midRed :: HexColor
midRed = HexColor "#A03F38"
darkRed :: HexColor
darkRed = HexColor "#722C2A"
cyan :: HexColor
cyan = "#0FF"
magenta :: HexColor
magenta = "#E44072"
light :: AppColor -> HexColor
light PrimaryLight = "#a8c3e5"
light Primary = colorValue PrimaryLight
-- light Danger = "#ef8379"
light Danger = lightRed
light c = colorValue c
hoverColor :: AppColor -> HexColor
hoverColor = \case
White -> colorValue Light
c -> light c
contrastColor :: AppColor -> HexColor
contrastColor = \case
Primary -> colorValue White
PrimaryLight -> colorValue White
Danger -> colorValue White
_ -> colorValue Dark
================================================
FILE: demo/Example/Concurrency/LazyLoading.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Example.Concurrency.LazyLoading where
import App.Docs
import Effectful
import Example.Colors
import Example.Concurrency.Tasks
import Example.Effects.Debug
import Web.Atomic.CSS
import Web.Hyperbole
import Web.Hyperbole.Effect.GenRandom
-----------------------------------------------------------
-- Lazy Loading Expensive Data
-----------------------------------------------------------
data LazyData = LazyData TaskId
deriving (Generic, ViewId)
instance (Debug :> es, GenRandom :> es) => HyperView LazyData es where
data Action LazyData
= Details
deriving (Generic, ViewAction)
update Details = do
LazyData taskId <- viewId
task <- pretendLoadTask taskId
pure $ viewTaskDetails task
viewTaskLoad :: View LazyData ()
viewTaskLoad = do
-- 100ms after rendering, get the details
el @ onLoad Details 100 ~ bg GrayLight . textAlign AlignCenter $ do
text "..."
viewTaskDetails :: Task -> View LazyData ()
viewTaskDetails task = do
el ~ color Success . textAlign AlignCenter $ do
text task.details
source :: ModuleSource
source = $(moduleSource)
================================================
FILE: demo/Example/Concurrency/Overlap.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Example.Concurrency.Overlap where
import App.Docs
import Data.Text (Text, pack)
import Effectful
import Example.Effects.Debug
import Example.Style.Cyber (btn)
import Example.View.Loader as Loader
import Web.Atomic.CSS
import Web.Hyperbole
-- Concurrency = Drop ---------------------------
data OverlapDrop = OverlapDrop
deriving (Generic, ViewId)
instance (Debug :> es) => HyperView OverlapDrop es where
data Action OverlapDrop
= GetTimeDrop
deriving (Generic, ViewAction)
-- this is the default, not necessary to specify
-- type Concurrency OverlapDrop = Drop
update GetTimeDrop = do
t <- getTimeSlowly
pure $ viewTimeDrop (Just t)
viewTimeDrop :: Maybe UTCTime -> View OverlapDrop ()
viewTimeDrop = viewTime GetTimeDrop "Drop"
-- Concurrency = Replace --------------------------
data OverlapReplace = OverlapReplace
deriving (Generic, ViewId)
instance (Debug :> es) => HyperView OverlapReplace es where
data Action OverlapReplace
= GetTimeReplace
deriving (Generic, ViewAction)
type Concurrency OverlapReplace = Replace
update GetTimeReplace = do
t <- getTimeSlowly
pure $ viewTimeReplace (Just t)
viewTimeReplace :: Maybe UTCTime -> View OverlapReplace ()
viewTimeReplace = viewTime GetTimeReplace "Replace"
-- Utilities -----------------------------------------------
getTimeSlowly :: (Debug :> es) => Eff es UTCTime
getTimeSlowly = do
delay 2000
systemTime
viewTime :: (ViewAction (Action id)) => Action id -> Text -> Maybe UTCTime -> View id ()
viewTime runTime loadLbl mtime = do
row ~ gap 10 $ do
button runTime ~ btn $ text loadLbl
Loader.loading
case mtime of
Nothing -> none
Just t -> el ~ whenLoading (display None) $ text $ pack $ show t
source :: ModuleSource
source = $(moduleSource)
================================================
FILE: demo/Example/Concurrency/Polling.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Example.Concurrency.Polling where
import App.Docs
import Data.Text (pack)
import Effectful
import Example.Effects.Debug
import Example.Style.Cyber (btn)
import Web.Atomic.CSS
import Web.Hyperbole
-----------------------------------------------------------
-- Simple Polling
-----------------------------------------------------------
data Poller = Poller
deriving (Generic, ViewId)
instance (Debug :> es) => HyperView Poller es where
data Action Poller
= Reload Int
| Stop
| Pause Int
deriving (Generic, ViewAction)
-- to stop, return a view without an onLoad
update (Pause n) = do
pure $ viewPaused n
update Stop = do
pure viewStopped
update (Reload n) = do
pure $ viewPoll n
viewInit :: View Poller ()
viewInit = do
row $ do
button (Reload 1) "Start Polling" ~ btn
viewStopped :: View Poller ()
viewStopped = do
row $ do
button (Reload 1) "Restart Polling" ~ btn
viewPaused :: Int -> View Poller ()
viewPaused n = do
col ~ gap 10 $ do
row $ do
button (Reload n) "Resume" ~ btn
viewStatus n
viewPoll :: Int -> View Poller ()
viewPoll n = do
-- reload every 200ms + round trip delay
col @ onLoad (Reload (n + 1)) 250 ~ gap 10 $ do
row ~ gap 5 $ do
button (Pause n) "Pause" ~ btn
button Stop "Stop" ~ btn
viewStatus n
viewStatus :: Int -> View Poller ()
viewStatus n = do
el $ do
text "Polling... "
text $ pack $ show n
source :: ModuleSource
source = $(moduleSource)
================================================
FILE: demo/Example/Concurrency/Progress.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Example.Concurrency.Progress where
import App.Docs
import Control.Monad (when)
import Data.Text (pack)
import Effectful
import Example.Colors
import Example.Concurrency.Tasks
import Example.Effects.Debug
import Example.View.Inputs (progressBar)
import Web.Atomic.CSS
import Web.Hyperbole
import Web.Hyperbole.Effect.GenRandom
-----------------------------------------------------------
-- Overlapping Progress Bars
-----------------------------------------------------------
type PercentPerTick = Int
data Progress = Progress TaskId
deriving (Generic, ViewId)
instance (Debug :> es, GenRandom :> es) => HyperView Progress es where
data Action Progress
= GoProgress PercentPerTick
deriving (Generic, ViewAction)
update (GoProgress progPerTick) = do
_ <- tick 0
pure $ viewProgress 100
where
tick current = do
-- pretend we did some work
-- this will not block other hyperviews from updating
delay 50
let total = current + progPerTick
when (total < 100) $ do
pushUpdate $ viewProgress total
tick total
viewProgressLoad :: PercentPerTick -> View Progress ()
viewProgressLoad p = el @ onLoad (GoProgress p) 50 $ none
viewProgress :: Int -> View Progress ()
viewProgress prg
| prg >= 100 = viewComplete
| otherwise = viewUpdating
where
viewComplete = do
row ~ bg Success . color White . pad 5 $ "Complete"
viewUpdating = do
let pct = fromIntegral prg / 100
Progress taskId <- viewId
progressBar pct $ do
el ~ grow $ text $ "Task" <> pack (show taskId)
source :: ModuleSource
source = $(moduleSource)
================================================
FILE: demo/Example/Concurrency/Tasks.hs
================================================
module Example.Concurrency.Tasks where
import Data.Text (Text, pack)
import Effectful
import Example.Effects.Debug
import Web.Hyperbole.Effect.GenRandom
-- Fake Tasks Effect ----------------------------------------
type TaskId = Int
data Task = Task
{ taskId :: TaskId
, details :: Text
}
pretendLoadTask :: (Debug :> es, GenRandom :> es) => TaskId -> Eff es Task
pretendLoadTask taskId = do
randomDelay <- genRandom (100, 1000)
delay randomDelay
pure $ Task taskId $ pack (show taskId)
pretendTasks :: [TaskId]
pretendTasks = [1 .. 30]
================================================
FILE: demo/Example/Contact.hs
================================================
{-# LANGUAGE UndecidableInstances #-}
module Example.Contact where
import App.Route (UserId)
import App.Route qualified as Route
import Data.Maybe (fromMaybe)
import Data.String.Conversions
import Data.Text (Text, pack)
import App.Docs
import Effectful
import Effectful.Reader.Dynamic
import Example.Colors
import Example.Effects.Debug
import Example.Effects.Users (User (..), Users)
import Example.Effects.Users qualified as Users
import Example.Style qualified as Style
import Example.Style.Cyber (btn)
import Example.View.Layout
import Web.Atomic.CSS
import Web.Hyperbole
-- Example adding a reader context to the page, based on an argument from the AppRoute
response :: (Hyperbole :> es, Users :> es, Debug :> es) => UserId -> Eff es Response
response uid = runReader uid $ runPage page
-- The page assumes all effects have been added
page
:: forall es
. (Hyperbole :> es, Users :> es, Debug :> es, Reader UserId :> es)
=> Page es '[Contact]
page = do
uid <- ask
u <- Users.find uid
pure $ layout (Route.Contacts Route.ContactsAll) $ do
section' "Contact" $ do
hyper (Contact uid) $ contactView u
-- Contact ----------------------------------------------------
data Contact = Contact UserId
deriving (Generic, ViewId)
instance (Users :> es, Debug :> es) => HyperView Contact es where
data Action Contact
= Edit
| Save
| ViewContact
deriving (Generic, ViewAction)
update action = do
-- No matter which action we are performing, let's look up the user to make sure it exists
Contact uid <- viewId
u <- Users.find uid
case action of
ViewContact -> do
pure $ contactView u
Edit -> do
pure $ contactEditView u
Save -> do
delay 1000
unew <- parseUser uid
Users.save unew
pure $ contactView unew
data ContactForm f = ContactForm
{ firstName :: Field f Text
, lastName :: Field f Text
, age :: Field f Int
, info :: Field f Text
}
deriving (Generic, FromFormF, GenFields FieldName, GenFields Maybe)
parseUser :: (Hyperbole :> es) => Int -> Eff es User
parseUser uid = do
ContactForm{firstName, lastName, age, info} <- formData @(ContactForm Identity)
pure User{id = uid, isActive = True, firstName, lastName, age, info}
contactView :: User -> View Contact ()
contactView = contactView' Edit
contactView' :: (ViewId c, ViewAction (Action c)) => Action c -> User -> View c ()
contactView' edit u = do
col ~ gap 10 $ do
row ~ fld $ do
el (text "First Name:")
text u.firstName
row ~ fld $ do
el (text "Last Name:")
text u.lastName
row ~ fld $ do
el (text "Age:")
text (cs $ show u.age)
row ~ fld $ do
el (text "Info:")
text u.info
row ~ fld $ do
el (text "Active:")
text (cs $ show u.isActive)
button edit "Edit" ~ btn
where
fld = gap 10
contactEditView :: User -> View Contact ()
contactEditView u = do
el contactLoading ~ display None . whenLoading flexCol
el (contactEdit ViewContact Save u) ~ whenLoading (display None)
contactEdit :: (ViewId c, ViewAction (Action c)) => Action c -> Action c -> User -> View c ()
contactEdit onView onSave u = do
col ~ gap 10 $ do
contactForm onSave contactFromUser
button onView (text "Cancel") ~ Style.btnLight
where
contactFromUser :: ContactForm Maybe
contactFromUser =
ContactForm
{ firstName = Just u.firstName
, lastName = Just u.lastName
, age = Just u.age
, info = Just u.info
}
contactForm :: (ViewId id, ViewAction (Action id)) => Action id -> ContactForm Maybe -> View id ()
contactForm onSubmit c = do
let f = fieldNames @ContactForm
form onSubmit ~ gap 10 $ do
field f.firstName ~ fld $ do
label $ do
text "First Name:"
input Name @ value (fromMaybe "" c.firstName) ~ Style.input
field f.lastName ~ fld $ do
label $ do
text "Last Name:"
input Name @ value (fromMaybe "" c.lastName) ~ Style.input
field f.info ~ fld $ do
label $ do
text "Info:"
textarea c.info @ value (fromMaybe "" c.info) ~ Style.input
field f.age ~ fld $ do
label $ do
text "Age:"
input Number @ value (maybe "" (pack . show) c.age) ~ inp
submit "Submit" ~ btn
where
fld :: (Styleable a) => CSS a -> CSS a
fld = flexRow . gap 10
inp = Style.input
contactLoading :: View id ()
contactLoading = el ~ (bg Warning . pad 10) $ "Loading..."
================================================
FILE: demo/Example/Contacts.hs
================================================
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Example.Contacts where
import App.Docs
import App.Route (UserId)
import App.Route qualified as Route
import Control.Monad (forM_)
import Effectful
import Example.Colors
import Example.Contact (ContactForm, contactForm, contactLoading, contactView', parseUser)
import Example.Contact qualified as Contact
import Example.Effects.Debug
import Example.Effects.Users (User (..), Users)
import Example.Effects.Users qualified as Users
import Example.Style qualified as Style
import Example.Style.Cyber (btn, btn', btnLight)
import Example.View.Layout
import Web.Atomic.CSS
import Web.Hyperbole
page
:: forall es
. (Hyperbole :> es, Users :> es, Debug :> es)
=> Page es '[Contacts, InlineContact, NewContact]
page = do
us <- Users.all
pure $ layout (Route.Contacts Route.ContactsAll) $ do
example $(moduleSource) $ do
hyper Contacts $ allContactsView Nothing us
-- Contacts ----------------------------------------------
data Contacts = Contacts
deriving (Generic, ViewId)
data Filter
= Active
| Inactive
deriving (Eq, Show, Read, Generic, ToJSON, FromJSON, ToParam, FromParam)
instance (Users :> es, Debug :> es) => HyperView Contacts es where
data Action Contacts
= Reload (Maybe Filter)
| AddUser
| DeleteUser UserId
deriving (Generic, ViewAction)
type Require Contacts = '[InlineContact, NewContact]
update = \case
Reload mf -> do
us <- Users.all
pure $ allContactsView mf us
AddUser -> do
uid <- Users.nextId
u <- parseUser uid
Users.save u
us <- Users.all
pure $ allContactsView Nothing us
DeleteUser uid -> do
Users.delete uid
us <- Users.all
pure $ allContactsView Nothing us
-- TODO: get the form to close when submitted
allContactsView :: Maybe Filter -> [User] -> View Contacts ()
allContactsView fil us = col ~ gap 20 $ do
row ~ gap 10 $ do
el ~ pad 10 $ "Filter: "
dropdown Reload fil $ do
option Nothing ""
option (Just Active) "Active!"
option (Just Inactive) "Inactive"
row ~ gap 10 $ do
let filtered = filter (filterUsers fil) us
forM_ filtered $ \u -> do
el ~ border 1 . pad 10 $ do
hyper (InlineContact u.id) $ contactView u
row $ do
space
route (Route.Contacts $ Route.Contact u.id) "details" ~ Style.link
row ~ gap 10 $ do
button (Reload Nothing) ~ Style.btnLight $ "Reload"
target (InlineContact 2) () $ button Edit ~ Style.btnLight $ "Edit Sara"
hyper NewContact newContactButton
where
filterUsers Nothing _ = True
filterUsers (Just Active) u = u.isActive
filterUsers (Just Inactive) u = not u.isActive
-- New Contact Form / Button ----------------------------------
-- Note that it is easier to nest hyperviews here because NewContact has sufficiently different state
-- * It doesn't need to know the users
-- * It DOES need to track it's open / close state
-- * We use target to submit the form to the Contacts parent view
data NewContact = NewContact
deriving (Generic, ViewId)
instance (Users :> es) => HyperView NewContact es where
data Action NewContact
= ShowForm
| CloseForm
deriving (Generic, ViewAction)
type Require NewContact = '[Contacts]
update action =
case action of
ShowForm -> pure newContactForm
CloseForm -> pure newContactButton
newContactButton :: View NewContact ()
newContactButton = do
button ShowForm ~ btn $ "Add Contact"
newContactForm :: View NewContact ()
newContactForm = do
row ~ pad 10 . gap 10 . border 1 $ do
target Contacts () $ do
contactForm AddUser (genFields :: ContactForm Maybe)
col $ do
space
button CloseForm ~ btnLight $ "Cancel"
-- Reuse Contact View ----------------------------------
-- We want to use the same view as Example.Contact, but customize the edit view to have a delete button
-- Note that we re-implement the actions and the handler
-- Just create functions to deduplicate code and use them here
data InlineContact = InlineContact UserId
deriving (Generic, ViewId)
instance (Users :> es, Debug :> es) => HyperView InlineContact es where
data Action InlineContact
= Edit
| ViewContact
| Save
deriving (Generic, ViewAction)
type Require InlineContact = '[Contacts]
update a = do
InlineContact uid <- viewId
u <- Users.find uid
case a of
ViewContact ->
pure $ contactView u
Edit ->
pure $ contactEdit u
Save -> do
delay 1000
unew <- parseUser uid
Users.save unew
pure $ contactView unew
-- See how we reuse the contactView' from Example.Contact
contactView :: User -> View InlineContact ()
contactView = contactView' Edit
-- See how we reuse the contactEdit' and contactLoading from Example.Contact
contactEdit :: User -> View InlineContact ()
contactEdit u = do
el ~ (display None . whenLoading flexCol) $ contactLoading
col ~ (whenLoading (display None) . gap 10) $ do
Contact.contactEdit ViewContact Save u
target Contacts () $ button (DeleteUser u.id) ~ btn' Danger . pad (XY 10 0) $ text "Delete"
================================================
FILE: demo/Example/Counter.hs
================================================
{-# LANGUAGE UndecidableInstances #-}
module Example.Counter where
import Data.Text (pack)
import Effectful
import Example.Style.Cyber as Style
import Web.Atomic.CSS
import Web.Hyperbole as Hyperbole
page :: (Hyperbole :> es) => Page es '[Counter]
page = do
pure $ hyper Counter (viewCount 0)
data Counter = Counter
deriving (Generic, ViewId)
instance HyperView Counter es where
data Action Counter
= Increment Int
| Decrement Int
deriving (Generic, ViewAction)
update (Increment n) = do
pure $ viewCount (n + 1)
update (Decrement n) = do
pure $ viewCount (n - 1)
viewCount :: Int -> View Counter ()
viewCount n = row $ do
col ~ gap 10 $ do
el ~ dataFeature $ text $ pack $ show n
row ~ gap 10 $ do
button (Decrement n) "Decrement" ~ Style.btn
button (Increment n) "Increment" ~ Style.btn
================================================
FILE: demo/Example/Data/ProgrammingLanguage.hs
================================================
{-# LANGUAGE DerivingVia #-}
module Example.Data.ProgrammingLanguage where
import Data.Text (Text, isInfixOf, toLower)
import Web.Hyperbole
data ProgrammingLanguage = ProgrammingLanguage
{ family :: LanguageFamily
, name :: Text
, features :: [TypeFeature]
, description :: Text
}
deriving (Generic, ToParam, FromParam)
instance Eq ProgrammingLanguage where
p1 == p2 = p1.name == p2.name
data LanguageFamily
= Functional
| ObjectOriented
deriving (Eq, Show, ToJSON, FromJSON, Ord, Generic, ToParam, FromParam)
data TypeFeature
= Dynamic
| Typed
| Generics
| TypeClasses
| TypeFamilies
deriving (Eq, Show, ToJSON, FromJSON, Generic, ToParam, FromParam)
isMatchLanguage :: Text -> ProgrammingLanguage -> Bool
isMatchLanguage term p =
isInfixOf (toLower term) . toLower $ p.name
allLanguages :: [ProgrammingLanguage]
allLanguages =
[ ProgrammingLanguage ObjectOriented "JavaScript" [Dynamic] "A versatile scripting language mainly used for web development."
, ProgrammingLanguage ObjectOriented "Java" [Typed] "A robust, platform-independent language commonly used for enterprise applications."
, ProgrammingLanguage ObjectOriented "TypeScript" [Typed, Generics] "A superset of JavaScript that adds static typing."
, ProgrammingLanguage ObjectOriented "Python" [Dynamic] "A beginner-friendly language with a wide range of applications, from web to data science."
, ProgrammingLanguage ObjectOriented "PHP" [Dynamic] "A server-side scripting language primarily used for web development."
, ProgrammingLanguage ObjectOriented "Go" [Typed, Generics] "A statically typed, compiled language designed for simplicity and efficiency."
, ProgrammingLanguage ObjectOriented "C++" [Typed] "A powerful language for system programming, game development, and high-performance applications."
, ProgrammingLanguage ObjectOriented "C#" [Typed, Generics] "A language developed by Microsoft, widely used for developing Windows and web applications."
, ProgrammingLanguage ObjectOriented "Objective-C" [Typed] "A language used primarily for macOS and iOS application development before Swift."
, ProgrammingLanguage ObjectOriented "Rust" [Typed, Generics, TypeClasses, TypeFamilies] "A memory-safe language focused on performance and reliability."
, ProgrammingLanguage ObjectOriented "Ruby" [Dynamic] "A dynamic language known for its simplicity and used in web frameworks like Ruby on Rails."
, ProgrammingLanguage ObjectOriented "Swift" [Typed, Generics] "A modern language for iOS and macOS application development."
, ProgrammingLanguage Functional "Haskell" [Typed, Generics, TypeClasses, TypeFamilies] "An elegant functional language for those with excellent taste."
, ProgrammingLanguage Functional "Elm" [Typed, Generics] "A functional language for building reliable web front-end applications."
, ProgrammingLanguage Functional "Scheme" [Dynamic] "A minimalist, functional dialect of Lisp."
]
================================================
FILE: demo/Example/DataLists/Autocomplete.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Example.DataLists.Autocomplete where
import App.Docs
import App.Route as Route
import Control.Monad (forM_)
import Data.Text (Text)
import Data.Text qualified as T
import Effectful
import Example.Colors
import Example.Data.ProgrammingLanguage (ProgrammingLanguage (..), allLanguages, isMatchLanguage)
import Example.DataLists.Filter as Filter (chosenView, clearButton, resultsTable)
import Example.View.Layout
import Safe (atMay)
import Web.Atomic.CSS
import Web.Hyperbole
import Prelude hiding (even, odd)
page :: (Hyperbole :> es) => Page es '[LiveSearch]
page = do
pure $ layout (Data Autocomplete) $ do
el "Create a serverside autocomplete with a combination of onInput and onKeyDown"
example $(moduleSource) $ do
hyper LiveSearch $ liveSearchView allLanguages 0 ""
data LiveSearch = LiveSearch
deriving (Generic, ViewId)
instance (IOE :> es) => HyperView LiveSearch es where
data Action LiveSearch
= SearchTerm Int Text
| Select (Maybe ProgrammingLanguage)
deriving (Generic, ViewAction)
-- favor the latest thing typed
type Concurrency LiveSearch = Replace
update (SearchTerm current term) = do
pure $ liveSearchView allLanguages current term
update (Select Nothing) = do
pure $ liveSearchView allLanguages 0 ""
update (Select (Just lang)) = do
pure $ selectedView lang
selectedView :: ProgrammingLanguage -> View LiveSearch ()
selectedView selected = do
col ~ gap 10 $ do
Filter.chosenView selected
liveSearchView :: [ProgrammingLanguage] -> Int -> Text -> View LiveSearch ()
liveSearchView langs current term = do
col ~ gap 10 $ do
el ~ stack $ do
search (SearchTerm current) 250 @ searchKeys . placeholder "search programming languages" . value term . autofocus ~ border 1 . pad 10 . grow
Filter.clearButton (SearchTerm current) term
col ~ popup (TRBL 50 0 0 0) . shownIfMatches $ do
searchPopup matchedLanguages currentSearchLang
Filter.resultsTable (Select . Just) langs
where
matchedLanguages = filter (isMatchLanguage term) langs
currentSearchLang = matchedLanguages `atMay` current
-- Only show the search popup if there is a search term and matchedLanguages
shownIfMatches =
if T.null term || null matchedLanguages then display None else flexCol
searchKeys =
onKeyDown Enter (Select currentSearchLang)
. onKeyDown ArrowDown (SearchTerm (current + 1) term)
. onKeyDown ArrowUp (SearchTerm (current - 1) term)
searchPopup :: [ProgrammingLanguage] -> Maybe ProgrammingLanguage -> View LiveSearch ()
searchPopup shownLangs highlighted = do
col ~ border 1 . bg White $ do
forM_ shownLangs $ \lang -> do
button (Select (Just lang)) ~ hover (bg Light) . selected lang . pad 5 $ do
text lang.name
where
selected l = if Just l == highlighted then bg Light else id
================================================
FILE: demo/Example/DataLists/DataTable.hs
================================================
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
module Example.DataLists.DataTable where
import App.Docs
import App.Route as Route
import Data.List (sortOn)
import Data.Text (pack)
import Effectful
import Example.Data.ProgrammingLanguage (ProgrammingLanguage (..), allLanguages)
import Example.View.Layout
import Example.View.SortableTable (dataTable, sortBtn, sortColumn)
import Web.Atomic.CSS
import Web.Hyperbole
import Prelude hiding (even, odd)
-- DataTable -> do
-- el "Complex reusable View Functions allow us to "
page :: (Hyperbole :> es) => Page es '[Languages]
page = do
pure $ layout (Data SortableTable) $ do
el "We can write view Functions that work in any view, like a dataTable"
example $(moduleSource) $ do
hyper Languages $ languagesView Nothing allLanguages
data Languages = Languages
deriving (Generic, ViewId)
data SortField
= SortName
| SortDescription
| SortFamily
deriving (Show, Read, Eq, Generic, ToJSON, FromJSON, ToParam, FromParam)
instance HyperView Languages es where
data Action Languages
= SortOn SortField
deriving (Generic, ViewAction)
update (SortOn fld) = do
let sorted = sortOnField fld allLanguages
pure $ languagesView (Just fld) sorted
sortOnField :: SortField -> [ProgrammingLanguage] -> [ProgrammingLanguage]
sortOnField = \case
SortName -> sortOn (.name)
SortDescription -> sortOn (.description)
SortFamily -> sortOn (.family)
languagesView :: Maybe SortField -> [ProgrammingLanguage] -> View Languages ()
languagesView fld langs =
table langs ~ dataTable $ do
sortColumn (sortBtn "Language" (SortOn SortName) (fld == Just SortName)) (.name)
sortColumn (sortBtn "Family" (SortOn SortFamily) (fld == Just SortFamily)) $ \d -> pack $ show d.family
sortColumn (sortBtn "Description" (SortOn SortDescription) (fld == Just SortDescription)) (.description)
================================================
FILE: demo/Example/DataLists/Filter.hs
================================================
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Example.DataLists.Filter where
import App.Docs
import App.Route as Route
import Data.Text (Text, pack)
import Effectful hiding (Dynamic)
import Example.Colors
import Example.Data.ProgrammingLanguage (LanguageFamily (..), ProgrammingLanguage (..), TypeFeature (..), allLanguages, isMatchLanguage)
import Example.View.Icon as Icon
import Example.View.Inputs (toggleCheckbox)
import Example.View.Layout
import Web.Atomic.CSS
import Web.Hyperbole
import Prelude hiding (even, odd)
page :: (Hyperbole :> es, IOE :> es) => Page es '[Languages]
page = do
filters <- query
pure $ layout (Data Filter) $ do
el "Incrementally search a list of data, storing parameters in the query string"
example $(moduleSource) $ do
hyper Languages $ languagesView filters
data Languages = Languages
deriving (Generic, ViewId)
-- Filters available from the query
-- See Example.Data.ProgrammingLanguage
data Filters = Filters
{ features :: [TypeFeature]
, family :: Maybe LanguageFamily
, term :: Text
}
deriving (Generic, Show, FromQuery, ToQuery)
instance (IOE :> es) => HyperView Languages es where
data Action Languages
= SearchTerm Text
| Select ProgrammingLanguage
| Feature TypeFeature Bool
| SetFamily (Maybe LanguageFamily)
deriving (Generic, ViewAction)
-- favor the latest thing entered / typed
type Concurrency Languages = Replace
update = \case
Select lang -> do
pure $ chosenView lang
SearchTerm term -> do
filters <- modFilters $ \f -> f{term}
pure $ languagesView filters
Feature feature selected -> do
filters <- modFilters $ \f -> setFeatures feature selected f
pure $ languagesView filters
SetFamily f -> do
filters <- modFilters $ \Filters{features, term} -> Filters{family = f, features, term}
pure $ languagesView filters
where
setFeatures feature selected Filters{term, family, features} =
let features' = if selected then addFeature feature features else delFeature feature features
in Filters{term, family, features = features'}
addFeature f fs
| f `elem` fs = fs
| otherwise = f : fs
delFeature feature =
filter (/= feature)
modFilters f = do
filts <- query
let filts' = f filts
setQuery filts'
pure filts'
-- apply our filters, return any languages that match
filterLanguages :: Filters -> [ProgrammingLanguage]
filterLanguages filts =
filter match allLanguages
where
match lang =
isMatchLanguage filts.term lang
&& matchFamily filts.family lang
&& matchFeatures filts.features lang
matchFamily Nothing _ = True
matchFamily (Just fam) lang = lang.family == fam
matchFeatures feats lang =
all (\f -> f `elem` lang.features) feats
languagesView :: Filters -> View Languages ()
languagesView filters = do
let matched = filterLanguages filters
col ~ gap 10 . grow $ do
filtersView filters
resultsTable Select matched
filtersView :: Filters -> View Languages ()
filtersView filters = do
el ~ stack . grow $ do
search SearchTerm 250 @ placeholder "filter programming languages" . value filters.term . autofocus ~ border 1 . pad 10
clearButton SearchTerm filters.term
row $ do
col ~ gap 5 $ do
el ~ bold $ "Language Family"
familyDropdown filters
space
col ~ gap 5 $ do
el ~ bold $ "Type System Features"
feature Dynamic
feature Typed
feature Generics
feature TypeClasses
feature TypeFamilies
where
feature f =
row ~ gap 10 $ do
toggleCheckbox (Feature f) (f `elem` filters.features)
el $ text (featureName f)
featureName f = pack $ show f
familyDropdown :: Filters -> View Languages ()
familyDropdown filters =
dropdown SetFamily filters.family ~ border 1 . pad 10 $ do
option Nothing "Any"
option (Just ObjectOriented) "Object Oriented"
option (Just Functional) "Functional"
clearButton :: (ViewAction (Action id)) => (Text -> Action id) -> Text -> View id ()
clearButton clear term =
el ~ popup (R 0) . pad 10 . showClearBtn $ do
button (clear "") ~ width 24 . hover (color PrimaryLight) $ Icon.xCircle
where
showClearBtn =
case term of
"" -> display None
_ -> id
chosenView :: ProgrammingLanguage -> View c ()
chosenView lang = do
row ~ gap 10 $ do
el "You chose:"
el $ text lang.name
el ~ (if lang.name == "Haskell" then id else display None) $ "You are as wise as you are attractive"
resultsTable :: (ViewAction (Action id)) => (ProgrammingLanguage -> Action id) -> [ProgrammingLanguage] -> View id ()
resultsTable onSelect langs = do
col ~ gap 15 $ do
mapM_ languageRow langs
where
languageRow lang = do
col ~ gap 5 $ do
row ~ gap 5 $ do
el ~ bold $ text lang.name
space
button (onSelect lang) ~ pad (XY 10 2) . border 1 . hover (bg GrayLight) . rows $ "Select"
row $ viewFamily lang.family
row ~ gap 5 $ do
el $ text lang.description
rows = textAlign AlignCenter . border 1 . borderColor GrayLight
viewFamily :: LanguageFamily -> View c ()
viewFamily fam = do
el ~ bg Light . pad (XY 10 2) . fontSize 16 . textA
gitextract_46835c3y/
├── .dockerignore
├── .github/
│ └── workflows/
│ ├── haskell.yaml
│ └── packcheck.yaml
├── .gitignore
├── .hlint.yaml
├── .packcheck.ignore
├── CHANGELOG.md
├── DOCTODO.md
├── Dockerfile
├── LICENSE
├── README.md
├── bin/
│ ├── dev
│ ├── docgen
│ └── release
├── cabal.project
├── client/
│ ├── declarations.d.ts
│ ├── dist/
│ │ ├── action.d.ts
│ │ ├── browser.d.ts
│ │ ├── events.d.ts
│ │ ├── http.d.ts
│ │ ├── hyperbole.js
│ │ ├── hyperview.d.ts
│ │ ├── index.d.ts
│ │ ├── lib.d.ts
│ │ ├── message.d.ts
│ │ ├── response.d.ts
│ │ └── sockets.d.ts
│ ├── package.json
│ ├── src/
│ │ ├── action.ts
│ │ ├── browser.ts
│ │ ├── events.ts
│ │ ├── http.ts
│ │ ├── hyperview.ts
│ │ ├── index.ts
│ │ ├── lib.ts
│ │ ├── message.ts
│ │ ├── response.ts
│ │ └── sockets.ts
│ ├── tsconfig.json
│ ├── util/
│ │ └── live-reload.js
│ └── webpack.config.js
├── demo/
│ ├── .dockerignore
│ ├── App/
│ │ ├── Cache.hs
│ │ ├── Config.hs
│ │ ├── Docs/
│ │ │ ├── Markdown.hs
│ │ │ ├── Page.hs
│ │ │ └── Snippet.hs
│ │ ├── Docs.hs
│ │ ├── Page/
│ │ │ ├── Application.hs
│ │ │ ├── CSS.hs
│ │ │ ├── Concurrency.hs
│ │ │ ├── Examples.hs
│ │ │ ├── Forms.hs
│ │ │ ├── HyperboleEffect.hs
│ │ │ ├── Hyperviews.hs
│ │ │ ├── Interactivity.hs
│ │ │ ├── Intro/
│ │ │ │ ├── Basics.hs
│ │ │ │ └── Intro.hs
│ │ │ ├── OAuth2.hs
│ │ │ ├── SideEffects.hs
│ │ │ ├── State.hs
│ │ │ └── ViewFunctions.hs
│ │ ├── Route.hs
│ │ └── Style.hs
│ ├── App.hs
│ ├── Example/
│ │ ├── CSS/
│ │ │ ├── External.hs
│ │ │ ├── Loading.hs
│ │ │ ├── Tooltips.hs
│ │ │ └── Transitions.hs
│ │ ├── Chat.hs
│ │ ├── Colors.hs
│ │ ├── Concurrency/
│ │ │ ├── LazyLoading.hs
│ │ │ ├── Overlap.hs
│ │ │ ├── Polling.hs
│ │ │ ├── Progress.hs
│ │ │ └── Tasks.hs
│ │ ├── Contact.hs
│ │ ├── Contacts.hs
│ │ ├── Counter.hs
│ │ ├── Data/
│ │ │ └── ProgrammingLanguage.hs
│ │ ├── DataLists/
│ │ │ ├── Autocomplete.hs
│ │ │ ├── DataTable.hs
│ │ │ ├── Filter.hs
│ │ │ └── LoadMore.hs
│ │ ├── Docs/
│ │ │ ├── App.hs
│ │ │ ├── BasicPage.hs
│ │ │ ├── CSS.hs
│ │ │ ├── Client.hs
│ │ │ ├── Component.hs
│ │ │ ├── Encoding.hs
│ │ │ ├── Interactive.hs
│ │ │ ├── MultiPage.hs
│ │ │ ├── MultiView.hs
│ │ │ ├── Nested.hs
│ │ │ ├── Nesting.hs
│ │ │ ├── Page/
│ │ │ │ ├── Messages.hs
│ │ │ │ └── Users.hs
│ │ │ ├── Params.hs
│ │ │ ├── QueryMessage.hs
│ │ │ ├── Sessions.hs
│ │ │ ├── SideEffects.hs
│ │ │ ├── State.hs
│ │ │ ├── UniqueViewId.hs
│ │ │ └── ViewFunctions.hs
│ │ ├── Document.hs
│ │ ├── Effects/
│ │ │ ├── Debug.hs
│ │ │ ├── Todos.hs
│ │ │ └── Users.hs
│ │ ├── Errors.hs
│ │ ├── FormSimple.hs
│ │ ├── FormValidation.hs
│ │ ├── Interactivity/
│ │ │ ├── Events.hs
│ │ │ └── Inputs.hs
│ │ ├── Javascript.hs
│ │ ├── Push.hs
│ │ ├── Requests.hs
│ │ ├── Scrollbars.hs
│ │ ├── Simple.hs
│ │ ├── State/
│ │ │ ├── Effects.hs
│ │ │ ├── Query.hs
│ │ │ ├── Sessions.hs
│ │ │ ├── Stateless.hs
│ │ │ └── ViewState.hs
│ │ ├── Style/
│ │ │ └── Cyber.hs
│ │ ├── Style.hs
│ │ ├── Tags.hs
│ │ ├── Test.hs
│ │ ├── Todos/
│ │ │ ├── Todo.hs
│ │ │ └── TodoCSS.hs
│ │ ├── Trigger.hs
│ │ └── View/
│ │ ├── Icon.hs
│ │ ├── Inputs.hs
│ │ ├── Layout.hs
│ │ ├── Loader.hs
│ │ ├── Menu.hs
│ │ └── SortableTable.hs
│ ├── Main.hs
│ ├── README.md
│ ├── demo.cabal
│ ├── fourmolu.yaml
│ ├── hie.yaml
│ ├── package.yaml
│ └── static/
│ ├── custom.js
│ ├── cyber.css
│ ├── docs.js
│ ├── external.css
│ ├── prism.css
│ ├── prism.js
│ ├── test.js
│ └── todomvc.css
├── docs/
│ ├── Main.hs
│ ├── app-document.md
│ ├── app-effects.md
│ ├── app-live.md
│ ├── app-pages.md
│ ├── app-routes.md
│ ├── atomic.md
│ ├── comparison.md
│ ├── concurrency-overlap.md
│ ├── dev.md
│ ├── docgen.cabal
│ ├── effectful.md
│ ├── effects-custom.md
│ ├── effects-other.md
│ ├── forms-simple.md
│ ├── forms-validated.md
│ ├── hyperviews-intro.md
│ ├── hyperviews-multi.md
│ ├── hyperviews-nesting.md
│ ├── hyperviews-unique.md
│ ├── interactivity-events.md
│ ├── interactivity-events2.md
│ ├── interactivity-inputs.md
│ ├── interactivity-javascript.md
│ ├── interactivity-pushevent.md
│ ├── intro-downsides.md
│ ├── intro-links.md
│ ├── intro.md
│ ├── javascript_api.md
│ ├── multi-same.md
│ ├── nix.md
│ ├── outline.md
│ ├── package.yaml
│ ├── pages.md
│ ├── state-browser.md
│ ├── state-effects.md
│ ├── state-sessions.md
│ ├── state-stateless.md
│ ├── state-threading.md
│ ├── state-viewstate.md
│ ├── view-components.md
│ ├── view-functions-end.md
│ ├── view-functions-wrap.md
│ └── view-functions.md
├── flake.nix
├── fourmolu.yaml
├── hie.yaml
├── hyperbole.cabal
├── package.yaml
├── src/
│ └── Web/
│ ├── Hyperbole/
│ │ ├── Application.hs
│ │ ├── Data/
│ │ │ ├── Cookie.hs
│ │ │ ├── Encoded.hs
│ │ │ ├── JSON.hs
│ │ │ ├── Param.hs
│ │ │ ├── QueryData.hs
│ │ │ └── URI.hs
│ │ ├── Document.hs
│ │ ├── Effect/
│ │ │ ├── Client.hs
│ │ │ ├── GenRandom.hs
│ │ │ ├── Hyperbole.hs
│ │ │ ├── OAuth2.hs
│ │ │ ├── Query.hs
│ │ │ ├── Request.hs
│ │ │ ├── Response.hs
│ │ │ └── Session.hs
│ │ ├── HyperView/
│ │ │ ├── Event.hs
│ │ │ ├── Forms.hs
│ │ │ ├── Handled.hs
│ │ │ ├── Hyper.hs
│ │ │ ├── Input.hs
│ │ │ └── Types.hs
│ │ ├── HyperView.hs
│ │ ├── Page.hs
│ │ ├── Route.hs
│ │ ├── Server/
│ │ │ ├── Handler.hs
│ │ │ ├── Message.hs
│ │ │ ├── Options.hs
│ │ │ ├── Socket.hs
│ │ │ └── Wai.hs
│ │ ├── TypeList.hs
│ │ ├── Types/
│ │ │ ├── Client.hs
│ │ │ ├── Event.hs
│ │ │ ├── Request.hs
│ │ │ └── Response.hs
│ │ ├── View/
│ │ │ ├── CSS.hs
│ │ │ ├── Embed.hs
│ │ │ ├── Render.hs
│ │ │ ├── Tag.hs
│ │ │ ├── Types.hs
│ │ │ ├── ViewAction.hs
│ │ │ └── ViewId.hs
│ │ └── View.hs
│ └── Hyperbole.hs
└── test/
├── Spec.hs
└── Test/
├── EncodedSpec.hs
├── FormSpec.hs
├── ParamSpec.hs
├── QuerySpec.hs
├── RouteSpec.hs
├── SessionSpec.hs
├── URISpec.hs
├── ViewActionSpec.hs
├── ViewIdSpec.hs
└── ViewSpec.hs
SYMBOL INDEX (174 symbols across 21 files)
FILE: client/dist/action.d.ts
type ActionMessage (line 2) | type ActionMessage = {
type Request (line 14) | type Request = {
FILE: client/dist/events.d.ts
type UrlFragment (line 2) | type UrlFragment = string;
FILE: client/dist/hyperbole.js
function t (line 2) | function t(e,t=100,n={}){if("function"!=typeof e)throw new TypeError(`Ex...
function n (line 2) | function n(o){var r=t[o];if(void 0!==r)return r.exports;var i=t[o]={expo...
function r (line 2) | function r(e,t){return function(e){if(Array.isArray(e))return e}(e)||fun...
function i (line 2) | function i(e,t){(null==t||t>e.length)&&(t=e.length);for(var n=0,o=new Ar...
function g (line 2) | function g(e,t){var n=[];for(var o of t){let t=e(o);if(!t)break;n.push(t...
function w (line 2) | function w(e){return{cookies:e.filter((e=>"Cookie"==e.key)).map((e=>e.va...
function E (line 2) | function E(e){return w(g(C,e.trim().split("\n")))}
function b (line 2) | function b(e,t){return t.find((t=>t.key==e))?.value}
function I (line 2) | function I(e,t){return t.filter((t=>t.key==e)).map((e=>e.value))}
function C (line 2) | function C(e){let t=e.match(/^(\w+)\: (.*)$/);if(t)return{key:t[1],value...
function k (line 2) | function k(e){let[t,n]=T(e);return{name:t,detail:JSON.parse(n)}}
function q (line 2) | function q(e){let[t,n]=T(e);return[t,n]}
function T (line 2) | function T(e){let t=e.indexOf("|");if(-1===t){let t=new Error("Bad Encod...
function L (line 2) | function L(e){if(!e)return;const t=new URLSearchParams;return e.forEach(...
function A (line 2) | function A(e,t){return e+" "+function(e){return""==e?"|":e.replace(/_/g,...
class x (line 2) | class x extends Error{constructor(e,t){super(e+"\n"+t),this.name="Protoc...
method constructor (line 2) | constructor(e,t){super(e+"\n"+t),this.name="ProtocolError"}
function O (line 2) | function O(e){let t=new Event("hyp-content",{bubbles:!0});e.dispatchEven...
function N (line 2) | function N(e,t){e.querySelectorAll("[id]").forEach((n=>{n.runAction=func...
function H (line 2) | function H(e,t){document.addEventListener(e,(function(n){if(!(n.target i...
function V (line 2) | function V(e,t){document.addEventListener(e,(function(n){if(!(n.target i...
function j (line 2) | function j(e){e.querySelectorAll("[data-onload]").forEach((e=>{let t=par...
function P (line 2) | function P(e){e.querySelectorAll("[data-onmouseenter]").forEach((e=>{let...
function B (line 2) | function B(e){e.querySelectorAll("[data-onmouseleave]").forEach((e=>{let...
function Q (line 2) | function Q(e){const t=U(e);if(D(t))return t;console.error("Non HyperView...
function U (line 2) | function U(e){let t=function(e){let t=e.closest("[data-target]");return ...
function _ (line 2) | async function _(e,t,n){if(e.activeRequest&&!e.activeRequest?.isCancelle...
function G (line 2) | function G(e){let t=e.targetViewId||e.viewId,n=document.getElementById(t...
function J (line 2) | function J(e){e.forEach((e=>{console.log("SetCookie: ",e),document.cooki...
function K (line 2) | function K(e,t){null!=e.query&&function(e){if(e!=function(){const e=wind...
function Y (line 2) | function Y(e,t){setTimeout((()=>{let n=new CustomEvent(e.name,{bubbles:!...
function X (line 2) | function X(e,t){setTimeout((()=>{let n=window.Hyperbole?.hyperView(e);n&...
method constructor (line 2) | constructor(e=M){this.hasEverConnected=!1,this.isConnected=!1,this.recon...
method connect (line 2) | connect(e=M,t=!1){const n=t?new WebSocket(e):this.socket;function o(e){c...
method sendAction (line 2) | async sendAction(e){if(this.isConnected){let t=function(e){let t=["|ACTI...
method runQueue (line 2) | runQueue(){let e=this.queue.pop();e&&(console.log("runQueue: ",e),this.s...
method onMessage (line 2) | onMessage(e){let{command:t,metas:n,rest:o}=function(e){let t=e.split("\n...
method addEventListener (line 2) | addEventListener(e,t){this.events.addEventListener(e,t)}
method dispatchEvent (line 2) | dispatchEvent(e){this.events.dispatchEvent(e)}
method disconnect (line 2) | disconnect(){this.isConnected=!1,this.hasEverConnected=!1,this.socket.cl...
FILE: client/dist/hyperview.d.ts
type HyperView (line 2) | interface HyperView extends HTMLElement {
type ConcurrencyMode (line 10) | type ConcurrencyMode = string;
FILE: client/dist/index.d.ts
type Window (line 5) | interface Window {
type DocumentEventMap (line 8) | interface DocumentEventMap {
type HyperboleAPI (line 14) | interface HyperboleAPI {
FILE: client/dist/message.d.ts
type Meta (line 1) | type Meta = {
type ViewId (line 5) | type ViewId = string;
type RequestId (line 6) | type RequestId = number;
type EncodedAction (line 7) | type EncodedAction = string;
type ViewState (line 8) | type ViewState = string;
type RemoteEvent (line 9) | type RemoteEvent = {
type Metadata (line 14) | type Metadata = {
type SplitMessage (line 26) | type SplitMessage = {
FILE: client/dist/response.d.ts
type Response (line 2) | type Response = {
type ResponseBody (line 6) | type ResponseBody = string;
type LiveUpdate (line 8) | type LiveUpdate = {
class FetchError (line 12) | class FetchError extends Error {
FILE: client/dist/sockets.d.ts
type SocketConnectionEventMap (line 4) | interface SocketConnectionEventMap {
class SocketConnection (line 11) | class SocketConnection {
type Update (line 27) | type Update = {
type Redirect (line 35) | type Redirect = {
type Trigger (line 40) | type Trigger = {
type JSEvent (line 48) | type JSEvent = {
type MessageType (line 55) | type MessageType = string;
class ProtocolError (line 56) | class ProtocolError extends Error {
FILE: client/src/action.ts
type ActionMessage (line 8) | type ActionMessage = {
function actionMessage (line 20) | function actionMessage(id: ViewId, action: EncodedAction, state: ViewSta...
function toSearch (line 29) | function toSearch(form?: FormData): URLSearchParams | undefined {
function renderActionMessage (line 41) | function renderActionMessage(msg: ActionMessage): string {
function renderForm (line 62) | function renderForm(form: URLSearchParams | undefined): string {
type Request (line 69) | type Request = {
function newRequest (line 74) | function newRequest(): Request {
function encodedParam (line 83) | function encodedParam(action: string, param: string): string {
function sanitizeParam (line 87) | function sanitizeParam(param: string): string {
FILE: client/src/browser.ts
function setQuery (line 2) | function setQuery(query: string) {
function currentQuery (line 11) | function currentQuery(): string {
FILE: client/src/events.ts
type UrlFragment (line 6) | type UrlFragment = string
function listenKeydown (line 8) | function listenKeydown(cb: (target: HyperView, action: string) => void):...
function listenKeyup (line 12) | function listenKeyup(cb: (target: HyperView, action: string) => void): v...
function listenKeyEvent (line 16) | function listenKeyEvent(event: "keyup" | "keydown", cb: (target: HyperVi...
function listenBubblingEvent (line 39) | function listenBubblingEvent(event: string, cb: (_target: HyperView, act...
function listenClick (line 66) | function listenClick(cb: (target: HyperView, action: string) => void): v...
function listenDblClick (line 70) | function listenDblClick(cb: (target: HyperView, action: string) => void)...
function listenTopLevel (line 75) | function listenTopLevel(cb: (target: HyperView, action: string) => void)...
function listenLoad (line 96) | function listenLoad(node: HTMLElement): void {
function listenMouseEnter (line 121) | function listenMouseEnter(node: HTMLElement): void {
function listenMouseLeave (line 134) | function listenMouseLeave(node: HTMLElement): void {
function listenChange (line 148) | function listenChange(cb: (target: HyperView, action: string) => void): ...
type LiveInputElement (line 180) | interface LiveInputElement extends HTMLInputElement {
function listenInput (line 184) | function listenInput(startedTyping: (target: HyperView) => void, cb: (ta...
function listenFormSubmit (line 228) | function listenFormSubmit(cb: (target: HyperView, action: string, form: ...
function nearestTargetId (line 254) | function nearestTargetId(node: HTMLElement): string | undefined {
function nearestHyperViewTarget (line 259) | function nearestHyperViewTarget(node: HTMLElement): HyperView | undefined {
function nearestAnyTarget (line 270) | function nearestAnyTarget(node: HTMLElement): HTMLElement | undefined {
FILE: client/src/hyperview.ts
type HyperView (line 3) | interface HyperView extends HTMLElement {
type ConcurrencyMode (line 15) | type ConcurrencyMode = string;
function dispatchContent (line 17) | function dispatchContent(node: HTMLElement): void {
function enrichHyperViews (line 22) | function enrichHyperViews(node: HTMLElement, runAction: (target: HyperVi...
FILE: client/src/index.ts
constant PACKAGE (line 10) | let PACKAGE = require('../package.json');
function runAction (line 25) | async function runAction(target: HyperView, action: string, form?: FormD...
function handleTrigger (line 52) | function handleTrigger(trigger: Trigger) {
function handleEvent (line 56) | function handleEvent(ev: JSEvent) {
function handleRedirect (line 62) | function handleRedirect(red: Redirect) {
function handleResponse (line 72) | function handleResponse(res: Update) {
function handleUpdate (line 83) | function handleUpdate(res: Update): HyperView | undefined {
function applyCookies (line 171) | function applyCookies(cookies: string[]) {
function runMetadata (line 178) | function runMetadata(meta: Metadata, target: HTMLElement | null) {
function runRemoteEvent (line 196) | function runRemoteEvent(remoteEvent: RemoteEvent, target: HTMLElement | ...
function runTrigger (line 204) | function runTrigger(viewId: ViewId, action: EncodedAction) {
function fixInputs (line 214) | function fixInputs(target: HTMLElement) {
function addCSS (line 233) | function addCSS(src: HTMLStyleElement | null) {
function init (line 249) | function init() {
type VNode (line 339) | type VNode = {
type Window (line 369) | interface Window {
type DocumentEventMap (line 372) | interface DocumentEventMap {
type HyperboleAPI (line 379) | interface HyperboleAPI {
FILE: client/src/lib.ts
function takeWhileMap (line 3) | function takeWhileMap<T, A>(pred: (val: T) => A | undefined, lines: T[])...
function dropWhile (line 16) | function dropWhile<T, A>(pred: (val: T) => A | undefined, lines: T[]): T...
FILE: client/src/message.ts
type Meta (line 6) | type Meta = { key: string, value: string }
type ViewId (line 7) | type ViewId = string
type RequestId (line 8) | type RequestId = number
type EncodedAction (line 9) | type EncodedAction = string
type ViewState (line 10) | type ViewState = string
type RemoteEvent (line 12) | type RemoteEvent = { name: string, detail: unknown }
function renderMetas (line 15) | function renderMetas(meta: Meta[]): string {
type Metadata (line 19) | type Metadata = {
function toMetadata (line 30) | function toMetadata(meta: Meta[]): Metadata {
function parseMetadata (line 45) | function parseMetadata(input: string): Metadata {
function metaValue (line 51) | function metaValue(key: string, metas: Meta[]): string | undefined {
function metaValuesAll (line 55) | function metaValuesAll(key: string, metas: Meta[]): string[] {
type SplitMessage (line 59) | type SplitMessage = {
function splitMessage (line 66) | function splitMessage(message: string): SplitMessage {
function parseMeta (line 78) | function parseMeta(line: string): Meta | undefined {
function parseRemoteEvent (line 89) | function parseRemoteEvent(input: string): RemoteEvent {
function parseAction (line 97) | function parseAction(input: string): [ViewId, string] {
function breakNextSegment (line 102) | function breakNextSegment(input: string): [string, string] {
FILE: client/src/response.ts
type Response (line 6) | type Response = {
type ResponseBody (line 11) | type ResponseBody = string
function parseResponse (line 13) | function parseResponse(res: ResponseBody): LiveUpdate {
type LiveUpdate (line 25) | type LiveUpdate = {
class FetchError (line 31) | class FetchError extends Error {
method constructor (line 34) | constructor(viewId: ViewId, msg: string, body: string) {
FILE: client/src/sockets.ts
type SocketConnectionEventMap (line 9) | interface SocketConnectionEventMap {
class SocketConnection (line 17) | class SocketConnection {
method constructor (line 26) | constructor(addr = defaultAddress) {
method connect (line 32) | connect(addr = defaultAddress, createSocket = false) {
method sendAction (line 87) | async sendAction(action: ActionMessage) {
method runQueue (line 97) | private runQueue() {
method onMessage (line 109) | private onMessage(event: MessageEvent) {
method addEventListener (line 230) | addEventListener<K extends keyof SocketConnectionEventMap>(e: K, cb: (...
method dispatchEvent (line 237) | dispatchEvent<K extends keyof SocketConnectionEventMap>(e: SocketConne...
method disconnect (line 241) | disconnect() {
type Update (line 249) | type Update = {
type Redirect (line 258) | type Redirect = {
type Trigger (line 264) | type Trigger = {
type JSEvent (line 273) | type JSEvent = {
type MessageType (line 281) | type MessageType = string
class ProtocolError (line 286) | class ProtocolError extends Error {
method constructor (line 287) | constructor(description: string, body: string) {
FILE: client/util/live-reload.js
function showNotification (line 14) | function showNotification(message) {
function jackIn (line 37) | function jackIn(style) {
FILE: demo/static/custom.js
function listenServerEvents (line 22) | function listenServerEvents() {
FILE: demo/static/docs.js
function highlightNav (line 34) | function highlightNav(activeId) {
FILE: demo/static/prism.js
function u (line 3) | function u(e){s.highlightedCode=e,a.hooks.run("before-insert",s),s.eleme...
function i (line 3) | function i(e,n,t,r){this.type=e,this.content=n,this.alias=t,this.length=...
function l (line 3) | function l(e,n,t,r){e.lastIndex=n;var a=e.exec(t);if(a&&r&&a[1]){var i=a...
function o (line 3) | function o(e,n,t,r,s,g){for(var f in t)if(t.hasOwnProperty(f)&&t[f]){var...
function s (line 3) | function s(){var e={value:null,prev:null,next:null},n={value:null,prev:e...
function u (line 3) | function u(e,n,t){var r=n.next,a={value:t,prev:n,next:r};return n.next=a...
function c (line 3) | function c(e,n,t){for(var r=n.next,a=0;a<t&&r!==e.tail;a++)r=r.next;n.ne...
function f (line 3) | function f(){a.manual||a.highlightAll()}
Condensed preview — 254 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (592K chars).
[
{
"path": ".dockerignore",
"chars": 62,
"preview": ".git\n.stack-work\nclient/node_modules\nDockerfile\ndist-newstyle\n"
},
{
"path": ".github/workflows/haskell.yaml",
"chars": 2917,
"preview": "name: Haskell CI\n\non:\n push:\n branches: [ \"main\", \"ci\" ]\n pull_request:\n branches: [ \"main\" ]\n\npermissions:\n co"
},
{
"path": ".github/workflows/packcheck.yaml",
"chars": 6210,
"preview": "# packcheck-0.7.1\n# You can use any of the options supported by packcheck as environment\n# variables here. See https://"
},
{
"path": ".gitignore",
"chars": 227,
"preview": "dist-newstyle\n.DS_Store\ntags\nnode_modules\n# Auto-generated pre-commit config\n.pre-commit-config.yaml\n# Nix output dir\nre"
},
{
"path": ".hlint.yaml",
"chars": 250,
"preview": "- arguments:\n - -XOverloadedRecordDot\n\n- ignore: {name: \"Use <$>\"}\n- ignore: {name: \"Use newtype instead of data\"}\n\n#"
},
{
"path": ".packcheck.ignore",
"chars": 391,
"preview": "client/*.d.ts\nclient/src/\nclient/dist/*.d.ts\nclient/package-lock.json\nclient/webpack.config.js\nclient/package.json\nclien"
},
{
"path": "CHANGELOG.md",
"chars": 2479,
"preview": "# Revision history for hyperbole\n\n## 0.6.0 -- 2026-01-15\n\nImprovements:\n* `ViewState` - built in threaded state, default"
},
{
"path": "DOCTODO.md",
"chars": 47,
"preview": "Documentation Outline\n======================\n\n\n"
},
{
"path": "Dockerfile",
"chars": 1593,
"preview": "FROM haskell:9.8.2 AS base\nWORKDIR /opt/build\n\nRUN cabal update\nRUN cabal install bytestring containers casing effectful"
},
{
"path": "LICENSE",
"chars": 1516,
"preview": "Copyright (c) 2023, Sean Hess\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\n"
},
{
"path": "README.md",
"chars": 3448,
"preview": "\n\n[![Hackage Version](https://img"
},
{
"path": "bin/dev",
"chars": 351,
"preview": "#!/bin/bash\n\n\npackage() {\n hpack\n hpack docs\n hpack demo\n}\n\nwatch() {\n ghcid -c \"cabal repl demo lib:hyperbole\" -T A"
},
{
"path": "bin/docgen",
"chars": 91,
"preview": "#!/bin/bash\n\nset -e\n\nhpack demo\nhpack docs\ncabal run docs\n\ncd /tmp/hyperbole\ncabal haddock\n"
},
{
"path": "bin/release",
"chars": 230,
"preview": "#!/bin/bash\n\n\n# Make sure everything is working\nhpack\ncabal test\n\n\n# Compile the JS client\ncd client\nnpm install\nnpx web"
},
{
"path": "cabal.project",
"chars": 63,
"preview": "tests: True\nmulti-repl: True\npackages:\n .\n ./demo/\n ./docs/\n"
},
{
"path": "client/declarations.d.ts",
"chars": 237,
"preview": "declare module 'omdomdom/lib/omdomdom.es.js' {\n export function create(node: any, ...args: any[]): any;\n export functi"
},
{
"path": "client/dist/action.d.ts",
"chars": 854,
"preview": "import { Meta, ViewId, RequestId, EncodedAction, ViewState } from \"./message\";\nexport type ActionMessage = {\n viewId:"
},
{
"path": "client/dist/browser.d.ts",
"chars": 55,
"preview": "export declare function setQuery(query: string): void;\n"
},
{
"path": "client/dist/events.d.ts",
"chars": 1319,
"preview": "import { HyperView } from './hyperview';\nexport type UrlFragment = string;\nexport declare function listenKeydown(cb: (ta"
},
{
"path": "client/dist/http.d.ts",
"chars": 0,
"preview": ""
},
{
"path": "client/dist/hyperbole.js",
"chars": 19248,
"preview": "/*! For license information please see hyperbole.js.LICENSE.txt */\n(()=>{var e={296:e=>{function t(e,t=100,n={}){if(\"fun"
},
{
"path": "client/dist/hyperview.d.ts",
"chars": 576,
"preview": "import { type Request } from \"./action\";\nexport interface HyperView extends HTMLElement {\n runAction(action: string):"
},
{
"path": "client/dist/index.d.ts",
"chars": 662,
"preview": "import { SocketConnection } from './sockets';\nimport { ViewId, Metadata } from './message';\nimport { HyperView } from \"."
},
{
"path": "client/dist/lib.d.ts",
"chars": 185,
"preview": "export declare function takeWhileMap<T, A>(pred: (val: T) => A | undefined, lines: T[]): A[];\nexport declare function dr"
},
{
"path": "client/dist/message.d.ts",
"chars": 1155,
"preview": "export type Meta = {\n key: string;\n value: string;\n};\nexport type ViewId = string;\nexport type RequestId = number;"
},
{
"path": "client/dist/response.d.ts",
"chars": 468,
"preview": "import { ViewId, Metadata } from './message';\nexport type Response = {\n meta: Metadata;\n body: ResponseBody;\n};\nex"
},
{
"path": "client/dist/sockets.d.ts",
"chars": 1757,
"preview": "import { ActionMessage } from './action';\nimport { ResponseBody } from \"./response\";\nimport { ViewId, RequestId, Encoded"
},
{
"path": "client/package.json",
"chars": 479,
"preview": "{\n \"name\": \"web-ui\",\n \"version\": \"0.6.0\",\n \"description\": \"Development -----------\",\n \"main\": \"index.js\",\n \"directo"
},
{
"path": "client/src/action.ts",
"chars": 2005,
"preview": "\nimport { takeWhileMap } from \"./lib\"\nimport { Meta, ViewId, RequestId, EncodedAction, ViewState } from \"./message\"\nimpo"
},
{
"path": "client/src/browser.ts",
"chars": 400,
"preview": "\nexport function setQuery(query: string) {\n if (query != currentQuery()) {\n if (query != \"\") query = \"?\" + query\n "
},
{
"path": "client/src/events.ts",
"chars": 8107,
"preview": "\nimport * as debounce from 'debounce'\nimport { encodedParam } from './action'\nimport { HyperView, isHyperView } from './"
},
{
"path": "client/src/http.ts",
"chars": 1295,
"preview": "// import { ActionMessage, ParsedResponse } from './action'\n// import { Response, FetchError } from \"./response\"\n\n// exp"
},
{
"path": "client/src/hyperview.ts",
"chars": 1160,
"preview": "import { type Request } from \"./action\";\n\nexport interface HyperView extends HTMLElement {\n runAction(action: string): "
},
{
"path": "client/src/index.ts",
"chars": 11095,
"preview": "import { patch, create } from \"omdomdom/lib/omdomdom.es.js\"\nimport { SocketConnection, Update, Redirect, Trigger, JSEven"
},
{
"path": "client/src/lib.ts",
"chars": 441,
"preview": "\n\nexport function takeWhileMap<T, A>(pred: (val: T) => A | undefined, lines: T[]): A[] {\n var output = []\n for (var li"
},
{
"path": "client/src/message.ts",
"chars": 2750,
"preview": "\nimport { takeWhileMap, dropWhile } from \"./lib\"\n\n\n\nexport type Meta = { key: string, value: string }\nexport type ViewId"
},
{
"path": "client/src/response.ts",
"chars": 790,
"preview": "\nimport { ViewId, Metadata } from './message'\n\n\n\nexport type Response = {\n meta: Metadata\n body: ResponseBody\n}\n\nexpor"
},
{
"path": "client/src/sockets.ts",
"chars": 8056,
"preview": "import { ActionMessage, renderActionMessage } from './action'\nimport { ResponseBody } from \"./response\"\nimport * as mess"
},
{
"path": "client/tsconfig.json",
"chars": 403,
"preview": "{\n \"compilerOptions\": {\n \"outDir\": \"./dist/\",\n \"sourceMap\": true,\n \"noImplicitAny\": true,\n \"module\": \"ES202"
},
{
"path": "client/util/live-reload.js",
"chars": 1485,
"preview": "// This isn't magic. If you want custom behavior, copy and modify this however you like. \n//\n// As with any custom js, a"
},
{
"path": "client/webpack.config.js",
"chars": 719,
"preview": "const path = require('path');\n// var PACKAGE = require('./package.json');\n// var version = PACKAGE.version;\n\nmodule.expo"
},
{
"path": "demo/.dockerignore",
"chars": 19,
"preview": "dist-newstyle\n.git\n"
},
{
"path": "demo/App/Cache.hs",
"chars": 508,
"preview": "module App.Cache where\n\nimport Network.HTTP.Types (Header)\nimport Network.Wai.Middleware.Static\n\nclientCache :: IO Optio"
},
{
"path": "demo/App/Config.hs",
"chars": 1772,
"preview": "{-# LANGUAGE QuasiQuotes #-}\n\nmodule App.Config where\n\nimport Data.Maybe (fromMaybe, isNothing)\nimport Effectful\nimport "
},
{
"path": "demo/App/Docs/Markdown.hs",
"chars": 5711,
"preview": "{-# LANGUAGE OverloadedLists #-}\n{-# LANGUAGE QuasiQuotes #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -Wno-orph"
},
{
"path": "demo/App/Docs/Page.hs",
"chars": 2699,
"preview": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE OverloadedLists #-}\n{-# LANGUAGE QuasiQuotes #-}\n\nmodule App.Docs.Page\n "
},
{
"path": "demo/App/Docs/Snippet.hs",
"chars": 5010,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Docs.Snippet where\n\nimport Control.Monad (unless)\nimport Data.Char (isSpace"
},
{
"path": "demo/App/Docs.hs",
"chars": 179,
"preview": "module App.Docs\n ( module App.Docs.Markdown\n , module App.Docs.Page\n , module App.Docs.Snippet\n ) where\n\nimport App."
},
{
"path": "demo/App/Page/Application.hs",
"chars": 1035,
"preview": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.Application where\n\nimport App.Docs\nimport "
},
{
"path": "demo/App/Page/CSS.hs",
"chars": 2491,
"preview": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.CSS where\n\nimport App.Docs\nimport App.Rout"
},
{
"path": "demo/App/Page/Concurrency.hs",
"chars": 3135,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule App.Page.Concurrency where\n\nimport App.Do"
},
{
"path": "demo/App/Page/Examples.hs",
"chars": 2169,
"preview": "module App.Page.Examples where\n\nimport App.Docs\nimport App.Route as Route\nimport Example.Style as Style (link)\nimport Ex"
},
{
"path": "demo/App/Page/Forms.hs",
"chars": 921,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.Forms where\n\nimport App.Docs\nimport App.Route\nimport Example.FormSimpl"
},
{
"path": "demo/App/Page/HyperboleEffect.hs",
"chars": 2254,
"preview": "module App.Page.HyperboleEffect where\n\nimport App.Route as Route hiding (Response, UserId)\nimport App.Docs\nimport Effect"
},
{
"path": "demo/App/Page/Hyperviews.hs",
"chars": 2538,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.Hyperviews where\n\nimport App.Docs\nimport App.Route qualified as Route "
},
{
"path": "demo/App/Page/Interactivity.hs",
"chars": 1450,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.Interactivity where\n\nimport App.Docs\nimport App.Route hiding (Javascri"
},
{
"path": "demo/App/Page/Intro/Basics.hs",
"chars": 2625,
"preview": "{-# LANGUAGE QuasiQuotes #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.Intro.Basics where\n\nimport App.Docs\nimpor"
},
{
"path": "demo/App/Page/Intro/Intro.hs",
"chars": 2626,
"preview": "{-# LANGUAGE QuasiQuotes #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.Intro.Intro where\n\nimport App.Docs\nimport"
},
{
"path": "demo/App/Page/OAuth2.hs",
"chars": 5329,
"preview": "{-# LANGUAGE OverloadedLists #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE Undeci"
},
{
"path": "demo/App/Page/SideEffects.hs",
"chars": 1064,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.SideEffects where\n\nimport App.Docs\nimport App.Route as Route (AppRoute"
},
{
"path": "demo/App/Page/State.hs",
"chars": 2321,
"preview": "{-# LANGUAGE QuasiQuotes #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.State where\n\nimport App.Docs\nimport App.R"
},
{
"path": "demo/App/Page/ViewFunctions.hs",
"chars": 1166,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.ViewFunctions where\n\nimport App.Docs\nimport App.Route qualified as Rou"
},
{
"path": "demo/App/Route.hs",
"chars": 3512,
"preview": "{-# LANGUAGE OverloadedLists #-}\n\nmodule App.Route where\n\nimport Data.String.Conversions (cs)\nimport Data.Text (Text, un"
},
{
"path": "demo/App/Style.hs",
"chars": 1209,
"preview": "module App.Style where\n\nimport Example.Colors\nimport Web.Atomic.CSS\n\n-- btn :: (Styleable h) => CSS h -> CSS h\n-- btn = "
},
{
"path": "demo/App.hs",
"chars": 10963,
"preview": "{-# LANGUAGE OverloadedStrings #-}\n{-# OPTIONS_GHC -Wno-unused-imports #-}\n\nmodule App where\n\nimport App.Cache (clientCa"
},
{
"path": "demo/Example/CSS/External.hs",
"chars": 1113,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.CSS.External where\n\nimport Data.Text (Text)\nimport App.Docs\nimport Web."
},
{
"path": "demo/Example/CSS/Loading.hs",
"chars": 810,
"preview": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.CSS.Loading where\n\nimport Data.Text (Text)\nimport Example.Effects."
},
{
"path": "demo/Example/CSS/Tooltips.hs",
"chars": 849,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.CSS.Tooltips where\n\nimport App.Docs\nimport Example.Colors\nimport Web.At"
},
{
"path": "demo/Example/CSS/Transitions.hs",
"chars": 752,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.CSS.Transitions where\n\nimport App.Docs\nimport Example.Style.Cyber (btn)"
},
{
"path": "demo/Example/Chat.hs",
"chars": 5306,
"preview": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Chat where\n\nimport App.Route\nimport Control.Monad (forM_, forever)"
},
{
"path": "demo/Example/Colors.hs",
"chars": 1704,
"preview": "{-# LANGUAGE LambdaCase #-}\n\nmodule Example.Colors where\n\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata AppColor\n = "
},
{
"path": "demo/Example/Concurrency/LazyLoading.hs",
"chars": 1167,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Concurrency.LazyLoading where\n\nim"
},
{
"path": "demo/Example/Concurrency/Overlap.hs",
"chars": 1877,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Concurrency.Overlap where\n\nimport"
},
{
"path": "demo/Example/Concurrency/Polling.hs",
"chars": 1559,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Concurrency.Polling where\n\nimport"
},
{
"path": "demo/Example/Concurrency/Progress.hs",
"chars": 1691,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Concurrency.Progress where\n\nimpor"
},
{
"path": "demo/Example/Concurrency/Tasks.hs",
"chars": 556,
"preview": "module Example.Concurrency.Tasks where\n\nimport Data.Text (Text, pack)\nimport Effectful\nimport Example.Effects.Debug\nimpo"
},
{
"path": "demo/Example/Contact.hs",
"chars": 4477,
"preview": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Contact where\n\nimport App.Route (UserId)\nimport App.Route qualifie"
},
{
"path": "demo/Example/Contacts.hs",
"chars": 5217,
"preview": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Conta"
},
{
"path": "demo/Example/Counter.hs",
"chars": 848,
"preview": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Counter where\n\nimport Data.Text (pack)\nimport Effectful\nimport Exa"
},
{
"path": "demo/Example/Data/ProgrammingLanguage.hs",
"chars": 2953,
"preview": "{-# LANGUAGE DerivingVia #-}\n\nmodule Example.Data.ProgrammingLanguage where\n\nimport Data.Text (Text, isInfixOf, toLower)"
},
{
"path": "demo/Example/DataLists/Autocomplete.hs",
"chars": 2911,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.DataLists.Autocomplete where\n\nimp"
},
{
"path": "demo/Example/DataLists/DataTable.hs",
"chars": 1886,
"preview": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.DataLists.DataTable where\n\nimport App.Docs\n"
},
{
"path": "demo/Example/DataLists/Filter.hs",
"chars": 5401,
"preview": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.DataL"
},
{
"path": "demo/Example/DataLists/LoadMore.hs",
"chars": 1950,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.DataLists.LoadMore where\n\nimport App.Docs\nimport App.Route as Route\nimp"
},
{
"path": "demo/Example/Docs/App.hs",
"chars": 2002,
"preview": "module Example.Docs.App where\n\nimport Data.Text (Text)\nimport Effectful\nimport Effectful.Concurrent\nimport Effectful.Dis"
},
{
"path": "demo/Example/Docs/BasicPage.hs",
"chars": 470,
"preview": "{-# OPTIONS_GHC -Wno-missing-signatures #-}\n\nmodule Example.Docs.BasicPage where\n\nimport Data.Text (Text)\nimport Web.Hyp"
},
{
"path": "demo/Example/Docs/CSS.hs",
"chars": 448,
"preview": "{-# OPTIONS_GHC -Wno-missing-signatures #-}\n{-# OPTIONS_GHC -Wno-unused-binds #-}\n{-# OPTIONS_GHC -Wno-unused-top-binds "
},
{
"path": "demo/Example/Docs/Client.hs",
"chars": 161,
"preview": "module Example.Docs.Client where\n\nimport Web.Hyperbole\n\npage :: (Hyperbole :> es) => Page es '[]\npage = do\n pageTitle \""
},
{
"path": "demo/Example/Docs/Component.hs",
"chars": 348,
"preview": "module Example.Docs.Component where\n\nimport Data.Text (Text)\nimport Example.Colors\nimport Web.Atomic.CSS\nimport Web.Hype"
},
{
"path": "demo/Example/Docs/Encoding.hs",
"chars": 229,
"preview": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Docs.Encoding where\n\nimport Data.Text (Text)\nimport Web.Hyperbole\n"
},
{
"path": "demo/Example/Docs/Interactive.hs",
"chars": 241,
"preview": "module Example.Docs.Interactive where\n\nimport Example.Simple\nimport Web.Hyperbole\n\npage :: Page es '[Message]\npage = do\n"
},
{
"path": "demo/Example/Docs/MultiPage.hs",
"chars": 852,
"preview": "{-# OPTIONS_GHC -Wno-missing-signatures #-}\n\nmodule Example.Docs.MultiPage where\n\nimport Example.Docs.Interactive qualif"
},
{
"path": "demo/Example/Docs/MultiView.hs",
"chars": 329,
"preview": "module Example.Docs.MultiView where\n\nimport Example.Counter (Counter (..), viewCount)\nimport Example.Simple (Message (.."
},
{
"path": "demo/Example/Docs/Nested.hs",
"chars": 1295,
"preview": "module Example.Docs.Nested where\n\nimport Control.Monad (forM_)\nimport Data.Text (Text)\nimport Web.Hyperbole\n\npage :: (Hy"
},
{
"path": "demo/Example/Docs/Nesting.hs",
"chars": 985,
"preview": "module Example.Docs.Nesting where\n\nimport Control.Monad (forM_)\nimport Example.Colors\nimport Example.Docs.UniqueViewId h"
},
{
"path": "demo/Example/Docs/Page/Messages.hs",
"chars": 116,
"preview": "module Example.Docs.Page.Messages where\n\nimport Web.Hyperbole\n\npage :: Page es '[]\npage = pure $ el \"Messages page\"\n"
},
{
"path": "demo/Example/Docs/Page/Users.hs",
"chars": 118,
"preview": "module Example.Docs.Page.Users where\n\nimport Web.Hyperbole\n\npage :: Int -> Page es '[]\npage _ = pure $ el \"User page\"\n"
},
{
"path": "demo/Example/Docs/Params.hs",
"chars": 1363,
"preview": "module Example.Docs.Params where\n\nimport Data.Text (Text)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata Filters = Fil"
},
{
"path": "demo/Example/Docs/QueryMessage.hs",
"chars": 712,
"preview": "module Example.Docs.QueryMessage where\n\nimport Data.Maybe (fromMaybe)\nimport Data.Text (Text)\nimport Web.Atomic.CSS\nimpo"
},
{
"path": "demo/Example/Docs/Sessions.hs",
"chars": 954,
"preview": "module Example.Docs.Sessions where\n\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata AppColor\n = White\n | Red\n | Gree"
},
{
"path": "demo/Example/Docs/SideEffects.hs",
"chars": 2329,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Docs.SideEffects where\n\nimport Da"
},
{
"path": "demo/Example/Docs/State.hs",
"chars": 592,
"preview": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Docs.State where\n\nimport Data.Text (Text)\nimport Web.Atomic.CSS\nim"
},
{
"path": "demo/Example/Docs/UniqueViewId.hs",
"chars": 1273,
"preview": "module Example.Docs.UniqueViewId where\n\nimport Control.Monad (forM_)\nimport Data.Text (Text, pack)\nimport Example.Colors"
},
{
"path": "demo/Example/Docs/ViewFunctions.hs",
"chars": 1983,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Docs.ViewFunctions where\n\nimport "
},
{
"path": "demo/Example/Document.hs",
"chars": 364,
"preview": "module Example.Document where\n\nimport Web.Hyperbole\n\nmain :: IO ()\nmain = do\n run 3000 $ liveApp (document documentHead"
},
{
"path": "demo/Example/Effects/Debug.hs",
"chars": 1060,
"preview": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE QuasiQuotes #-}\n\nmodule Example.Effects.Debug\n ( Milliseconds\n , Debug (..)\n "
},
{
"path": "demo/Example/Effects/Todos.hs",
"chars": 3069,
"preview": "{-# LANGUAGE DerivingVia #-}\n{-# LANGUAGE LambdaCase #-}\n\nmodule Example.Effects.Todos where\n\nimport Data.Map (Map)\nimpo"
},
{
"path": "demo/Example/Effects/Users.hs",
"chars": 2281,
"preview": "{-# LANGUAGE LambdaCase #-}\n\nmodule Example.Effects.Users where\n\nimport App.Route (UserId)\nimport Control.Concurrent.MVa"
},
{
"path": "demo/Example/Errors.hs",
"chars": 3856,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.Errors where\n\nimport App.Docs\nimport Effectful.Exception\nimport Example"
},
{
"path": "demo/Example/FormSimple.hs",
"chars": 5128,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.FormSimple where\n\nimport App.Docs\nimport Data.Text (Text, pack)\nimport "
},
{
"path": "demo/Example/FormValidation.hs",
"chars": 3304,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.FormValidation where\n\nimport Data.Text (Text, pack)\nimport Data.Text qu"
},
{
"path": "demo/Example/Interactivity/Events.hs",
"chars": 2089,
"preview": "module Example.Interactivity.Events where\n\nimport Data.Text (Text, pack)\nimport Example.Colors\nimport Example.Style.Cybe"
},
{
"path": "demo/Example/Interactivity/Inputs.hs",
"chars": 855,
"preview": "module Example.Interactivity.Inputs where\n\nimport Data.Text (pack)\nimport Web.Atomic.CSS\nimport Web.Hyperbole hiding (bu"
},
{
"path": "demo/Example/Javascript.hs",
"chars": 1262,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.Javascript where\n\nimport Data.Text (Text, pack)\nimport App.Docs\nimport "
},
{
"path": "demo/Example/Push.hs",
"chars": 1271,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Push where\n\nimport App.Docs\nimpor"
},
{
"path": "demo/Example/Requests.hs",
"chars": 3009,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.Requests where\n\nimport Data.String.Conversions (cs)\nimport Data.Text (T"
},
{
"path": "demo/Example/Scrollbars.hs",
"chars": 1838,
"preview": "module Example.Scrollbars where\n\nimport Control.Monad (forM_)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text"
},
{
"path": "demo/Example/Simple.hs",
"chars": 824,
"preview": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies "
},
{
"path": "demo/Example/State/Effects.hs",
"chars": 1924,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.State.Effects where\n\nimport App.D"
},
{
"path": "demo/Example/State/Query.hs",
"chars": 2222,
"preview": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.State.Query where\n\nimport Dat"
},
{
"path": "demo/Example/State/Sessions.hs",
"chars": 2478,
"preview": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Exam"
},
{
"path": "demo/Example/State/Stateless.hs",
"chars": 605,
"preview": "module Example.State.Stateless where\n\nimport Example.Style.Cyber (btn)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata "
},
{
"path": "demo/Example/State/ViewState.hs",
"chars": 904,
"preview": "module Example.State.ViewState where\n\nimport Data.Text (pack)\nimport Example.Style.Cyber (btn, dataFeature)\nimport Web.A"
},
{
"path": "demo/Example/Style/Cyber.hs",
"chars": 2731,
"preview": "module Example.Style.Cyber where\n\nimport Data.Text (Text, pack)\nimport Example.Colors\nimport Web.Atomic.CSS\nimport Web.A"
},
{
"path": "demo/Example/Style.hs",
"chars": 1213,
"preview": "module Example.Style where\n\nimport Example.Colors\nimport Web.Atomic.CSS\n\n-- btn :: (Styleable h) => CSS h -> CSS h\n-- bt"
},
{
"path": "demo/Example/Tags.hs",
"chars": 1364,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.Tags where\n\nimport App.Docs\nimport App.Route qualified as Route\nimport "
},
{
"path": "demo/Example/Test.hs",
"chars": 1345,
"preview": "module Example.Test where\n\nimport Control.Monad (forM_)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimpo"
},
{
"path": "demo/Example/Todos/Todo.hs",
"chars": 5837,
"preview": "{-# LANGUAGE DerivingVia #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Todo"
},
{
"path": "demo/Example/Todos/TodoCSS.hs",
"chars": 7934,
"preview": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Todos.TodoCSS (page) where\n\nimport App.Route hiding (Filter)\nimpor"
},
{
"path": "demo/Example/Trigger.hs",
"chars": 1136,
"preview": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.Trigger where\n\nimport Data.Text (Text)\nimport App.Docs\nimport Example.S"
},
{
"path": "demo/Example/View/Icon.hs",
"chars": 3626,
"preview": "{-# LANGUAGE QuasiQuotes #-}\n\nmodule Example.View.Icon where\n\nimport Data.String.Interpolate (i)\nimport Data.Text (Text)"
},
{
"path": "demo/Example/View/Inputs.hs",
"chars": 603,
"preview": "module Example.View.Inputs where\n\nimport Example.Colors\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ntoggleCheckbox :: (V"
},
{
"path": "demo/Example/View/Layout.hs",
"chars": 3042,
"preview": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE QuasiQu"
},
{
"path": "demo/Example/View/Loader.hs",
"chars": 926,
"preview": "{-# LANGUAGE QuasiQuotes #-}\n\nmodule Example.View.Loader where\n\nimport Data.ByteString (ByteString)\nimport Data.String.I"
},
{
"path": "demo/Example/View/Menu.hs",
"chars": 2050,
"preview": "{-# LANGUAGE AllowAmbiguousTypes #-}\n\nmodule Example.View.Menu where\n\nimport App.Docs\nimport App.Route\nimport Control.Mo"
},
{
"path": "demo/Example/View/SortableTable.hs",
"chars": 1254,
"preview": "module Example.View.SortableTable where\n\nimport Data.Text (Text)\nimport Example.Colors\nimport Example.Style qualified as"
},
{
"path": "demo/Main.hs",
"chars": 60,
"preview": "module Main where\n\nimport App\n\nmain :: IO ()\nmain = App.run\n"
},
{
"path": "demo/README.md",
"chars": 114,
"preview": "Hyperbole Examples\n===================\n\nVisit https://docs.hyperbole.live to view these examples with source code\n"
},
{
"path": "demo/demo.cabal",
"chars": 4201,
"preview": "cabal-version: 2.2\n\n-- This file has been generated from package.yaml by hpack version 0.37.0.\n--\n-- see: https://github"
},
{
"path": "demo/fourmolu.yaml",
"chars": 1570,
"preview": "# # Number of spaces per indentation step\nindentation: 2\n#\n# # Max line length for automatic line breaking\n# column-limi"
},
{
"path": "demo/hie.yaml",
"chars": 17,
"preview": "cradle:\n cabal:\n"
},
{
"path": "demo/package.yaml",
"chars": 1423,
"preview": "name: demo\nversion: 0.6.0\nsynopsis: Interactive HTML apps using type-safe serverside "
},
{
"path": "demo/static/custom.js",
"chars": 750,
"preview": "console.log(\"Custom JS!\")\n\nwindow.onload = function() {\n let boxes = Hyperbole.hyperView(\"JBoxes\")\n console.log(\"Found"
},
{
"path": "demo/static/cyber.css",
"chars": 3235,
"preview": "@font-face {\n font-family: 'Share Tech Mono';\n src: url('/ShareTechMono-Regular.ttf') format('truetype');\n font-weigh"
},
{
"path": "demo/static/docs.js",
"chars": 1484,
"preview": "\nconsole.log(\"CUSTOM DOCS JS 2\")\n\nconst sections = document.querySelectorAll(\"section[id]\")\nconst navLinks = document.qu"
},
{
"path": "demo/static/external.css",
"chars": 373,
"preview": ".item {\n border: 1px dashed;\n padding: 5px;\n padding-left: 10px;\n padding-right: 10px;\n}\n\n.item:hover {\n border-col"
},
{
"path": "demo/static/prism.css",
"chars": 1503,
"preview": "/* PrismJS 1.30.0\nhttps://prismjs.com/download#themes=prism-okaidia&languages=markup+css+clike+javascript+haskell */\ncod"
},
{
"path": "demo/static/prism.js",
"chars": 19952,
"preview": "/* PrismJS 1.30.0\nhttps://prismjs.com/download#themes=prism&languages=markup+css+clike+javascript+haskell */\nvar _self=\""
},
{
"path": "demo/static/test.js",
"chars": 253,
"preview": "console.log('test.js')\n\n\nwindow.addEventListener('load', function() {\n\n let other = Hyperbole.hyperView(\"Other\")\n docu"
},
{
"path": "demo/static/todomvc.css",
"chars": 720,
"preview": "/* Undo the CSS reset for the TODOMVC example. This is only needed for the examples, because\n * we need to apply the res"
},
{
"path": "docs/Main.hs",
"chars": 7765,
"preview": "{-# LANGUAGE QuasiQuotes #-}\n\nmodule Main where\n\nimport Control.Exception (SomeException, try)\nimport Data.Char (isAlpha"
},
{
"path": "docs/app-document.md",
"chars": 431,
"preview": "The first argument is a `document` function. This turns an initial page fragment into a full document, complete with `<s"
},
{
"path": "docs/app-effects.md",
"chars": 422,
"preview": "Your application will want to support various side effects. It's helpful to create a single function that runs all share"
},
{
"path": "docs/app-live.md",
"chars": 328,
"preview": "In [[/basics]] we showed how to run a simple application:\n\n #EMBED Example.Docs.BasicPage main\n\n Let's go over the ar"
},
{
"path": "docs/app-pages.md",
"chars": 628,
"preview": "The second argument of `liveApp` is an `Effect` monad which returns a `Response`. We will rarely return a `Response` dir"
},
{
"path": "docs/app-routes.md",
"chars": 706,
"preview": "Since we have more than one `Page`, we need a way to choose between them. You could create a manual function `Hyperbole "
},
{
"path": "docs/atomic.md",
"chars": 364,
"preview": "Hyperbole encourages using the [atomic-css](https://github.com/seanhess/atomic-css) package to factor styles with haske"
},
{
"path": "docs/comparison.md",
"chars": 1062,
"preview": "Comparison with Similar Frameworks\n==================================\n\n[HTMX](https://htmx.org/)\n----------------\n\nSimil"
},
{
"path": "docs/concurrency-overlap.md",
"chars": 665,
"preview": "By default, if an `Action` triggers for a particular `HyperView` when one is already being processed, the system will `D"
},
{
"path": "docs/dev.md",
"chars": 682,
"preview": "Local Development\n=================\n\nDownload and install [NPM](https://nodejs.org/en/download). On a mac, can be instal"
},
{
"path": "docs/docgen.cabal",
"chars": 1271,
"preview": "cabal-version: 2.2\n\n-- This file has been generated from package.yaml by hpack version 0.37.0.\n--\n-- see: https://github"
},
{
"path": "docs/effectful.md",
"chars": 619,
"preview": "Hyperbole relies heavily on [Effectful](https://hackage.haskell.org/package/effectful) to run and compose side effects. "
},
{
"path": "docs/effects-custom.md",
"chars": 1274,
"preview": "We could run a database using the `IOE` effect, but it is better to describe the high-level operations available to the "
},
{
"path": "docs/effects-other.md",
"chars": 571,
"preview": "If we want to use an `Effect` besides `Hyperbole`, add it as a constraint to any `Page` and `HyperView` that needs it\n\nT"
},
{
"path": "docs/forms-simple.md",
"chars": 418,
"preview": "We can render and parse `form`s via a record. This can be a simple record:\n\n #EMBED Example.FormSimple data ContactFo"
},
{
"path": "docs/forms-validated.md",
"chars": 339,
"preview": "We can use a Higher-Kinded `form` not only for field names and values, but to `validate` form fields\n\n #EMBED Example"
},
{
"path": "docs/hyperviews-intro.md",
"chars": 1320,
"preview": "Let's get interactive! Using `Hyperbole`, we divide our `Page` into independent live subsections called `HyperView`s\n\nTo"
},
{
"path": "docs/hyperviews-multi.md",
"chars": 317,
"preview": "We can add as many `HyperView`s to a `Page` as we want. Each will update independently. These can be copies of the same "
},
{
"path": "docs/hyperviews-nesting.md",
"chars": 741,
"preview": "We can nest smaller, more specific `HyperView`s inside of a larger parent. You might need this technique to display a li"
},
{
"path": "docs/hyperviews-unique.md",
"chars": 890,
"preview": "`ViewId` values must be unique. So if we want more than one of the same `HyperView` on the same `Page`, we need a way to"
},
{
"path": "docs/interactivity-events.md",
"chars": 318,
"preview": "Hyperbole provides various events that can be tied to specific `Action`s. Up to this point, we've only used them via the"
},
{
"path": "docs/interactivity-events2.md",
"chars": 346,
"preview": "The following example demonstrates using `onMouseEnter` and `onMouseLeave`\n\nRemember it is better to use Atomic CSS to p"
},
{
"path": "docs/interactivity-inputs.md",
"chars": 339,
"preview": "We've seen `button` in quite a few examples. Hyperbole provides a few other high-level inputs to easily tie interactivit"
},
{
"path": "docs/interactivity-javascript.md",
"chars": 748,
"preview": "Include custom js on a page with the script tag on only the page where it is needed, or globally via your `docuemnt` fun"
},
{
"path": "docs/interactivity-pushevent.md",
"chars": 357,
"preview": "## PushEvent\n\nThe server can push an event to be dispatched on a `HyperView`\n\n #EMBED Example.Javascript update Alert"
},
{
"path": "docs/intro-downsides.md",
"chars": 840,
"preview": "__Beginners__ - It uses some advanced Haskell features, and requires using [Effectful](https://hackage.haskell.org/packa"
},
{
"path": "docs/intro-links.md",
"chars": 369,
"preview": "This site has detailed documentation with inline examples. Click the \"source\" link to see the real source code for the e"
},
{
"path": "docs/intro.md",
"chars": 1957,
"preview": "Single Page Applications (SPAs) require the programmer to write two programs: a Javascript client and a Server, which bo"
},
{
"path": "docs/javascript_api.md",
"chars": 2142,
"preview": "Javascript API\n-----------------\n\nRequirements\n\n1. Call runAction() - you ought to be able to tell the server to run a p"
},
{
"path": "docs/multi-same.md",
"chars": 632,
"preview": "We can embed more than one of the same `HyperView` as long as the _value_ of `ViewId` is unique. Let's update `Message` "
},
{
"path": "docs/nix.md",
"chars": 3555,
"preview": "Usage with NIX\n==============\n\n\nHow to Import Flake\n-------------------\n\nYou can import this flake's overlay to add `hyp"
},
{
"path": "docs/outline.md",
"chars": 946,
"preview": "# TODO: ConcurrencyMode = Replace, etc\n# TODO: feedback - loading\n\nIntro\n------\n\n\n\n\nBasics\n------\n\n* Get Running\n* Html "
},
{
"path": "docs/package.yaml",
"chars": 970,
"preview": "name: docgen\nversion: 0.5.0\nsynopsis: Interactive HTML apps using type-safe serversid"
},
{
"path": "docs/pages.md",
"chars": 766,
"preview": "\nAn app will usually have multiple 'Page's with different 'Route's that each map to a unique url path:\n\n@\n#EMBED Example"
},
{
"path": "docs/state-browser.md",
"chars": 725,
"preview": "The state `Action` threading and `ViewState` both live in on the web page itself, and are reset when the user navigates "
},
{
"path": "docs/state-effects.md",
"chars": 579,
"preview": "For any real application, most persistent state will need to use a separate `Effect`, like a database. In [[/sideeffects"
},
{
"path": "docs/state-sessions.md",
"chars": 612,
"preview": "Likewise we can store state in a browser cookie using `Session`. This is useful for user preferences, login state, and a"
},
{
"path": "docs/state-stateless.md",
"chars": 219,
"preview": "By default, `HyperView`s are stateless. Nothing is stored in the server connection. `HyperView` `update`s are the direct"
},
{
"path": "docs/state-threading.md",
"chars": 471,
"preview": "The simplest way to add state to a `HyperView` is to pass it back and forth between the `Action` and the `View`. In this"
},
{
"path": "docs/state-viewstate.md",
"chars": 761,
"preview": "`Hyperbole` can manage action-threaded state automatically by setting `ViewState` in your `ViewId`:\n\n #EMBED Example."
},
{
"path": "docs/view-components.md",
"chars": 788,
"preview": "You may be tempted to use `HyperView`s to create reusable \\\"_Components_\\\". This leads to object-oriented designs that d"
},
{
"path": "docs/view-functions-end.md",
"chars": 285,
"preview": "Don't use `HyperView`s to keep your code DRY. Instead, think about which subsections of a page ought to update independe"
},
{
"path": "docs/view-functions-wrap.md",
"chars": 152,
"preview": "View functions can be containers which wrap other Views:\n\n #EMBED Example.View.Inputs progressBar\n\n #EMBED Example"
},
{
"path": "docs/view-functions.md",
"chars": 696,
"preview": "We showed in [[basics]] how we can factor `View`s into functions. It's best practice to have a main `View` function for "
},
{
"path": "flake.nix",
"chars": 8374,
"preview": "{\n description = \"hyperbole overlay, development and hyperbole-demo\";\n\n nixConfig = {\n extra-substituters = [\n "
},
{
"path": "fourmolu.yaml",
"chars": 1569,
"preview": "# # Number of spaces per indentation step\nindentation: 2\n#\n# # Max line length for automatic line breaking\n# column-limi"
},
{
"path": "hie.yaml",
"chars": 17,
"preview": "cradle:\n cabal:\n"
},
{
"path": "hyperbole.cabal",
"chars": 5258,
"preview": "cabal-version: 2.2\n\n-- This file has been generated from package.yaml by hpack version 0.37.0.\n--\n-- see: https://github"
},
{
"path": "package.yaml",
"chars": 2143,
"preview": "name: hyperbole\nversion: 0.6.0\nsynopsis: Interactive HTML apps using type-safe server"
},
{
"path": "src/Web/Hyperbole/Application.hs",
"chars": 3316,
"preview": "module Web.Hyperbole.Application\n ( waiApp\n , websocketsOr\n , defaultConnectionOptions\n , liveApp\n , liveAppWith\n "
}
]
// ... and 54 more files (download for full content)
About this extraction
This page contains the full source code of the seanhess/hyperbole GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 254 files (539.1 KB), approximately 157.6k tokens, and a symbol index with 174 extracted functions, classes, methods, constants, and types. 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.